Clean up exception handling in callbacks

TODO.FACTOR.txt

@@ -1,8 +1,5 @@
 - if two tasks write to a unix stream, the buffer can overflow
 - x86 SIB addressing modes
-- exceptions inside callbacks are broken:
-  - we need to unwind the stacks to the level where the exception handler
-    was set
 - "localhost" 50 <client> won't fail
 - compiled gc check slows things down
 

library/alien/alien-callback.factor

@@ -55,7 +55,8 @@ M: alien-callback-error summary ( error -- )
 : linearize-callback ( node -- )
     dup alien-callback-xt [
         dup alien-callback-parameters registers>objects
-        dup alien-callback-quot %alien-callback ,
+        dup alien-callback-quot \ init-error-handler swons
+        %alien-callback ,
         unbox-return
         %return ,
     ] make-linear ;

library/errors.factor

@@ -14,8 +14,7 @@ TUPLE: no-method object generic ;
     [ >c call f c> drop f ] callcc1 nip ; inline
 
 : rethrow ( error -- )
-    catchstack* empty?
+    catchstack* empty? [ die ] [ c> continue-with ] if ;
-    [ die "Can't happen" throw ] [ c> continue-with ] if ;
 
 : cleanup ( try cleanup -- | try: -- | cleanup: -- )
     [ >c >r call c> drop r> call ]

library/test/compiler/callbacks.factor

@@ -12,9 +12,9 @@ FUNCTION: void callback_test_1 void* callback ; compiled
 
 [ ] [ callback-1 callback_test_1 ] unit-test
 
-! : callback-2 "void" { } [ 5 throw ] alien-callback ; compiled
+: callback-2 "void" { } [ [ 5 throw ] catch drop ] alien-callback ; compiled
-! 
+
-! [ 5 ] [ [ callback-2 callback_test_1 ] catch ] unit-test
+[ ] [ callback-2 callback_test_1 ] unit-test
 
 : callback-3 "void" { } [ 5 "x" set ] alien-callback ; compiled
 

native/error.c

@@ -37,7 +37,7 @@ void throw_error(CELL error, bool keep_stacks)
 	thrown_executing = executing;
 
 	/* Return to run() method */
-	LONGJMP(toplevel,1);
+	LONGJMP(stack_chain->toplevel,1);
 }
 
 void primitive_throw(void)

native/gc.c

@@ -74,16 +74,21 @@ void collect_roots(void)
 
 	while(stacks)
 	{
-		copy_handle(&stacks->callframe);
+		/* these two pointers are only set in inactive states */
-		
+		if(stacks != stack_chain)
-		CELL bottom = stacks->ds_region->start;
+		{
-		CELL top = stacks->ds;
+			copy_handle(&stacks->callframe);
+			copy_handle(&stacks->catch_save);
+		}
+
+		CELL bottom = stacks->data_region->start;
+		CELL top = stacks->data;
 		
 		for(ptr = bottom; ptr <= top; ptr += CELLS)
 			copy_handle((CELL*)ptr);
 	
-		bottom = stacks->cs_region->start;
+		bottom = stacks->call_region->start;
-		top = stacks->cs;
+		top = stacks->call;
 		
 		for(ptr = bottom; ptr <= top; ptr += CELLS)
 			copy_handle((CELL*)ptr);

native/macosx/run.m

@@ -7,14 +7,14 @@ void platform_run()
 {
 	for(;;)
 	{
-		SETJMP(toplevel);
+		SETJMP(stack_chain->toplevel);
 		handle_error();
 NS_DURING
-		run(false);
+		run();
 		NS_VOIDRETURN;
 NS_HANDLER
         	general_error(ERROR_OBJECTIVE_C,
-			tag_object(make_alien(F,localException)),
+			tag_object(make_alien(F,(CELL)localException)),
 			true);
 NS_ENDHANDLER
 	}

native/run.c

@@ -31,16 +31,10 @@ void handle_error(void)
 	}
 }
 
-void run(bool handle_errors)
+void run(void)
 {
 	CELL next;
 
-	if(handle_errors)
-	{
-		SETJMP(toplevel);
-		handle_error();
-	}
-	
 	for(;;)
 	{
 		if(callframe == F)
@@ -74,14 +68,16 @@ void run(bool handle_errors)
 
 void run_toplevel(void)
 {
-	run(true);
+	SETJMP(stack_chain->toplevel);
+	handle_error();
+	run();
 }
 
 /* Called by compiled callbacks after nest_stacks() and boxing registers */
 void run_callback(CELL quot)
 {
 	call(quot);
-	run(false);
+	platform_run();
 }
 
 /* XT of deferred words */

native/run.h

@@ -22,9 +22,6 @@
 /* TAGGED user environment data; see getenv/setenv prims */
 DLLEXPORT CELL userenv[USER_ENV];
 
-/* Error handlers restore this */
-JMP_BUF toplevel;
-
 INLINE CELL dpop(void)
 {
 	CELL value = get(ds);
@@ -79,7 +76,7 @@ INLINE void call(CELL quot)
 }
 
 void handle_error();
-void run(bool handle_errors);
+void run(void);
 void run_toplevel(void);
 DLLEXPORT void run_callback(CELL quot);
 void platform_run(void);

native/stack.c

@@ -12,13 +12,13 @@ void reset_callstack(void)
 
 void fix_stacks(void)
 {
-	if(STACK_UNDERFLOW(ds,stack_chain->ds_region))
+	if(STACK_UNDERFLOW(ds,stack_chain->data_region))
 		reset_datastack();
-	else if(STACK_OVERFLOW(ds,stack_chain->ds_region))
+	else if(STACK_OVERFLOW(ds,stack_chain->data_region))
 		reset_datastack();
-	else if(STACK_UNDERFLOW(cs,stack_chain->cs_region))
+	else if(STACK_UNDERFLOW(cs,stack_chain->call_region))
 		reset_callstack();
-	else if(STACK_OVERFLOW(cs,stack_chain->cs_region))
+	else if(STACK_OVERFLOW(cs,stack_chain->call_region))
 		reset_callstack();
 }
 
@@ -26,8 +26,8 @@ void fix_stacks(void)
 in registers, so callbacks must save and restore the correct values */
 void save_stacks(void)
 {
-	stack_chain->ds = ds;
+	stack_chain->data = ds;
-	stack_chain->cs = cs;
+	stack_chain->call = cs;
 }
 
 /* called on entry into a compiled callback */
@@ -45,12 +45,14 @@ void nest_stacks(void)
 	- Factor callback returns
 	- C function restores registers
 	- C function returns to Factor code */
-	new_stacks->ds_save = ds;
+	new_stacks->data_save = ds;
-	new_stacks->cs_save = cs;
+	new_stacks->call_save = cs;
 
 	new_stacks->callframe = callframe;
-	new_stacks->ds_region = alloc_bounded_block(ds_size);
+	new_stacks->catch_save = userenv[CATCHSTACK_ENV];
-	new_stacks->cs_region = alloc_bounded_block(cs_size);
+
+	new_stacks->data_region = alloc_bounded_block(ds_size);
+	new_stacks->call_region = alloc_bounded_block(cs_size);
 	new_stacks->next = stack_chain;
 	stack_chain = new_stacks;
 	callframe = F;
@@ -61,13 +63,15 @@ void nest_stacks(void)
 /* called when leaving a compiled callback */
 void unnest_stacks(void)
 {
-	dealloc_bounded_block(stack_chain->ds_region);
+	dealloc_bounded_block(stack_chain->data_region);
-	dealloc_bounded_block(stack_chain->cs_region);
+	dealloc_bounded_block(stack_chain->call_region);
 
-	ds = stack_chain->ds_save;
+	ds = stack_chain->data_save;
-	cs = stack_chain->cs_save;
+	cs = stack_chain->call_save;
 
 	callframe = stack_chain->callframe;
+	userenv[CATCHSTACK_ENV] = stack_chain->catch_save;
+
 	stack_chain = stack_chain->next;
 }
 

native/stack.h

@@ -1,20 +1,32 @@
 typedef struct _STACKS {
-    CELL ds;
+	/* current datastack top pointer */
-    CELL ds_save;
+	CELL data;
-    BOUNDED_BLOCK *ds_region;
+	/* saved contents of ds register on entry to callback */
-    CELL cs;
+	CELL data_save;
-    CELL cs_save;
+	/* memory region holding current datastack */
-    BOUNDED_BLOCK *cs_region;
+	BOUNDED_BLOCK *data_region;
-    CELL callframe;
+	/* current callstack top pointer */
-    struct _STACKS *next;
+	CELL call;
+	/* saved contents of cs register on entry to callback */
+	CELL call_save;
+	/* memory region holding current callstack */
+	BOUNDED_BLOCK *call_region;
+	/* saved callframe on entry to callback */
+	CELL callframe;
+	/* saved catchstack on entry to callback */
+	CELL catch_save;
+	/* error handler longjmp buffer */
+	JMP_BUF toplevel;
+
+	struct _STACKS *next;
 } STACKS;
 
 STACKS *stack_chain;
 
 CELL ds_size, cs_size;
 
-#define ds_bot ((CELL)(stack_chain->ds_region->start))
+#define ds_bot ((CELL)(stack_chain->data_region->start))
-#define cs_bot ((CELL)(stack_chain->cs_region->start))
+#define cs_bot ((CELL)(stack_chain->call_region->start))
 
 #define STACK_UNDERFLOW(stack,region) ((stack) + CELLS < (region)->start)
 #define STACK_OVERFLOW(stack,region) ((stack) + CELLS >= (region)->start + (region)->size)