vm: dispatch signal handlers through subprimitive

We also need to save C ABI volatile registers before calling the signal handler in order to be able to reliably resume. Add signal-handler and leaf-signal-handler subprimitives to preserve volatile registers before invoking the signal handler C function.

basis/bootstrap/image/image.factor

@@ -92,7 +92,7 @@ CONSTANT: image-version 4
 
 CONSTANT: data-base 1024
 
-CONSTANT: special-objects-size 70
+CONSTANT: special-objects-size 80
 
 CONSTANT: header-size 10
 
@@ -184,26 +184,28 @@ SPECIAL-OBJECT: lazy-jit-compile-word 43
 SPECIAL-OBJECT: unwind-native-frames-word 44
 SPECIAL-OBJECT: fpu-state-word 45
 SPECIAL-OBJECT: set-fpu-state-word 46
+SPECIAL-OBJECT: signal-handler-word 47
+SPECIAL-OBJECT: leaf-signal-handler-word 48
 
-SPECIAL-OBJECT: callback-stub 48
+SPECIAL-OBJECT: callback-stub 50
 
 ! PIC stubs
-SPECIAL-OBJECT: pic-load 49
+SPECIAL-OBJECT: pic-load 51
-SPECIAL-OBJECT: pic-tag 50
+SPECIAL-OBJECT: pic-tag 52
-SPECIAL-OBJECT: pic-tuple 51
+SPECIAL-OBJECT: pic-tuple 53
-SPECIAL-OBJECT: pic-check-tag 52
+SPECIAL-OBJECT: pic-check-tag 54
-SPECIAL-OBJECT: pic-check-tuple 53
+SPECIAL-OBJECT: pic-check-tuple 55
-SPECIAL-OBJECT: pic-hit 54
+SPECIAL-OBJECT: pic-hit 56
-SPECIAL-OBJECT: pic-miss-word 55
+SPECIAL-OBJECT: pic-miss-word 57
-SPECIAL-OBJECT: pic-miss-tail-word 56
+SPECIAL-OBJECT: pic-miss-tail-word 58
 
 ! Megamorphic dispatch
-SPECIAL-OBJECT: mega-lookup 57
+SPECIAL-OBJECT: mega-lookup 59
-SPECIAL-OBJECT: mega-lookup-word 58
+SPECIAL-OBJECT: mega-lookup-word 60
-SPECIAL-OBJECT: mega-miss-word 59
+SPECIAL-OBJECT: mega-miss-word 61
 
 ! Default definition for undefined words
-SPECIAL-OBJECT: undefined-quot 60
+SPECIAL-OBJECT: undefined-quot 62
 
 : special-object-offset ( symbol -- n )
     special-objects get at header-size + ;
@@ -525,6 +527,8 @@ M: quotation '
     \ unwind-native-frames unwind-native-frames-word set
     \ fpu-state fpu-state-word set
     \ set-fpu-state set-fpu-state-word set
+    \ signal-handler signal-handler-word set
+    \ leaf-signal-handler leaf-signal-handler-word set
     undefined-def undefined-quot set ;
 
 : emit-special-objects ( -- )

basis/cpu/x86/64/bootstrap.factor

@@ -36,12 +36,12 @@ IN: bootstrap.x86
 [
     ! load entry point
     RAX 0 MOV rc-absolute-cell rel-this
-    ! store entry point
-    RSP bootstrap-cell 2 * neg [+] RAX MOV
-    ! store stack frame size
-    RSP bootstrap-cell neg [+] stack-frame-size MOV
     ! alignment
     RSP stack-frame-size bootstrap-cell - SUB
+    ! store entry point
+    RSP stack-frame-size bootstrap-cell 3 * - [+] RAX MOV
+    ! store stack frame size
+    RSP stack-frame-size bootstrap-cell 2 * - [+] stack-frame-size MOV
 ] jit-prolog jit-define
 
 [
@@ -91,6 +91,61 @@ IN: bootstrap.x86
     "end_callback" jit-call
 ] \ c-to-factor define-sub-primitive
 
+USE: locals
+
+: jit-save-volatile-regs ( -- )
+    ! do we also need to save XMM?
+    RSP volatile-regs length bootstrap-cell * SUB
+    volatile-regs
+    [| r i | RSP i bootstrap-cell * [+] r MOV ] each-index ;
+
+:: jit-restore-volatile-regs ( additional-pop -- )
+    volatile-regs
+    [| r i | r RSP i bootstrap-cell * [+] MOV ] each-index
+    RSP volatile-regs length bootstrap-cell * additional-pop + ADD ;
+
+[
+    ! Stack at this point has the signal handler pointer followed by
+    ! the return address back into normal execution, then the 24 bytes
+    ! of stack frame + alignment inserted by the prolog.
+    ! After registers are saved, the stack looks like:
+    ! RSP  saved volatile regs (`volatile-regs length` cells)
+    !  +   subprimitive stack frame alignment (3 cells)
+    !  .   signal handler address (1 cell)
+    !  .   resume address (1 cell)
+    jit-save-volatile-regs
+    jit-save-context
+    RAX RSP volatile-regs length 3 + bootstrap-cell * [+] MOV
+    RAX CALL
+    bootstrap-cell jit-restore-volatile-regs
+] \ signal-handler define-sub-primitive
+
+! :: jit-push-leaf-stack-frame ( -- )
+!     ;
+! 
+! :: jit-pop-leaf-stack-frame ( -- )
+!     ;
+! 
+! [
+!     ! Stack at this point has the signal handler pointer followed by
+!     ! the word pointer and the return address back into normal execution,
+!     ! then the 24 bytes of stack frame + alignment inserted by the prolog
+!     ! After registers are saved and the leaf stack frame is constructed,
+!     ! the stack looks like:
+!     ! RSP  fake leaf stack frame (4 cells)
+!     !  +   saved volatile regs (`volatile-regs length` cells)
+!     !  .   subprimitive stack frame alignment (3 cells)
+!     !  .   leaf word (1 cell)
+!     !  .   signal handler address (1 cell)
+!     !      resume address (1 cell)
+!     jit-save-volatile-regs
+!     jit-push-leaf-stack-frame
+!     jit-save-context
+!     "memory_signal_handler_impl" jit-call
+!     jit-pop-leaf-stack-frame
+!     bootstrap-cell jit-restore-volatile-regs
+! ] \ leaf-signal-handler define-sub-primitive
+
 [
     arg1 ds-reg [] MOV
     ds-reg bootstrap-cell SUB

basis/cpu/x86/64/unix/bootstrap.factor

@@ -7,6 +7,7 @@ IN: bootstrap.x86
 
 : stack-frame-size ( -- n ) 4 bootstrap-cells ;
 : nv-regs ( -- seq ) { RBX R12 R13 R14 R15 } ;
+: volatile-regs ( -- seq ) { RAX RCX RDX RSI RDI R8 R9 R10 R11 } ;
 : arg1 ( -- reg ) RDI ;
 : arg2 ( -- reg ) RSI ;
 : arg3 ( -- reg ) RDX ;

basis/cpu/x86/64/windows/bootstrap.factor

@@ -9,6 +9,7 @@ DEFER: stack-reg
 
 : stack-frame-size ( -- n ) 8 bootstrap-cells ;
 : nv-regs ( -- seq ) { RBX RSI RDI R12 R13 R14 R15 } ;
+: volatile-regs ( -- seq ) { RAX RCX RDX R8 R9 R10 R11 } ;
 : arg1 ( -- reg ) RCX ;
 : arg2 ( -- reg ) RDX ;
 : arg3 ( -- reg ) R8 ;

basis/cpu/x86/assembler/assembler.factor

@@ -954,3 +954,7 @@ PRIVATE>
 
 : HWNT ( -- ) HEX: 2e , ; ! Hint branch Weakly Not Taken
 : HST  ( -- ) HEX: 3e , ; ! Hint branch Strongly Taken
+
+! interrupt instructions
+
+: INT ( n -- ) dup 3 = [ drop HEX: cc , ] [ HEX: cd , 1, ] if ;

basis/threads/threads.factor

@@ -60,7 +60,7 @@ mailbox
 sleep-entry ;
 
 : self ( -- thread )
-    63 special-object { thread } declare ; inline
+    65 special-object { thread } declare ; inline
 
 : thread-continuation ( thread -- continuation )
     context>> check-box value>> continuation-for ;
@@ -79,7 +79,7 @@ sleep-entry ;
     [ tnamespace ] dip change-at ; inline
 
 : threads ( -- assoc )
-    64 special-object { hashtable } declare ; inline
+    66 special-object { hashtable } declare ; inline
 
 : thread-registered? ( thread -- ? )
     id>> threads key? ;
@@ -92,18 +92,18 @@ sleep-entry ;
 : unregister-thread ( thread -- )
     id>> threads delete-at ;
 
-: set-self ( thread -- ) 63 set-special-object ; inline
+: set-self ( thread -- ) 65 set-special-object ; inline
 
 PRIVATE>
 
 : run-queue ( -- dlist )
-    65 special-object { dlist } declare ; inline
+    67 special-object { dlist } declare ; inline
 
 : sleep-queue ( -- heap )
-    66 special-object { min-heap } declare ; inline
+    68 special-object { min-heap } declare ; inline
 
 : waiting-callbacks ( -- assoc )
-    68 special-object { hashtable } declare ; inline
+    70 special-object { hashtable } declare ; inline
 
 : new-thread ( quot name class -- thread )
     new
@@ -234,10 +234,10 @@ M: real sleep
 <PRIVATE
 
 : init-thread-state ( -- )
-    H{ } clone 64 set-special-object
+    H{ } clone 66 set-special-object
-    <dlist> 65 set-special-object
+    <dlist> 67 set-special-object
-    <min-heap> 66 set-special-object
+    <min-heap> 68 set-special-object
-    H{ } clone 68 set-special-object ;
+    H{ } clone 70 set-special-object ;
 
 : init-initial-thread ( -- )
     [ ] "Initial" <thread>

basis/vm/vm.factor

@@ -30,7 +30,7 @@ STRUCT: vm
 { nursery zone }
 { cards-offset cell }
 { decks-offset cell }
-{ special-objects cell[70] } ;
+{ special-objects cell[80] } ;
 
 : vm-field-offset ( field -- offset ) vm offset-of ; inline
 

core/alien/strings/strings.factor

@@ -67,5 +67,5 @@ M: array symbol>string [ (symbol>string) ] map ;
 [
      8 special-object utf8 alien>string string>cpu \ cpu set-global
      9 special-object utf8 alien>string string>os \ os set-global
-    67 special-object utf8 alien>string \ vm-compiler set-global
+    69 special-object utf8 alien>string \ vm-compiler set-global
 ] "alien.strings" add-startup-hook

core/bootstrap/primitives.factor

@@ -345,6 +345,8 @@ tuple
     { "(call)" "kernel.private" ( quot -- ) }
     { "fpu-state" "kernel.private" ( -- ) }
     { "set-fpu-state" "kernel.private" ( -- ) }
+    { "signal-handler" "kernel.private" ( -- ) }
+    { "leaf-signal-handler" "kernel.private" ( -- ) }
     { "unwind-native-frames" "kernel.private" ( -- ) }
     { "set-callstack" "kernel.private" ( callstack -- * ) }
     { "lazy-jit-compile" "kernel.private" ( -- ) }

core/compiler/units/units.factor

@@ -106,7 +106,7 @@ GENERIC: definitions-changed ( assoc obj -- )
 ! Incremented each time stack effects potentially changed, used
 ! by compiler.tree.propagation.call-effect for call( and execute(
 ! inline caching
-: effect-counter ( -- n ) 47 special-object ; inline
+: effect-counter ( -- n ) 49 special-object ; inline
 
 GENERIC: always-bump-effect-counter? ( defspec -- ? )
 
@@ -141,9 +141,9 @@ M: object always-bump-effect-counter? drop f ;
 
 : bump-effect-counter ( -- )
     bump-effect-counter? [
-        47 special-object 0 or
+        49 special-object 0 or
         1 +
-        47 set-special-object
+        49 set-special-object
     ] when ;
 
 : notify-observers ( -- )

core/continuations/continuations.factor

@@ -124,7 +124,7 @@ callback-error-hook [ [ die ] ] initialize
     catchstack* [
         in-callback?
         [ callback-error-hook get-global call( error -- * ) ]
-        [ 63 special-object error-in-thread ]
+        [ 65 special-object error-in-thread ]
         if
     ] [ pop continue-with ] if-empty ;
 
@@ -190,8 +190,8 @@ M: condition compute-restarts
     init-catchstack
     ! VM calls on error
     [
-        ! 63 = self
+        ! 65 = self
-        63 special-object error-thread set-global
+        65 special-object error-thread set-global
         continuation error-continuation set-global
         [ original-error set-global ] [ rethrow ] bi
     ] 5 set-special-object

core/io/streams/c/c.factor

@@ -55,7 +55,7 @@ M: c-io-backend init-io ;
 
 : stdin-handle ( -- alien ) 11 special-object ;
 : stdout-handle ( -- alien ) 12 special-object ;
-: stderr-handle ( -- alien ) 61 special-object ;
+: stderr-handle ( -- alien ) 63 special-object ;
 
 : init-c-stdio ( -- )
     stdin-handle <c-reader>

vm/callstack.cpp

@@ -18,35 +18,37 @@ callstack *factor_vm::allot_callstack(cell size)
 	return stack;
 }
 
-void factor_vm::dispatch_signal_handler(cell *sp, cell *pc, cell newpc)
+void factor_vm::dispatch_signal_handler(cell *sp, cell *pc, cell handler)
 {
 	/* True stack frames are always 16-byte aligned. Leaf procedures
 	that don't create a stack frame will be out of alignment by sizeof(cell)
 	bytes. */
+	/* XXX horribly x86-centric */
+
 	cell offset = *sp % 16;
-	if (offset == 0) {
+
+	tagged<word> handler_word = tagged<word>(special_objects[SIGNAL_HANDLER_WORD]);
+	if (offset == 0)
+	{
 		signal_from_leaf = false;
-		cell newsp = *sp - sizeof(cell);
+	}
-		*sp = newsp;
+	else if (offset == 16 - sizeof(cell))
-		*(cell*)newsp = *pc;
+	{
-		*pc = newpc;
+		signal_from_leaf = true;
-		ctx->callstack_top = (stack_frame*)newsp;
+		handler_word = tagged<word>(special_objects[LEAF_SIGNAL_HANDLER_WORD]);
-	} else if (offset == 16 - sizeof(cell)) {
+	}
-		dispatch_signal_handler_from_leaf(sp, pc, newpc);
+	else
-	} else {
+	{
 		fatal_error("Invalid stack frame during signal handler", *sp);
 	}
-}
 
-void factor_vm::dispatch_signal_handler_from_leaf(cell *sp, cell *pc, cell newpc)
+	/* Push the original PC as a return address and the C handler function
-{
+	* pointer as an argument to the signal handler stub. */
-	/* We should try to conjure a stack frame here, but we may need to deal
+	cell newsp = *sp - 2*sizeof(cell);
-	with callstack overflows or the GC moving code around.
+	*sp = newsp;
-	For now leave the stack untouched so the signal handler returns into
+	*(cell*)(newsp + sizeof(cell)) = *pc;
-	the parent procedure. This will cause things to blow up if the stack
+	*(cell*)newsp = handler;
-	is left unbalanced. */
+	*pc = (cell)handler_word->code->entry_point();
-	signal_from_leaf = true;
-	*pc = newpc;
 }
 
 /* We ignore the two topmost frames, the 'callstack' primitive

vm/objects.hpp

@@ -1,7 +1,7 @@
 namespace factor
 {
 
-static const cell special_object_count = 70;
+static const cell special_object_count = 80;
 
 enum special_object {
 	OBJ_WALKER_HOOK = 3,       /* non-local exit hook, used by library only */
@@ -57,16 +57,18 @@ enum special_object {
 	UNWIND_NATIVE_FRAMES_WORD,
 	GET_FPU_STATE_WORD,
 	SET_FPU_STATE_WORD,
+	SIGNAL_HANDLER_WORD,
+	LEAF_SIGNAL_HANDLER_WORD,
 
 	/* Incremented on every modify-code-heap call; invalidates call( inline
 	caching */
-	REDEFINITION_COUNTER = 47,
+	REDEFINITION_COUNTER = 49,
 
 	/* Callback stub generation in callbacks.c */
-	CALLBACK_STUB = 48,
+	CALLBACK_STUB = 50,
 	
 	/* Polymorphic inline cache generation in inline_cache.c */
-	PIC_LOAD = 49,
+	PIC_LOAD = 51,
 	PIC_TAG,
 	PIC_TUPLE,
 	PIC_CHECK_TAG,
@@ -76,25 +78,25 @@ enum special_object {
 	PIC_MISS_TAIL_WORD,
 
 	/* Megamorphic cache generation in dispatch.c */
-	MEGA_LOOKUP = 57,
+	MEGA_LOOKUP = 59,
 	MEGA_LOOKUP_WORD,
 	MEGA_MISS_WORD,
 
-	OBJ_UNDEFINED = 60,       /* default quotation for undefined words */
+	OBJ_UNDEFINED = 62,       /* default quotation for undefined words */
 
-	OBJ_STDERR = 61,          /* stderr FILE* handle */
+	OBJ_STDERR = 63,          /* stderr FILE* handle */
 
-	OBJ_STAGE2 = 62,          /* have we bootstrapped? */
+	OBJ_STAGE2 = 64,          /* have we bootstrapped? */
 
-	OBJ_CURRENT_THREAD = 63,
+	OBJ_CURRENT_THREAD = 65,
 
-	OBJ_THREADS = 64,
+	OBJ_THREADS = 66,
-	OBJ_RUN_QUEUE = 65,
+	OBJ_RUN_QUEUE = 67,
-	OBJ_SLEEP_QUEUE = 66,
+	OBJ_SLEEP_QUEUE = 68,
 
-	OBJ_VM_COMPILER = 67,     /* version string of the compiler we were built with */
+	OBJ_VM_COMPILER = 69,     /* version string of the compiler we were built with */
 
-	OBJ_WAITING_CALLBACKS = 68,
+	OBJ_WAITING_CALLBACKS = 70,
 };
 
 /* save-image-and-exit discards special objects that are filled in on startup