From a2e6c372136f35a1d62a8add94293efbd8b52649 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 7 Feb 2008 18:30:20 -0600 Subject: [PATCH 01/13] simplify builder.test --- extra/builder/builder.factor | 9 +++++-- extra/builder/test/test.factor | 48 ++++++++++++++++++++++------------ 2 files changed, 38 insertions(+), 19 deletions(-) diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index 5e992ccc81..caa381ba5d 100755 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -1,8 +1,8 @@ -USING: kernel io io.files io.launcher hashtables tools.deploy.backend +USING: kernel io io.files io.launcher hashtables system continuations namespaces sequences splitting math.parser prettyprint tools.time calendar bake vars http.client - combinators ; + combinators bootstrap.image ; IN: builder @@ -82,6 +82,11 @@ VAR: stamp ] if + { + "git" "pull" "--no-summary" + "http://dharmatech.onigirihouse.com/factor.git" "master" + } run-process process-status + "/builds/" stamp> append make-directory "/builds/" stamp> append cd diff --git a/extra/builder/test/test.factor b/extra/builder/test/test.factor index fb9c62e2aa..2a867b1fbc 100644 --- a/extra/builder/test/test.factor +++ b/extra/builder/test/test.factor @@ -7,28 +7,42 @@ USING: kernel sequences assocs builder continuations vocabs vocabs.loader IN: builder.test +! : do-load ( -- ) +! [ +! [ load-everything ] +! [ require-all-error-vocabs "../load-everything-log" log-object ] +! recover +! ] +! "../load-everything-time" log-runtime ; + : do-load ( -- ) - [ - [ load-everything ] - [ require-all-error-vocabs "../load-everything-log" log-object ] - recover - ] - "../load-everything-time" log-runtime ; + [ try-everything ] "../load-everything-time" log-runtime + dup empty? + [ drop ] + [ "../load-everything-log" log-object ] + if ; + +! : do-tests ( -- ) +! "" child-vocabs +! [ vocab-source-loaded? ] subset +! [ vocab-tests-path ] map +! [ dup [ ?resource-path exists? ] when ] subset +! [ dup run-test ] { } map>assoc +! [ second empty? not ] subset +! dup empty? +! [ drop ] +! [ +! "../failing-tests" +! [ [ nl failures. ] assoc-each ] +! with-stream +! ] +! if ; : do-tests ( -- ) - "" child-vocabs - [ vocab-source-loaded? ] subset - [ vocab-tests-path ] map - [ dup [ ?resource-path exists? ] when ] subset - [ dup run-test ] { } map>assoc - [ second empty? not ] subset + run-all-tests keys dup empty? [ drop ] - [ - "../failing-tests" - [ [ nl failures. ] assoc-each ] - with-stream - ] + [ "../failing-tests" log-object ] if ; : do-all ( -- ) do-load do-tests ; From 1c3efa89d214ad2b4f9f6b468de2519c6bdbae2c Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Thu, 7 Feb 2008 19:50:26 -0600 Subject: [PATCH 02/13] builder improvements (download-image, simpler do-all) --- extra/builder/builder.factor | 12 ++++++------ extra/builder/test/test.factor | 24 ------------------------ 2 files changed, 6 insertions(+), 30 deletions(-) diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor index caa381ba5d..9af79efb29 100755 --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -2,7 +2,7 @@ USING: kernel io io.files io.launcher hashtables system continuations namespaces sequences splitting math.parser prettyprint tools.time calendar bake vars http.client - combinators bootstrap.image ; + combinators bootstrap.image bootstrap.image.download ; IN: builder @@ -70,7 +70,6 @@ VAR: stamp "pull" "--no-summary" "git://factorcode.org/git/factor.git" - ! "http://dharmatech.onigirihouse.com/factor.git" "master" } run-process process-status @@ -85,7 +84,7 @@ VAR: stamp { "git" "pull" "--no-summary" "http://dharmatech.onigirihouse.com/factor.git" "master" - } run-process process-status + } run-process drop "/builds/" stamp> append make-directory "/builds/" stamp> append cd @@ -112,14 +111,15 @@ VAR: stamp "builder: vm compile" throw ] if - [ "http://factorcode.org/images/latest/" boot-image-name append download ] + [ my-arch download-image ] + [ ] [ "builder: image download" email-string ] - recover + cleanup `{ { +arguments+ { ,[ factor-binary ] - ,[ "-i=" boot-image-name append ] + ,[ "-i=" my-boot-image-name append ] "-no-user-init" } } { +stdout+ "../boot-log" } diff --git a/extra/builder/test/test.factor b/extra/builder/test/test.factor index 2a867b1fbc..c887c668e6 100644 --- a/extra/builder/test/test.factor +++ b/extra/builder/test/test.factor @@ -7,14 +7,6 @@ USING: kernel sequences assocs builder continuations vocabs vocabs.loader IN: builder.test -! : do-load ( -- ) -! [ -! [ load-everything ] -! [ require-all-error-vocabs "../load-everything-log" log-object ] -! recover -! ] -! "../load-everything-time" log-runtime ; - : do-load ( -- ) [ try-everything ] "../load-everything-time" log-runtime dup empty? @@ -22,22 +14,6 @@ IN: builder.test [ "../load-everything-log" log-object ] if ; -! : do-tests ( -- ) -! "" child-vocabs -! [ vocab-source-loaded? ] subset -! [ vocab-tests-path ] map -! [ dup [ ?resource-path exists? ] when ] subset -! [ dup run-test ] { } map>assoc -! [ second empty? not ] subset -! dup empty? -! [ drop ] -! [ -! "../failing-tests" -! [ [ nl failures. ] assoc-each ] -! with-stream -! ] -! if ; - : do-tests ( -- ) run-all-tests keys dup empty? From 7adb07bcc4354c8f32befc3cfce5242c6b11687e Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 8 Feb 2008 03:11:47 -0600 Subject: [PATCH 03/13] concurrency docs fix --- extra/concurrency/concurrency-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/concurrency/concurrency-docs.factor b/extra/concurrency/concurrency-docs.factor index f04811b72a..538ed847f0 100644 --- a/extra/concurrency/concurrency-docs.factor +++ b/extra/concurrency/concurrency-docs.factor @@ -138,7 +138,7 @@ ARTICLE: { "concurrency" "servers" } "Servers" ARTICLE: { "concurrency" "synchronous-sends" } "Synchronous Sends" { $link send } " sends a message asynchronously, and the sending process continues immediately. The 'pong server' example shown previously all sent messages to the server and waited for a reply back from the server. This pattern of synchronous sending is made easier with " { $link send-synchronous } ".\n\nThis word will send a message to the given process and immediately block until a reply is received for this particular message send. It leaves the reply on the stack. Note that it doesn't wait for just any reply, it waits for a reply specifically to this send.\n\nTo do this it wraps the requested message inside a tagged message format using " { $link tag-message } ":" { $code "\"My Message\" tag-message .\n => { ...from... ...tag... \"My Message\" }" } -"The message is wrapped in array where the first item is the sending process object, the second is a unique tag, and the third is the original message. Server processes can use the 'from' to reply to the process that originally sent the message. The tag can is used in the receiving server to include the value in the reply. After the send-synchronous call the current process will block waiting for a reply that has the exact same tag. In this way you can be sure that the reply you got was for the specific message sent. Here is the pong-server recoded to use 'send-synchronous':" +"The message is wrapped in array where the first item is the sending process object, the second is a unique tag, and the third is the original message. Server processes can use the 'from' to reply to the process that originally sent the message. The tag can used in the receiving server to include the value in the reply. After the send-synchronous call the current process will block waiting for a reply that has the exact same tag. In this way you can be sure that the reply you got was for the specific message sent. Here is the pong-server recoded to use 'send-synchronous':" { $code ": pong-server ( -- )\n receive {\n { { ?from ?tag \"ping\" } [ ?tag \"pong\" 2array ?from send pong-server ] }\n { { ?from _ } [ ?tag \"server shutdown\" 2array ?from send ] }\n } match-cond ;\n\n[ pong-server ] spawn \"ping\" swap send-synchronous .\n => \"pong\"" } "Notice that the code to send the reply back to the original caller wraps the reply in an array where the first item is the tag originally sent. 'send-synchronous' only returns if it receives a reply containing that specific tag." ; From 3f38bf18ec98e02af5a42422d167bc8122053b89 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 8 Feb 2008 03:14:08 -0600 Subject: [PATCH 04/13] concurrency docs fix --- extra/concurrency/concurrency-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/concurrency/concurrency-docs.factor b/extra/concurrency/concurrency-docs.factor index 538ed847f0..16a2e65a90 100644 --- a/extra/concurrency/concurrency-docs.factor +++ b/extra/concurrency/concurrency-docs.factor @@ -138,7 +138,7 @@ ARTICLE: { "concurrency" "servers" } "Servers" ARTICLE: { "concurrency" "synchronous-sends" } "Synchronous Sends" { $link send } " sends a message asynchronously, and the sending process continues immediately. The 'pong server' example shown previously all sent messages to the server and waited for a reply back from the server. This pattern of synchronous sending is made easier with " { $link send-synchronous } ".\n\nThis word will send a message to the given process and immediately block until a reply is received for this particular message send. It leaves the reply on the stack. Note that it doesn't wait for just any reply, it waits for a reply specifically to this send.\n\nTo do this it wraps the requested message inside a tagged message format using " { $link tag-message } ":" { $code "\"My Message\" tag-message .\n => { ...from... ...tag... \"My Message\" }" } -"The message is wrapped in array where the first item is the sending process object, the second is a unique tag, and the third is the original message. Server processes can use the 'from' to reply to the process that originally sent the message. The tag can used in the receiving server to include the value in the reply. After the send-synchronous call the current process will block waiting for a reply that has the exact same tag. In this way you can be sure that the reply you got was for the specific message sent. Here is the pong-server recoded to use 'send-synchronous':" +"The message is wrapped in array where the first item is the sending process object, the second is a unique tag, and the third is the original message. Server processes can use the 'from' to reply to the process that originally sent the message. The tag is used in the receiving server to include the value in the reply. After the send-synchronous call the current process will block waiting for a reply that has the exact same tag. In this way you can be sure that the reply you got was for the specific message sent. Here is the pong-server recoded to use 'send-synchronous':" { $code ": pong-server ( -- )\n receive {\n { { ?from ?tag \"ping\" } [ ?tag \"pong\" 2array ?from send pong-server ] }\n { { ?from _ } [ ?tag \"server shutdown\" 2array ?from send ] }\n } match-cond ;\n\n[ pong-server ] spawn \"ping\" swap send-synchronous .\n => \"pong\"" } "Notice that the code to send the reply back to the original caller wraps the reply in an array where the first item is the tag originally sent. 'send-synchronous' only returns if it receives a reply containing that specific tag." ; From 5570f367a631dddd2e0f42078baa15641ed12567 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 8 Feb 2008 20:09:59 -0600 Subject: [PATCH 05/13] builder: build-status variable --- extra/builder/builder.factor | 12 ++++++++++++ 1 file changed, 12 insertions(+) mode change 100755 => 100644 extra/builder/builder.factor diff --git a/extra/builder/builder.factor b/extra/builder/builder.factor old mode 100755 new mode 100644 index 9af79efb29..1c5f5ff3fd --- a/extra/builder/builder.factor +++ b/extra/builder/builder.factor @@ -59,8 +59,12 @@ VAR: stamp ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +SYMBOL: build-status + : build ( -- ) + "running" build-status set-global + datestamp >stamp "/builds/factor" cd @@ -98,6 +102,8 @@ VAR: stamp { "make" "clean" } run-process drop + ! "vm" build-status set-global + `{ { +arguments+ { "make" ,[ target ] } } { +stdout+ "../compile-log" } @@ -116,6 +122,8 @@ VAR: stamp [ "builder: image download" email-string ] cleanup + ! "bootstrap" build-status set-global + `{ { +arguments+ { ,[ factor-binary ] @@ -133,6 +141,8 @@ VAR: stamp "builder: bootstrap" throw ] if + ! "test" build-status set-global + `{ ,[ factor-binary ] "-run=builder.test" } run-process drop "../load-everything-log" exists? @@ -143,6 +153,8 @@ VAR: stamp [ "builder: failing tests" "../failing-tests" email-file ] when + ! "ready" build-status set-global + ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! From 7b07ababba5a9f95d17fa9c67fbfe006d97916cd Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 8 Feb 2008 20:16:12 -0600 Subject: [PATCH 06/13] add builder.server --- extra/builder/server/server.factor | 68 ++++++++++++++++++++++++++++++ 1 file changed, 68 insertions(+) create mode 100644 extra/builder/server/server.factor diff --git a/extra/builder/server/server.factor b/extra/builder/server/server.factor new file mode 100644 index 0000000000..672de1e47d --- /dev/null +++ b/extra/builder/server/server.factor @@ -0,0 +1,68 @@ + +USING: kernel continuations namespaces threads match bake concurrency builder ; + +IN: builder.server + +! : build-server ( -- ) +! receive +! { +! { +! "start" +! [ [ build ] in-thread ] +! } + +! { +! { ?from ?tag "status" } +! [ `{ ?tag ,[ build-status get ] } ?from send ] +! } +! } +! match-cond +! build-server ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! : build-server ( -- ) +! receive +! { +! { +! "start" +! [ +! [ [ build ] [ drop ] recover "idle" build-status set-global ] in-thread +! ] +! } + +! { +! { ?from ?tag "status" } +! [ `{ ?tag ,[ build-status get ] } ?from send ] +! } +! } +! match-cond +! build-server ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: build-server ( -- ) + receive + { + { + "start" + [ + build-status get "idle" = + build-status get f = + or + [ + [ [ build ] [ drop ] recover "idle" build-status set-global ] + in-thread + ] + when + ] + } + + { + { ?from ?tag "status" } + [ `{ ?tag ,[ build-status get ] } ?from send ] + } + } + match-cond + build-server ; + From f45f6879ab04d4d115ee91b21493471592971fb9 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 8 Feb 2008 23:28:06 -0600 Subject: [PATCH 07/13] Makefile: winnt target downloads dlls --- Makefile | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index 05a185f643..9776027a59 100755 --- a/Makefile +++ b/Makefile @@ -123,7 +123,15 @@ solaris-x86-32: solaris-x86-64: $(MAKE) $(EXECUTABLE) CONFIG=vm/Config.solaris.x86.64 -winnt-x86-32: +freetype6.dll: + wget http://factorcode.org/dlls/freetype6.dll + chmod 755 freetype6.dll + +zlib1.dll: + wget http://factorcode.org/dlls/zlib1.dll + chmod 755 zlib1.dll + +winnt-x86-32: freetype6.dll zlib1.dll $(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32 winnt-x86-64: From fdac73a4d74a05306293fddebcd39142313b3887 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 9 Feb 2008 02:15:29 -0600 Subject: [PATCH 08/13] Oops --- extra/concurrency/concurrency.factor | 33 ++++++++++++++-------------- 1 file changed, 17 insertions(+), 16 deletions(-) diff --git a/extra/concurrency/concurrency.factor b/extra/concurrency/concurrency.factor index e4972c9030..b46439b583 100755 --- a/extra/concurrency/concurrency.factor +++ b/extra/concurrency/concurrency.factor @@ -264,12 +264,7 @@ PRIVATE> #! so the server continuation gets its new self updated. self swap call ; -TUPLE: future value processes ; - -: notify-future ( value future -- ) - tuck set-future-value - dup future-processes [ schedule-thread ] each - f swap set-future-processes ; +TUPLE: future status value processes ; : future ( quot -- future ) #! Spawn a process to call the quotation and immediately return @@ -277,22 +272,28 @@ TUPLE: future value processes ; #! ?future. If the quotation has completed the result will be returned. #! If not, the process will block until the quotation completes. #! 'quot' must have stack effect ( -- X ). - \ future construct-empty [ + [ [ - >r [ t 2array ] compose [ f 2array ] recover r> - notify-future - ] 2curry spawn drop - ] keep ; + t + ] compose + ] spawn drop + [ self send ] compose spawn ; : ?future ( future -- result ) #! Block the process until the future has completed and then #! place the result on the stack. Return the result #! immediately if the future has completed. - dup future-value [ - first2 [ throw ] unless - ] [ - dup [ future-processes push stop ] curry callcc0 ?future - ] ?if ; + process-mailbox mailbox-get ; + +: parallel-map ( seq quot -- newseq ) + #! Spawn a process to apply quot to each element of seq, + #! joining the results into a sequence at the end. + [ curry future ] curry map [ ?future ] map ; + +: parallel-each ( seq quot -- ) + #! Spawn a process to apply quot to each element of seq, + #! and waits for all processes to complete. + [ f ] compose parallel-map drop ; TUPLE: promise fulfilled? value processes ; From 7fbbe94d80c473c94f5b11f558cda2f5977d78d2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 9 Feb 2008 02:19:26 -0600 Subject: [PATCH 09/13] FEP work in progress --- vm/debug.c | 35 ++++++++++++++++++++++++++++++++++- 1 file changed, 34 insertions(+), 1 deletion(-) diff --git a/vm/debug.c b/vm/debug.c index 5b4320b5e9..01e1ab0f43 100755 --- a/vm/debug.c +++ b/vm/debug.c @@ -38,6 +38,9 @@ void print_array(F_ARRAY* array, CELL nesting) CELL length = array_capacity(array); CELL i; + if(length > 10) + length = 10; + for(i = 0; i < length; i++) { printf(" "); @@ -201,7 +204,7 @@ void dump_objects(F_FIXNUM type) if(type == -1 || type_of(obj) == type) { printf("%lx ",obj); - print_nested_obj(obj,3); + print_nested_obj(obj,1); printf("\n"); } } @@ -210,6 +213,36 @@ void dump_objects(F_FIXNUM type) gc_off = false; } +CELL obj; +CELL look_for; + +void find_references_step(CELL *scan) +{ + if(look_for == *scan) + { + printf("%lx ",obj); + print_nested_obj(obj,1); + printf("\n"); + } +} + +void find_references(CELL look_for_) +{ + look_for = look_for_; + + begin_scan(); + + CELL obj_; + while((obj_ = next_object()) != F) + { + obj = obj_; + do_slots(obj_,find_references_step); + } + + /* end scan */ + gc_off = false; +} + void factorbug(void) { reset_stdio(); From e9a63d7a2c2d080e778a3f3e8bd4b99d2867588f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 9 Feb 2008 14:10:52 -0600 Subject: [PATCH 10/13] Arrggh --- extra/concurrency/concurrency.factor | 34 ++++++++++++++++++---------- 1 file changed, 22 insertions(+), 12 deletions(-) diff --git a/extra/concurrency/concurrency.factor b/extra/concurrency/concurrency.factor index b46439b583..3c8011cc6b 100755 --- a/extra/concurrency/concurrency.factor +++ b/extra/concurrency/concurrency.factor @@ -264,26 +264,36 @@ PRIVATE> #! so the server continuation gets its new self updated. self swap call ; -TUPLE: future status value processes ; +TUPLE: future value processes ; +: notify-future ( value future -- ) + tuck set-future-value + dup future-processes [ schedule-thread ] each + f swap set-future-processes ; + : future ( quot -- future ) - #! Spawn a process to call the quotation and immediately return - #! a 'future' on the stack. The future can later be queried with - #! ?future. If the quotation has completed the result will be returned. - #! If not, the process will block until the quotation completes. - #! 'quot' must have stack effect ( -- X ). + #! Spawn a process to call the quotation and immediately return. + \ future construct-empty [ [ [ + >r [ t 2array ] compose [ f 2array ] recover r> + notify-future + ] 2curry spawn drop + ] keep ; t ] compose ] spawn drop [ self send ] compose spawn ; - -: ?future ( future -- result ) - #! Block the process until the future has completed and then - #! place the result on the stack. Return the result - #! immediately if the future has completed. - process-mailbox mailbox-get ; + + : ?future ( future -- result ) + #! Block the process until the future has completed and then + #! place the result on the stack. Return the result + #! immediately if the future has completed. + dup future-value [ + first2 [ throw ] unless + ] [ + dup [ future-processes push stop ] curry callcc0 ?future + ] ?if ; : parallel-map ( seq quot -- newseq ) #! Spawn a process to apply quot to each element of seq, From 3121e740f2838d6d29ef0e1291fd8da670bb2416 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 9 Feb 2008 14:12:14 -0600 Subject: [PATCH 11/13] Fix typo --- core/continuations/continuations-docs.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor index 2977d02c6f..7cf15394ef 100755 --- a/core/continuations/continuations-docs.factor +++ b/core/continuations/continuations-docs.factor @@ -169,7 +169,7 @@ HELP: rethrow HELP: throw-restarts { $values { "error" object } { "restarts" "a sequence of " { $snippet "{ string object }" } " pairs" } { "restart" object } } -{ $description "Throws a restartable error using " { $link throw } ". The " { $snippet "restarts" } " parameter is a sequence of pairs where the first element in each pair is a human-readable description and the second is an arbitrary object. If the error reaches the top-level error handler, the user will be presented with the list of possible restarts, and upon invoking one, execution will continue after the call to " { $link condition } " with the object associated to the chosen restart on the stack." } +{ $description "Throws a restartable error using " { $link throw } ". The " { $snippet "restarts" } " parameter is a sequence of pairs where the first element in each pair is a human-readable description and the second is an arbitrary object. If the error reaches the top-level error handler, the user will be presented with the list of possible restarts, and upon invoking one, execution will continue after the call to " { $link throw-restarts } " with the object associated to the chosen restart on the stack." } { $examples "Try invoking one of the two restarts which are offered after the below code throws an error:" { $code From 25c64c8ac713cc94bf706124900f3658e3e34167 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 9 Feb 2008 14:13:06 -0600 Subject: [PATCH 12/13] Arrghh!!! --- extra/concurrency/concurrency.factor | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/extra/concurrency/concurrency.factor b/extra/concurrency/concurrency.factor index 3c8011cc6b..50abee8418 100755 --- a/extra/concurrency/concurrency.factor +++ b/extra/concurrency/concurrency.factor @@ -280,15 +280,11 @@ TUPLE: future value processes ; notify-future ] 2curry spawn drop ] keep ; - t - ] compose - ] spawn drop - [ self send ] compose spawn ; : ?future ( future -- result ) - #! Block the process until the future has completed and then - #! place the result on the stack. Return the result - #! immediately if the future has completed. + #! Block the process until the future has completed and then + #! place the result on the stack. Return the result + #! immediately if the future has completed. dup future-value [ first2 [ throw ] unless ] [ From a21781e3807d1c89cba88989cb694e65d81d0ee3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 9 Feb 2008 14:14:37 -0600 Subject: [PATCH 13/13] Concurrency fix --- extra/concurrency/concurrency.factor | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/extra/concurrency/concurrency.factor b/extra/concurrency/concurrency.factor index 50abee8418..a8e0bc6eeb 100755 --- a/extra/concurrency/concurrency.factor +++ b/extra/concurrency/concurrency.factor @@ -270,11 +270,10 @@ TUPLE: future value processes ; tuck set-future-value dup future-processes [ schedule-thread ] each f swap set-future-processes ; - + : future ( quot -- future ) #! Spawn a process to call the quotation and immediately return. \ future construct-empty [ - [ [ >r [ t 2array ] compose [ f 2array ] recover r> notify-future