multitasking

TODO.FACTOR.txt

@@ -8,8 +8,6 @@
 - balance needs USE:
 - command line arguments
 - socket protocol
-- irc: stack underflow?
-- ignore SIGPIPE
 
 + docs:
 
@@ -39,6 +37,9 @@
 
 + native:
 
+- irc: stack underflow?
+- ignore SIGPIPE
+- don't allow multiple i/o requests on the same port
 - accept multi-line input in listener
 - gc call in the middle of some ops might affect callstack
 - multitasking

library/platform/native/boot-stage2.factor

@@ -58,6 +58,7 @@ USE: stdio
     "/library/continuations.factor"
     "/library/platform/native/errors.factor"
     "/library/errors.factor"
+    "/library/platform/native/threads.factor"
     "/library/stream.factor"
     "/library/platform/native/io-internals.factor"
     "/library/platform/native/stream.factor"

library/platform/native/boot.factor

@@ -53,6 +53,7 @@ primitives,
     "/library/continuations.factor"
     "/library/platform/native/errors.factor"
     "/library/errors.factor"
+    "/library/platform/native/threads.factor"
     "/library/stream.factor"
     "/library/platform/native/io-internals.factor"
     "/library/platform/native/stream.factor"

library/platform/native/init.factor

@@ -33,6 +33,7 @@ USE: namespaces
 USE: parser
 USE: stdio
 USE: streams
+USE: threads
 USE: words
 
 : init-gc ( -- )
@@ -42,6 +43,7 @@ USE: words
     #! Initialize an interpreter with the basic services.
     init-gc
     init-namespaces
+    init-threads
     init-stdio
     init-errors
     "HOME" os-env [ "." ] unless* "~" set

library/platform/native/io-internals.factor

@@ -32,18 +32,12 @@ USE: kernel
 USE: namespaces
 USE: stack
 USE: strings
+USE: threads
 
 : stdin 0 getenv ;
 : stdout 1 getenv ;
 : stderr 2 getenv ;
 
-: yield ( -- )
-    next-io-task dup [
-        call
-    ] [
-        drop yield
-    ] ifte ;
-
 : flush-fd ( port -- )
     [ swap add-write-io-task yield ] callcc0 drop ;
 

library/platform/native/threads.factor

@@ -0,0 +1,65 @@
+! :folding=none:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+IN: threads
+USE: combinators
+USE: continuations
+USE: io-internals
+USE: kernel
+USE: lists
+USE: namespaces
+USE: stack
+USE: strings
+
+: run-queue ( -- queue )
+    9 getenv ;
+
+: set-run-queue ( queue -- )
+    9 setenv ;
+
+: init-threads ( -- )
+    f set-run-queue ;
+
+: next-thread ( -- quot )
+    run-queue dup [ uncons set-run-queue ] when ;
+
+: schedule-thread ( quot -- )
+    run-queue cons set-run-queue ;
+
+: yield ( -- )
+    next-thread dup [
+        call
+    ] [
+        drop next-io-task dup [
+            call
+        ] [
+            drop yield
+        ] ifte
+    ] ifte ;
+
+: in-thread ( quot -- )
+    [ schedule-thread call yield ] callcc0 drop ;

library/vocabularies.factor

@@ -95,6 +95,7 @@ USE: strings
         "stdio"
         "strings"
         "test"
+        "threads"
         "trace"
         "unparser"
         "vectors"

native/run.h

@@ -3,12 +3,13 @@
 #define STDIN_ENV      0
 #define STDOUT_ENV     1
 #define STDERR_ENV     2
-#define NAMESTACK_ENV  3
+#define NAMESTACK_ENV  3 /* used by library only */
 #define GLOBAL_ENV     4
 #define BREAK_ENV      5
-#define CATCHSTACK_ENV 6
+#define CATCHSTACK_ENV 6 /* used by library only */
 #define GC_ENV         7
 #define BOOT_ENV       8
+#define RUNQUEUE_ENV   9 /* used by library only */
 
 /* Error handlers restore this */
 sigjmp_buf toplevel;