some miscellaneous error handling and bootstrapping cleanups

TODO.FACTOR.txt

@@ -6,7 +6,6 @@
 - jvm factor -- still supporting httpd?
 - make inferior.factor nicer to use
 - telnetd printing signal 13, and other problems
-- check error callstack, not enough >pop>?
 
 + docs:
 
@@ -74,7 +73,6 @@
 - namespace clone drops static var bindings
 - ditch expand
 - set-object-path
-- more readable traces
 - telnetd: send errors on socket
 - contains ==> contains?
 

library/continuations.factor

@@ -68,10 +68,3 @@ USE: vectors
     #! the point after the callcc1 call, and places X at the top
     #! of the original datastack.
     [ [ continue1 ] (callcc) ] reify ;
-
-: suspend ( -- )
-    "top-level-continuation" get dup [
-        call
-    ] [
-        toplevel
-    ] ifte ;

library/errors.factor

@@ -53,8 +53,8 @@ USE: vectors
             "error-line" set
             "error-col" set
             "error" set
-            datastack >pop> "error-datastack" set
-            callstack >pop> >pop> "error-callstack" set
+            datastack "error-datastack" set
+            callstack "error-callstack" set
             namestack "error-namestack" set
             catchstack "error-catchstack" set
         ] bind

library/init.factor

@@ -117,5 +117,8 @@ USE: words
     [
         interpreter-loop
     ] [
-        [ default-error-handler suspend ] when*
+        [
+            default-error-handler
+            "top-level-continuation" get call
+        ] when*
     ] catch ;

library/platform/native/boot-stage2.factor

@@ -72,12 +72,12 @@ USE: stdio
     "/library/platform/native/parse-syntax.factor"
     "/library/platform/native/parse-stream.factor"
     "/library/platform/native/unparser.factor"
-    "/library/format.factor"
+
     "/library/styles.factor"
     "/library/vocabulary-style.factor"
     "/library/prettyprint.factor"
-    "/library/debugger.factor"
     "/library/platform/native/debugger.factor"
+    "/library/debugger.factor"
     "/library/platform/native/init.factor"
 
     "/library/math/math.factor"

library/platform/native/boot.factor

@@ -66,13 +66,8 @@ primitives,
     "/library/platform/native/parser.factor"
     "/library/platform/native/parse-syntax.factor"
     "/library/platform/native/parse-stream.factor"
-    "/library/platform/native/unparser.factor"
     "/library/format.factor"
-    "/library/styles.factor"
-    "/library/vocabulary-style.factor"
-    "/library/prettyprint.factor"
-    "/library/debugger.factor"
-    "/library/platform/native/debugger.factor"
+    "/library/platform/native/unparser.factor"
     "/library/platform/native/init.factor"
 ] [
     cross-compile-resource

library/platform/native/debugger.factor

@@ -94,6 +94,7 @@ USE: vectors
         signal-error
         io-task-twice-error
         no-io-tasks-error
+        profiling-disabled-error
     } vector-nth execute ;
 
 : kernel-error? ( obj -- ? )

library/platform/native/errors.factor

@@ -35,12 +35,3 @@ USE: vectors
 : catchstack ( -- cs ) catchstack* clone ;
 : set-catchstack* ( cs -- ) 6 setenv ;
 : set-catchstack ( cs -- ) clone set-catchstack* ;
-
-DEFER: >c
-DEFER: throw
-
-: init-errors ( -- )
-    64 <vector> set-catchstack*
-    [ 1 exit* ] >c ( last resort )
-    [ default-error-handler 1 exit* ] >c
-    [ throw ] 5 setenv ( kernel calls on error ) ;

library/platform/native/init-stage2.factor

@@ -41,11 +41,17 @@ USE: words
 
 : cli-args ( -- args ) 10 getenv ;
 
+: init-error-handler ( -- )
+    [ 1 exit* ] >c ( last resort )
+    [ default-error-handler 1 exit* ] >c
+    [ throw ] 5 setenv ( kernel calls on error ) ;
+
 : warm-boot ( -- )
     #! A fully bootstrapped image has this as the boot
     #! quotation.
     boot
 
+    init-error-handler
     init-random
     "stdio" get <ansi-stream> "stdio" set
 

library/platform/native/init.factor

@@ -35,6 +35,10 @@ USE: stdio
 USE: streams
 USE: threads
 USE: words
+USE: vectors
+
+: init-errors ( -- )
+    64 <vector> set-catchstack* ;
 
 : init-gc ( -- )
     [ garbage-collection ] 7 setenv ;
@@ -42,10 +46,10 @@ USE: words
 : boot ( -- )
     #! Initialize an interpreter with the basic services.
     init-gc
+    init-errors
     init-namespaces
     init-threads
     init-stdio
-    init-errors
     "HOME" os-env [ "." ] unless* "~" set
     10 "base" set
     "/" "/" set

library/platform/native/kernel.factor

@@ -25,15 +25,9 @@
 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-IN: namespaces
-DEFER: init-namespaces
-
 IN: vectors
 DEFER: vector=
 
-IN: errors
-DEFER: init-errors
-
 IN: kernel
 USE: arithmetic
 USE: combinators
@@ -105,12 +99,6 @@ USE: vectors
         [ 103 | "fixnum/bignum/ratio/float/complex" ]
     ] assoc ;
 
-: toplevel ( -- )
-    init-namespaces
-    init-errors
-    0 <vector> set-datastack
-    0 <vector> set-callstack ;
-
 : java? f ;
 : native? t ;
 

native/error.c

@@ -30,11 +30,6 @@ void throw_error(CELL error)
 	dpush(error);
 	/* Execute the 'throw' word */
 	call(userenv[BREAK_ENV]);
-	if(callframe == 0)
-	{
-		/* Crash at startup */
-		fatal_error("Error thrown before BREAK_ENV set",error);
-	}
 
 	/* Return to run() method */
 	siglongjmp(toplevel,1);
@@ -43,6 +38,20 @@ void throw_error(CELL error)
 void general_error(CELL error, CELL tagged)
 {
 	CONS* c = cons(error,tag_cons(cons(tagged,F)));
+	if(userenv[BREAK_ENV] == 0)
+	{
+		/* Crash at startup */
+		fprintf(stderr,"Error thrown before BREAK_ENV set\n");
+		fprintf(stderr,"Error #%d\n",to_fixnum(error));
+		if(error == ERROR_TYPE)
+		{
+			fprintf(stderr,"Type #%d\n",to_fixnum(
+				untag_cons(tagged)->car));
+			fprintf(stderr,"Got type #%d\n",type_of(
+				untag_cons(tagged)->cdr));
+		}
+		exit(1);
+	}
 	throw_error(tag_cons(c));
 }
 

native/factor.h

@@ -40,8 +40,8 @@ typedef unsigned short CHAR;
 and allows profiling. */
 #define EXTRA_CALL_INFO
 
-#include "error.h"
 #include "memory.h"
+#include "error.h"
 #include "gc.h"
 #include "types.h"
 #include "array.h"

native/run.c

@@ -129,7 +129,7 @@ void primitive_setenv(void)
 void primitive_profiling(void)
 {
 #ifndef EXTRA_CALL_INFO
-	general_error(PROFILING_DISABLED,F);
+	general_error(ERROR_PROFILING_DISABLED,F);
 #else
 	CELL d = dpop();
 	if(d == F)

native/run.h

@@ -43,11 +43,6 @@ CELL userenv[USER_ENV];
 /* This ensures that words in the user's interpreter do not count */
 CELL profile_depth;
 
-void signal_handler(int signal, siginfo_t* siginfo, void* uap);
-void profiling_step(int signal, siginfo_t* siginfo, void* uap);
-void init_signals(void);
-void clear_environment(void);
-
 INLINE CELL dpop(void)
 {
 	ds -= CELLS;
@@ -100,6 +95,11 @@ INLINE void call(CELL quot)
 	callframe = quot;
 }
 
+void signal_handler(int signal, siginfo_t* siginfo, void* uap);
+void profiling_step(int signal, siginfo_t* siginfo, void* uap);
+void init_signals(void);
+void clear_environment(void);
+
 void run(void);
 void undefined(void);
 void docol(void);

native/stack.h

@@ -1,5 +1,5 @@
-#define STACK_UNDERFLOW(stack,bot) ((stack) < UNTAG(bot) + sizeof(ARRAY))
-#define STACK_OVERFLOW(stack,bot) ((stack) >= UNTAG(bot) + object_size(bot))
+#define STACK_UNDERFLOW(stack,bot) ((stack) < UNTAG(bot))
+#define STACK_OVERFLOW(stack,bot) ((stack) >= UNTAG(bot) + STACK_SIZE)
 
 void reset_datastack(void);
 void reset_callstack(void);