Merge branch 'master' of git://factorcode.org/git/factor
Matthew Willis
commit
85e08ab853
10
Makefile
10
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:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 bootstrap.image.download ;
|
||||
|
||||
IN: builder
|
||||
|
||||
|
|
@ -59,8 +59,12 @@ VAR: stamp
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
SYMBOL: build-status
|
||||
|
||||
: build ( -- )
|
||||
|
||||
"running" build-status set-global
|
||||
|
||||
datestamp >stamp
|
||||
|
||||
"/builds/factor" cd
|
||||
|
|
@ -70,7 +74,6 @@ VAR: stamp
|
|||
"pull"
|
||||
"--no-summary"
|
||||
"git://factorcode.org/git/factor.git"
|
||||
! "http://dharmatech.onigirihouse.com/factor.git"
|
||||
"master"
|
||||
}
|
||||
run-process process-status
|
||||
|
|
@ -82,6 +85,11 @@ VAR: stamp
|
|||
]
|
||||
if
|
||||
|
||||
{
|
||||
"git" "pull" "--no-summary"
|
||||
"http://dharmatech.onigirihouse.com/factor.git" "master"
|
||||
} run-process drop
|
||||
|
||||
"/builds/" stamp> append make-directory
|
||||
"/builds/" stamp> append cd
|
||||
|
||||
|
|
@ -94,6 +102,8 @@ VAR: stamp
|
|||
|
||||
{ "make" "clean" } run-process drop
|
||||
|
||||
! "vm" build-status set-global
|
||||
|
||||
`{
|
||||
{ +arguments+ { "make" ,[ target ] } }
|
||||
{ +stdout+ "../compile-log" }
|
||||
|
|
@ -107,14 +117,17 @@ 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
|
||||
|
||||
! "bootstrap" build-status set-global
|
||||
|
||||
`{
|
||||
{ +arguments+ {
|
||||
,[ factor-binary ]
|
||||
,[ "-i=" boot-image-name append ]
|
||||
,[ "-i=" my-boot-image-name append ]
|
||||
"-no-user-init"
|
||||
} }
|
||||
{ +stdout+ "../boot-log" }
|
||||
|
|
@ -128,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?
|
||||
|
|
@ -138,6 +153,8 @@ VAR: stamp
|
|||
[ "builder: failing tests" "../failing-tests" email-file ]
|
||||
when
|
||||
|
||||
! "ready" build-status set-global
|
||||
|
||||
;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
@ -8,27 +8,17 @@ 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 ;
|
||||
[ 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
|
||||
run-all-tests keys
|
||||
dup empty?
|
||||
[ drop ]
|
||||
[
|
||||
"../failing-tests" <file-writer>
|
||||
[ [ nl failures. ] assoc-each ]
|
||||
with-stream
|
||||
]
|
||||
[ "../failing-tests" log-object ]
|
||||
if ;
|
||||
|
||||
: do-all ( -- ) do-load do-tests ;
|
||||
|
|
|
|||
|
|
@ -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 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." ;
|
||||
|
||||
|
|
|
|||
|
|
@ -272,19 +272,15 @@ TUPLE: future value processes ;
|
|||
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 ;
|
||||
|
||||
: ?future ( future -- result )
|
||||
|
||||
: ?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.
|
||||
|
|
@ -294,6 +290,16 @@ TUPLE: future value processes ;
|
|||
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,
|
||||
#! 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 ;
|
||||
|
||||
: <promise> ( -- <promise> )
|
||||
|
|
|
|||
35
vm/debug.c
35
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();
|
||||
|
|
|
|||
Loading…
Reference in New Issue