From 028c8776019129e143a4bf81b977eb603ead70dd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 21 May 2009 21:23:01 -0500 Subject: [PATCH 01/12] tuple-arrays: clean up a bit and add docs --- basis/tuple-arrays/tuple-arrays-docs.factor | 25 +++++++++++++++++++++ basis/tuple-arrays/tuple-arrays.factor | 2 +- 2 files changed, 26 insertions(+), 1 deletion(-) create mode 100644 basis/tuple-arrays/tuple-arrays-docs.factor diff --git a/basis/tuple-arrays/tuple-arrays-docs.factor b/basis/tuple-arrays/tuple-arrays-docs.factor new file mode 100644 index 0000000000..cedf900698 --- /dev/null +++ b/basis/tuple-arrays/tuple-arrays-docs.factor @@ -0,0 +1,25 @@ +IN: tuple-arrays +USING: help.markup help.syntax sequences ; + +HELP: TUPLE-ARRAY: +{ $syntax "TUPLE-ARRAY: class" } +{ $description "Generates a new data type in the current vocabulary named " { $snippet { $emphasis "class" } "-array" } " for holding instances of " { $snippet "class" } ", which must be a tuple class word. Together with the class itself, this also generates words named " { $snippet "<" { $emphasis "class" } "-array>" } " and " { $snippet ">" { $emphasis "class" } "-array" } ", for creating new instances of this tuple array type." } ; + +ARTICLE: "tuple-arrays" "Tuple arrays" +"The " { $vocab-link "tuple-arrays" } " vocabulary implements space-efficient unboxed tuple arrays. Whereas an ordinary array of tuples would consist of pointers to heap-allocated objects, a tuple array stores its elements inline. Calling " { $link nth } " copies an element into a new tuple, and calling " { $link set-nth } " copies an existing tuple's slots into an array." +$nl +"Since value semantics differ from reference semantics, it is best to use tuple arrays with tuples where all slots are declared " { $link read-only } "." +$nl +"Tuple arrays should not be used with inheritance; storing an instance of a subclass in a tuple array will slice off the subclass slots, and getting the same value out again will yield an instance of the superclass. Also, tuple arrays do not get updated if tuples are redefined to add or remove slots, so caution should be exercised when doing interactive development on code that uses tuple arrays." +{ $subsection POSTPONE: TUPLE-ARRAY: } +"An example:" +{ $example + "USE: tuple-arrays" + "IN: scratchpad" + "TUPLE: point x y ;" + "TUPLE-ARRAY: point" + "{ T{ point f 1 2 } T{ point f 1 3 } T{ point f 2 3 } } >point-array first short." + "T{ point f 1 2 }" +} ; + +ABOUT: "tuple-arrays" \ No newline at end of file diff --git a/basis/tuple-arrays/tuple-arrays.factor b/basis/tuple-arrays/tuple-arrays.factor index 35d771416c..761dbd816a 100644 --- a/basis/tuple-arrays/tuple-arrays.factor +++ b/basis/tuple-arrays/tuple-arrays.factor @@ -21,7 +21,7 @@ MACRO: infer-in ( class -- quot ) infer in>> '[ _ ] ; [ new ] [ smart-tuple>array ] bi ; inline : tuple-slice ( n seq -- slice ) - [ n>> [ * dup ] keep + ] [ seq>> ] bi { array } declare slice boa ; inline + [ n>> [ * dup ] keep + ] [ seq>> ] bi slice boa ; inline : read-tuple ( slice class -- tuple ) '[ _ boa-unsafe ] input Date: Thu, 21 May 2009 23:27:42 -0500 Subject: [PATCH 02/12] io.monitors: fix example (reported by levy in #concatenative0 --- basis/io/monitors/monitors-docs.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/io/monitors/monitors-docs.factor b/basis/io/monitors/monitors-docs.factor index f0278e300e..c5f266de56 100644 --- a/basis/io/monitors/monitors-docs.factor +++ b/basis/io/monitors/monitors-docs.factor @@ -112,10 +112,10 @@ $nl { $code "USE: io.monitors" ": watch-loop ( monitor -- )" - " dup next-change . nl nl flush watch-loop ;" + " dup next-change path>> print nl nl flush watch-loop ;" "" ": watch-directory ( path -- )" - " [ t [ watch-loop ] with-monitor ] with-monitors" + " [ t [ watch-loop ] with-monitor ] with-monitors ;" } ; ABOUT: "io.monitors" From 9cc178b738e4cddaed98748f10233757f05c07d8 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 22 May 2009 01:59:50 -0500 Subject: [PATCH 03/12] If a vocab fails to load, manifest would be left in a weird state (reported by Joe Groff) --- core/parser/parser-tests.factor | 11 ++++++++++- core/vocabs/loader/test/l/l.factor | 4 ++++ core/vocabs/loader/test/l/tags.txt | 1 + core/vocabs/parser/parser.factor | 4 ++-- 4 files changed, 17 insertions(+), 3 deletions(-) create mode 100644 core/vocabs/loader/test/l/l.factor create mode 100644 core/vocabs/loader/test/l/tags.txt diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor index a9e0bd08ab..32f432a6cd 100644 --- a/core/parser/parser-tests.factor +++ b/core/parser/parser-tests.factor @@ -618,4 +618,13 @@ EXCLUDE: qualified.tests.bar => x ; [ "USE: kernel UNUSE: kernel dup" "unuse-test" parse-stream -] [ error>> error>> error>> no-word-error? ] must-fail-with \ No newline at end of file +] [ error>> error>> error>> no-word-error? ] must-fail-with + +[ ] [ [ "vocabs.loader.test.l" forget-vocab ] with-compilation-unit ] unit-test + +[ + [ "vocabs.loader.test.l" use-vocab ] must-fail + [ f ] [ "vocabs.loader.test.l" manifest get search-vocab-names>> key? ] unit-test + [ ] [ "vocabs.loader.test.l" unuse-vocab ] unit-test + [ f ] [ "vocabs.loader.test.l" manifest get search-vocab-names>> key? ] unit-test +] with-file-vocabs diff --git a/core/vocabs/loader/test/l/l.factor b/core/vocabs/loader/test/l/l.factor new file mode 100644 index 0000000000..10cd35dff2 --- /dev/null +++ b/core/vocabs/loader/test/l/l.factor @@ -0,0 +1,4 @@ +IN: vocabs.loader.test.l +USE: kernel + +"Oops" throw \ No newline at end of file diff --git a/core/vocabs/loader/test/l/tags.txt b/core/vocabs/loader/test/l/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/core/vocabs/loader/test/l/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index 45084ae8ff..ff55f8e68d 100644 --- a/core/vocabs/parser/parser.factor +++ b/core/vocabs/parser/parser.factor @@ -108,8 +108,8 @@ TUPLE: no-current-vocab ; dup using-vocab? [ vocab-name "Already using ``" "'' vocabulary" surround note. ] [ manifest get - [ [ vocab-name ] dip search-vocab-names>> conjoin ] [ [ load-vocab ] dip search-vocabs>> push ] + [ [ vocab-name ] dip search-vocab-names>> conjoin ] 2bi ] if ; @@ -121,8 +121,8 @@ TUPLE: no-current-vocab ; : unuse-vocab ( vocab -- ) dup using-vocab? [ manifest get - [ [ vocab-name ] dip search-vocab-names>> delete-at ] [ [ load-vocab ] dip search-vocabs>> delq ] + [ [ vocab-name ] dip search-vocab-names>> delete-at ] 2bi ] [ drop ] if ; From d7ab0ad7c081c145989422bfa6e80f2a86512df0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 22 May 2009 02:04:36 -0500 Subject: [PATCH 04/12] io.monitors: spawn-monitor was broken and never used, so remove it (reported by levi in #concatenative) --- basis/io/monitors/monitors.factor | 3 --- 1 file changed, 3 deletions(-) diff --git a/basis/io/monitors/monitors.factor b/basis/io/monitors/monitors.factor index 7d40a1563a..cc8cea37d2 100644 --- a/basis/io/monitors/monitors.factor +++ b/basis/io/monitors/monitors.factor @@ -60,9 +60,6 @@ SYMBOL: +rename-file+ : run-monitor ( path recursive? quot -- ) '[ [ @ t ] loop ] with-monitor ; inline -: spawn-monitor ( path recursive? quot -- ) - [ '[ _ _ _ run-monitor ] ] [ 2drop "Monitoring " prepend ] 3bi - spawn drop ; { { [ os macosx? ] [ "io.monitors.macosx" require ] } { [ os linux? ] [ "io.monitors.linux" require ] } From bbad40683b701346a65253d67b66d1f8f3ed4dac Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 22 May 2009 16:21:35 -0500 Subject: [PATCH 05/12] webapps.mason: spiff up download.xml a bit --- extra/webapps/mason/download.xml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/extra/webapps/mason/download.xml b/extra/webapps/mason/download.xml index af4ac0214d..6dca81baf8 100644 --- a/extra/webapps/mason/download.xml +++ b/extra/webapps/mason/download.xml @@ -4,9 +4,12 @@ + Factor binary package for <t:label t:name="platform" /> +
Logo
+

Factor binary package for

Requirements:

From 92ecb2f3be0226c6886018cb0821c6956cbfa2e0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 22 May 2009 17:15:40 -0500 Subject: [PATCH 06/12] fix random.windows -- use CRYPT_MACHINE_KEYSET --- basis/random/windows/windows.factor | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/basis/random/windows/windows.factor b/basis/random/windows/windows.factor index 6dce078d67..06a7634a43 100644 --- a/basis/random/windows/windows.factor +++ b/basis/random/windows/windows.factor @@ -25,7 +25,8 @@ CONSTANT: factor-crypto-container "FactorCryptoContainer" CryptAcquireContextW handle swap ; : acquire-crypto-context ( provider type -- handle ) - 0 (acquire-crypto-context) + CRYPT_MACHINE_KEYSET + (acquire-crypto-context) 0 = [ GetLastError NTE_BAD_KEYSET = [ drop f ] [ win32-error-string throw ] if @@ -34,7 +35,7 @@ CONSTANT: factor-crypto-container "FactorCryptoContainer" ] if ; : create-crypto-context ( provider type -- handle ) - CRYPT_NEWKEYSET (acquire-crypto-context) win32-error=0/f *void* ; + { CRYPT_MACHINE_KEYSET CRYPT_NEWKEYSET } (acquire-crypto-context) win32-error=0/f *void* ; ERROR: acquire-crypto-context-failed provider type ; From d660dd4ed6ec4f91d9b9b9a2a5a24802a2cb7dc6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Fri, 22 May 2009 17:18:24 -0500 Subject: [PATCH 07/12] fix typo --- basis/random/windows/windows.factor | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/basis/random/windows/windows.factor b/basis/random/windows/windows.factor index 06a7634a43..83b1fab0d0 100644 --- a/basis/random/windows/windows.factor +++ b/basis/random/windows/windows.factor @@ -1,7 +1,7 @@ USING: accessors alien.c-types byte-arrays combinators.short-circuit continuations destructors init kernel locals namespaces random windows.advapi32 windows.errors -windows.kernel32 ; +windows.kernel32 math.bitwise ; IN: random.windows TUPLE: windows-rng provider type ; @@ -35,7 +35,8 @@ CONSTANT: factor-crypto-container "FactorCryptoContainer" ] if ; : create-crypto-context ( provider type -- handle ) - { CRYPT_MACHINE_KEYSET CRYPT_NEWKEYSET } (acquire-crypto-context) win32-error=0/f *void* ; + { CRYPT_MACHINE_KEYSET CRYPT_NEWKEYSET } flags + (acquire-crypto-context) win32-error=0/f *void* ; ERROR: acquire-crypto-context-failed provider type ; From a1436e69cde39d8ef151c5d09075c9e3afafb3ed Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 22 May 2009 17:32:27 -0500 Subject: [PATCH 08/12] webapps.mason: make it look like the factorcode.org site --- extra/webapps/mason/download.xml | 5 ++++- extra/webapps/mason/mason.factor | 22 +++++++++++----------- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/extra/webapps/mason/download.xml b/extra/webapps/mason/download.xml index 6dca81baf8..7e50f958cd 100644 --- a/extra/webapps/mason/download.xml +++ b/extra/webapps/mason/download.xml @@ -1,8 +1,11 @@ + + - + Factor binary package for <t:label t:name="platform" /> diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor index 4d42617520..690c4c9660 100644 --- a/extra/webapps/mason/mason.factor +++ b/extra/webapps/mason/mason.factor @@ -21,12 +21,13 @@ TUPLE: mason-app < dispatcher ; ] dip link ; : download-grid-cell ( cpu os -- xml ) - builder new swap >>os swap >>cpu select-tuple dup - [ + builder new swap >>os swap >>cpu select-tuple [ dup last-release>> dup [ "." split1 drop 16 tail* 6 head* download-link ] [ 2drop f ] if - ] when - [XML <-> XML] ; + [XML
<->
XML] + ] [ + [XML XML] + ] if* ; CONSTANT: oses { @@ -47,22 +48,21 @@ CONSTANT: cpus : download-grid ( -- xml ) oses - [ values [ [XML <-> XML] ] map ] + [ values [ [XML <-> XML] ] map ] [ keys cpus [ [ nip second ] [ first ] 2bi [ swap download-grid-cell - ] curry map [XML <-><-> XML] + ] curry map + [XML <-><-> XML] ] with map - ] bi [XML <->
<->
XML] ; + ] bi + [XML <->
<->
XML] ; : ( -- action ) - [ - download-grid - xml>string "text/html" - ] >>display ; + [ download-grid xml>string "text/html" ] >>display ; : validate-os/cpu ( -- ) { From 760445c8e4347389645e7bf4eafaf2832f694766 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 22 May 2009 17:42:05 -0500 Subject: [PATCH 09/12] More cosmetic tweaks --- extra/webapps/mason/mason.factor | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor index 690c4c9660..fad77286b2 100644 --- a/extra/webapps/mason/mason.factor +++ b/extra/webapps/mason/mason.factor @@ -26,7 +26,7 @@ TUPLE: mason-app < dispatcher ; [ "." split1 drop 16 tail* 6 head* download-link ] [ 2drop f ] if [XML
<->
XML] ] [ - [XML XML] + [XML XML] ] if* ; CONSTANT: oses @@ -58,7 +58,12 @@ CONSTANT: cpus [XML <-><-> XML] ] with map ] bi - [XML <->
<->
XML] ; + [XML + + <-> + <-> +
OS/CPU
+ XML] ; : ( -- action ) From b58c1780c6fd9dde4d15b082f1e18c418dd89c71 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 22 May 2009 17:48:05 -0500 Subject: [PATCH 10/12] One last tweak --- extra/webapps/mason/mason.factor | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor index fad77286b2..f7aadb9a54 100644 --- a/extra/webapps/mason/mason.factor +++ b/extra/webapps/mason/mason.factor @@ -15,7 +15,7 @@ TUPLE: mason-app < dispatcher ; : download-link ( builder label -- xml ) [ - [ URL" download" ] dip + [ URL" http://builds.factorcode.org/download" ] dip [ os>> "os" set-query-param ] [ cpu>> "cpu" set-query-param ] bi ] dip link ; @@ -137,16 +137,16 @@ CONSTANT: cpus os>> { { "winnt" "Windows XP (also tested on Vista)" } { "macosx" "Mac OS X 10.5 Leopard" } - { "linux" "Linux 2.6.16 with GLIBC 2.4" } + { "linux" "Ubuntu Linux 9.04 (other distributions may also work)" } { "freebsd" "FreeBSD 7.0" } { "netbsd" "NetBSD 4.0" } - { "openbsd" "OpenBSD 4.2" } + { "openbsd" "OpenBSD 4.4" } } at ] [ dup cpu>> "x86.32" = [ os>> { - { [ dup { "winnt" "linux" } member? ] [ drop "Intel Pentium 4, Core Duo, or other x86 chip with SSE2 support. Note that 32-bit Athlon XP processors do not support SSE2." ] } - { [ dup { "freebsd" "netbsd" "openbsd" } member? ] [ drop "Intel Pentium Pro or better" ] } + { [ dup { "winnt" "linux" "freebsd" } member? ] [ drop "Intel Pentium 4, Core Duo, or other x86 chip with SSE2 support. Note that 32-bit Athlon XP processors do not support SSE2." ] } + { [ dup { "netbsd" "openbsd" } member? ] [ drop "Intel Pentium Pro or better" ] } { [ t ] [ drop f ] } } cond ] [ drop f ] if From 5fa0507b97f0acd9721ca8d9bf807a729b55df95 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 22 May 2009 17:52:31 -0500 Subject: [PATCH 11/12] websites.concatenatieve: add builds.factorcode.org --- extra/websites/concatenative/concatenative.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index d7b132d4f2..207ae9ab34 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -23,7 +23,8 @@ webapps.pastebin webapps.planet webapps.wiki webapps.user-admin -webapps.help ; +webapps.help +webapps.mason ; IN: websites.concatenative : test-db ( -- db ) "resource:test.db" ; @@ -95,6 +96,7 @@ SYMBOL: dh-file test-db "planet.factorcode.org" add-responder home "docs" append-path test-db "docs.factorcode.org" add-responder home "cgi" append-path "gitweb.factorcode.org" add-responder + "builds.factorcode.org" add-responder main-responder set-global ; : ( -- config ) From 6061b68b0daa243b3a224194d65478d3849e984b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 23 May 2009 00:31:52 -0500 Subject: [PATCH 12/12] checksums.md5: make the new optimized code work with big endian CPUs --- basis/checksums/md5/md5.factor | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor index c74aa550d2..d59976fb7e 100644 --- a/basis/checksums/md5/md5.factor +++ b/basis/checksums/md5/md5.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2006, 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel io io.binary io.files io.streams.byte-array math +USING: alien.c-types kernel io io.binary io.files io.streams.byte-array math math.functions math.parser namespaces splitting grouping strings sequences byte-arrays locals sequences.private macros fry io.encodings.binary math.bitwise checksums accessors @@ -173,9 +173,27 @@ HINTS: (process-md5-block-G) { uint-array md5-state } ; HINTS: (process-md5-block-H) { uint-array md5-state } ; HINTS: (process-md5-block-I) { uint-array md5-state } ; +: byte-array>le ( byte-array -- byte-array ) + little-endian? [ + dup 4 [ + [ [ 1 2 ] dip exchange-unsafe ] + [ [ 0 3 ] dip exchange-unsafe ] bi + ] each + ] unless ; + +: byte-array>uint-array-le ( byte-array -- uint-array ) + byte-array>le byte-array>uint-array ; + +HINTS: byte-array>uint-array-le byte-array ; + +: uint-array>byte-array-le ( uint-array -- byte-array ) + underlying>> byte-array>le ; + +HINTS: uint-array>byte-array-le uint-array ; + M: md5-state checksum-block ( block state -- ) [ - [ byte-array>uint-array ] [ state>> ] bi* { + [ byte-array>uint-array-le ] [ state>> ] bi* { [ (process-md5-block-F) ] [ (process-md5-block-G) ] [ (process-md5-block-H) ] @@ -185,7 +203,7 @@ M: md5-state checksum-block ( block state -- ) nip update-md5 ] 2bi ; -: md5>checksum ( md5 -- bytes ) state>> underlying>> ; +: md5>checksum ( md5 -- bytes ) state>> uint-array>byte-array-le ; M: md5-state clone ( md5 -- new-md5 ) call-next-method