Merge branch 'master' of http://dharmatech.onigirihouse.com/factor

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:

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

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

extra/builder/test/test.factor

@@ -8,27 +8,17 @@ USING: kernel sequences assocs builder continuations vocabs vocabs.loader
 IN: builder.test
 
 : do-load ( -- )
-  [
+  [ try-everything ] "../load-everything-time" log-runtime
-    [ load-everything ]
+  dup empty?
-    [ require-all-error-vocabs "../load-everything-log" log-object ]
+    [ drop ]
-    recover
+    [ "../load-everything-log" log-object ]
-  ]
+  if ;
-  "../load-everything-time" log-runtime ;
 
 : do-tests ( -- )
-  "" child-vocabs
+  run-all-tests keys
-  [ 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" log-object ]
-    "../failing-tests" <file-writer>
-      [ [ nl failures. ] assoc-each ]
-    with-stream
-  ]
   if ;
 
 : do-all ( -- ) do-load do-tests ;

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