From 9850e33cc5571e9b4aa1b4d7faec38d6b296fe87 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Wed, 28 Jul 2004 00:23:08 +0000
Subject: [PATCH] in-thread error handling fixed

---
 TODO.FACTOR.txt                       |   4 ++--
 factor/.FactorInterpreter.java.marks  | Bin 45 -> 45 bytes
 factor/FactorInterpreter.java         |   6 +++++-
 library/debugger.factor               |  12 ++++++------
 library/platform/jvm/kernel.factor    |   8 +++++++-
 library/platform/jvm/threads.factor   |   7 ++++++-
 library/platform/native/errors.factor |   2 +-
 library/sbuf.factor                   |   5 ++++-
 native/types.h                        |   6 +++---
 9 files changed, 34 insertions(+), 16 deletions(-)

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 4ade0f7f1d..67e3c3df23 100644
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -12,6 +12,8 @@
 - partition, sort
 - inspector: sort
 - index of str
+- accept: return socket, instead of printing msg
+- use div(3)
 
 + interactive:
 
@@ -45,9 +47,7 @@
 
 + misc:
 
-- error handling and threads
 - should i -i inf -inf be parsing words?
-- fix multithreading
 - namespace clone drops static var bindings
 - ditch map
 - ditch expand
diff --git a/factor/.FactorInterpreter.java.marks b/factor/.FactorInterpreter.java.marks
index c699161e890a9cd0946ca962108a656461f5a021..fcf0aa17fb70bc70ec3a7694cb1bb6366b406a92 100644
GIT binary patch
literal 45
kcmY#Pv^F#_G&g~eT#5|VhK3dfW)Kp>wKOmXa)Bfl0K?%3LjV8(

literal 45
kcmY#Pv^F#_G%<&eT#5|VhKA<mmJkxcwXiS%a)Bfl0L57dRR910

diff --git a/factor/FactorInterpreter.java b/factor/FactorInterpreter.java
index 66afc6ff22..331b76cc8a 100644
--- a/factor/FactorInterpreter.java
+++ b/factor/FactorInterpreter.java
@@ -113,6 +113,7 @@ public class FactorInterpreter implements FactorObject, Runnable
 		this.builtins = interp.builtins;
 		this.last = interp.last;
 		this.global = interp.global;
+		this.startupDone = true;
 	} //}}}
 
 	//{{{ init() method
@@ -627,9 +628,12 @@ public class FactorInterpreter implements FactorObject, Runnable
 		define("kernel","exit*");
 		catchstack.push(new Cons(new Integer(1),
 			new Cons(searchVocabulary("kernel","exit*"),null)));
+		define("continuations","suspend");
 		define("errors","default-error-handler");
 		catchstack.push(new Cons(searchVocabulary("errors",
-			"default-error-handler"),null));
+			"default-error-handler"),
+			new Cons(searchVocabulary("continuations","suspend"),
+			null)));
 		callframe = null;
 	} //}}}
 }
diff --git a/library/debugger.factor b/library/debugger.factor
index 9dfac559dd..3a10f6994d 100644
--- a/library/debugger.factor
+++ b/library/debugger.factor
@@ -56,14 +56,14 @@ USE: unparser
 
 : default-error-handler ( error -- )
     #! Print the error and return to the top level.
-    in-parser? [ parse-dump ] [ standard-dump ] ifte terpri
+    [
+        in-parser? [ parse-dump ] [ standard-dump ] ifte terpri
 
-    "Stacks have been reset." print
-    ":s :r :n :c show stacks at time of error." print
+        "Stacks have been reset." print
+        ":s :r :n :c show stacks at time of error." print
 
-    java? [ ":j shows Java stack trace." print ] when
-
-    suspend ;
+        java? [ ":j shows Java stack trace." print ] when
+    ] when* ;
 
 : :s ( -- ) "error-datastack"  get . ;
 : :r ( -- ) "error-callstack"  get . ;
diff --git a/library/platform/jvm/kernel.factor b/library/platform/jvm/kernel.factor
index 74054ccdd7..9459a1ad48 100644
--- a/library/platform/jvm/kernel.factor
+++ b/library/platform/jvm/kernel.factor
@@ -90,9 +90,15 @@ IN: kernel
 : garbage-collection ( -- )
     [ ] "java.lang.System" "gc" jinvoke-static ;
 
+IN: arithmetic
+DEFER: >bignum
+
+IN: kernel
+
 : millis ( -- millis )
     ! Pushes the current time, in milliseconds.
-    [ ] "java.lang.System" "currentTimeMillis" jinvoke-static ;
+    [ ] "java.lang.System" "currentTimeMillis" jinvoke-static
+    >bignum ;
 
 : system-property ( name -- value )
     [ "java.lang.String" ] "java.lang.System" "getProperty"
diff --git a/library/platform/jvm/threads.factor b/library/platform/jvm/threads.factor
index dc4001c3ad..215ecbce01 100644
--- a/library/platform/jvm/threads.factor
+++ b/library/platform/jvm/threads.factor
@@ -29,6 +29,7 @@ IN: threads
 
 USE: combinators
 USE: continuations
+USE: errors
 USE: kernel
 USE: stack
 
@@ -66,4 +67,8 @@ USE: stack
 
 : in-thread ( quot -- )
     #! Execute a quotation in a new thread.
-    fork [ call toplevel ] [ drop ] ifte ; interpret-only
+    fork [
+        [ call ] [ default-error-handler toplevel ] catch
+    ] [
+        drop
+    ] ifte ; interpret-only
diff --git a/library/platform/native/errors.factor b/library/platform/native/errors.factor
index b7b408067b..cf59f9fa31 100644
--- a/library/platform/native/errors.factor
+++ b/library/platform/native/errors.factor
@@ -82,5 +82,5 @@ DEFER: default-error-handler
 : init-errors ( -- )
     64 <vector> set-catchstack*
     [ 1 exit* ] >c ( last resort )
-    [ default-error-handler ] >c
+    [ default-error-handler suspend ] >c
     [ throw ] 5 setenv ( kernel calls on error ) ;
diff --git a/library/sbuf.factor b/library/sbuf.factor
index 6f3ca6e417..924aa7a98a 100644
--- a/library/sbuf.factor
+++ b/library/sbuf.factor
@@ -44,7 +44,7 @@ USE: stack
     #! Append a string to the construction buffer.
     "string-buffer" get sbuf-append ;
 
-: %> ( -- )
+: %> ( -- str )
     #! Ends construction and pushes the constructed text on the
     #! stack.
     "string-buffer" get sbuf>str n> drop ;
@@ -55,4 +55,7 @@ USE: stack
     <% swap [ dup % ] times drop %> ;
 
 : str-map ( str code -- str )
+    #! Apply a quotation to each character in the string, and
+    #! push a new string constructed from return values.
+    #! The quotation must have stack effect ( X -- X ).
     <% swap [ swap dup >r call % r> ] str-each drop %> ;
diff --git a/native/types.h b/native/types.h
index 35db8c7504..fd3e52a261 100644
--- a/native/types.h
+++ b/native/types.h
@@ -4,16 +4,16 @@
 #define RETAG(cell,tag) ((CELL)(cell) | (tag))
 #define UNTAG(cell) ((CELL)(cell) & ~TAG_MASK)
 
-/* Tags */
+/*** Tags ***/
 #define FIXNUM_TYPE 0
 #define WORD_TYPE 1
 #define CONS_TYPE 2
 #define OBJECT_TYPE 3
 #define HEADER_TYPE 4
 #define XT_TYPE 5
+#define GC_COLLECTED 6 /* See gc.c */
 
-/* See gc.c */
-#define GC_COLLECTED 6
+/*** Header types ***/
 
 /* Canonical F object */
 #define F_TYPE 6