in-thread error handling fixed

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

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;
 	} //}}}
 }

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
+        "Stacks have been reset." print
-    ":s :r :n :c show stacks at time of error." print
+        ":s :r :n :c show stacks at time of error." print
 
-    java? [ ":j shows Java stack trace." print ] when
+        java? [ ":j shows Java stack trace." print ] when
-
+    ] when* ;
-    suspend ;
 
 : :s ( -- ) "error-datastack"  get . ;
 : :r ( -- ) "error-callstack"  get . ;

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"

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

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

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

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 */
+/*** Header types ***/
-#define GC_COLLECTED 6
 
 /* Canonical F object */
 #define F_TYPE 6