Slava Pestov 2008-02-09 01:57:51 -06:00
commit e00db87a0c
5 changed files with 108 additions and 25 deletions

View File

@ -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:

29
extra/builder/builder.factor Executable file → Normal file
View File

@ -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
;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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." ;