vm: resumably handle signals from leaf procedures

basis/compiler/constants/constants.factor

@@ -29,6 +29,7 @@ CONSTANT: deck-bits 18
 : callstack-top-offset ( -- n ) 2 \ callstack type-number slot-offset ; inline
 : vm-context-offset ( -- n ) 0 bootstrap-cells ; inline
 : vm-spare-context-offset ( -- n ) 1 bootstrap-cells ; inline
+: vm-signal-handler-addr-offset ( -- n ) 8 bootstrap-cells ; inline
 : context-callstack-top-offset ( -- n ) 0 bootstrap-cells ; inline
 : context-callstack-bottom-offset ( -- n ) 1 bootstrap-cells ; inline
 : context-datastack-offset ( -- n ) 2 bootstrap-cells ; inline

basis/cpu/x86/64/bootstrap.factor

@@ -93,58 +93,47 @@ IN: bootstrap.x86
 
 USE: locals
 
-: jit-save-volatile-regs ( -- )
+:: jit-save-volatile-regs ( -- save-size )
     ! do we also need to save XMM?
-    RSP volatile-regs length bootstrap-cell * SUB
+    volatile-regs length bootstrap-cell * 16 align :> save-size
+    RSP 2 bootstrap-cells [+] save-size ADD ! bump up stack frame size
+    RSP save-size SUB
     volatile-regs
-    [| r i | RSP i bootstrap-cell * [+] r MOV ] each-index ;
+    [| r i | RSP i bootstrap-cell * [+] r MOV ] each-index
+    save-size ;
 
-:: jit-restore-volatile-regs ( additional-pop -- )
+:: jit-restore-volatile-regs ( save-size -- )
     volatile-regs
     [| r i | r RSP i bootstrap-cell * [+] MOV ] each-index
-    RSP volatile-regs length bootstrap-cell * additional-pop + ADD ;
+    RSP save-size ADD ;
 
-[
+[| |
-    ! Stack at this point has the signal handler pointer followed by
+    jit-save-volatile-regs :> save-size
-    ! 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 vm-reg vm-signal-handler-addr-offset [+] MOV
     RAX CALL
-    bootstrap-cell jit-restore-volatile-regs
+    save-size jit-restore-volatile-regs
 ] \ signal-handler define-sub-primitive
 
-! :: jit-push-leaf-stack-frame ( -- )
+[| |
-!     ;
+    jit-save-volatile-regs :> save-size
-! 
+    jit-save-context
-! :: jit-pop-leaf-stack-frame ( -- )
+    RAX vm-reg vm-signal-handler-addr-offset [+] MOV
-!     ;
+    RAX CALL
-! 
+    ! Stack at this point has a fake stack frame set up to represent the
-! [
+    ! leaf procedure we interrupted. We must tear down that frame in
-!     ! Stack at this point has the signal handler pointer followed by
+    ! addition to our own before resuming.
-!     ! the word pointer and the return address back into normal execution,
+    ! Grab our resume address and place it just underneath the leaf proc's
-!     ! then the 24 bytes of stack frame + alignment inserted by the prolog
+    ! return address, since we can't touch any registers once they've been
-!     ! After registers are saved and the leaf stack frame is constructed,
+    ! restored. If we got this far there should be no faults here and we
-!     ! the stack looks like:
+    ! can get away with corrupting the stack frame.
-!     ! RSP  fake leaf stack frame (4 cells)
+    RAX RSP save-size 3 bootstrap-cells + [+] MOV
-!     !  +   saved volatile regs (`volatile-regs length` cells)
+    RSP save-size 6 bootstrap-cells + [+] RAX MOV
-!     !  .   subprimitive stack frame alignment (3 cells)
+
-!     !  .   leaf word (1 cell)
+    ! Popping 3 extra cells here plus the 3 cells the epilogue pops leaves
-!     !  .   signal handler address (1 cell)
+    ! the resume address at the top of the stack for when the epilogue RETs.
-!     !      resume address (1 cell)
+    save-size 3 bootstrap-cells + jit-restore-volatile-regs
-!     jit-save-volatile-regs
+] \ leaf-signal-handler define-sub-primitive
-!     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

basis/vm/vm.factor

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

vm/callstack.cpp

@@ -18,23 +18,70 @@ callstack *factor_vm::allot_callstack(cell size)
 	return stack;
 }
 
+struct word_finder {
+	cell address;
+	cell found_word;
+
+	word_finder(cell address) : address(address), found_word(0) {}
+
+	// XXX keep a map of word names in the code heap so we don't need this
+	void operator()(object *obj)
+	{
+		if (obj->type() == WORD_TYPE)
+		{
+			word *w = static_cast<word*>(obj);
+			if ((cell)w->code->entry_point() <= address 
+				&& address - (cell)w->code->entry_point() < w->code->size()) {
+				assert(found_word == 0);
+				found_word = (cell)w->code->entry_point();
+			}
+		}
+	}
+};
+
+static cell find_word_for_address(factor_vm *vm, cell pc)
+{
+	word_finder finder(pc);
+	vm->each_object(finder);
+	assert(finder.found_word != 0);
+	return finder.found_word;
+}
+
 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 */
+	/* XXX check if exception came from C code */
+	/* XXX handle callstack overflow */
 
 	cell offset = *sp % 16;
 
+	signal_handler_addr = handler;
 	tagged<word> handler_word = tagged<word>(special_objects[SIGNAL_HANDLER_WORD]);
 	if (offset == 0)
 	{
+		// should use FRAME_RETURN_ADDRESS here to be platform-agnostic
 		signal_from_leaf = false;
+		cell newsp = *sp - sizeof(cell);
+		*sp = newsp;
+		*(cell*)newsp = *pc;
 	}
+	// should check the PC since leaf procs on RISC architectures won't touch the
+	// stack at all
 	else if (offset == 16 - sizeof(cell))
 	{
 		signal_from_leaf = true;
+
+		// Make a fake frame for the leaf procedure
+		cell leaf_word = find_word_for_address(this, *pc);
+
+		cell newsp = *sp + 4 * sizeof(cell); // XXX platform-appropriate stack size
+		*(cell*)(newsp + 3*sizeof(cell)) = 4*sizeof(cell);
+		*(cell*)(newsp + 2*sizeof(cell)) = leaf_word;
+		*(cell*) newsp                   = *pc;
+		*sp = newsp;
 		handler_word = tagged<word>(special_objects[LEAF_SIGNAL_HANDLER_WORD]);
 	}
 	else
@@ -42,12 +89,6 @@ void factor_vm::dispatch_signal_handler(cell *sp, cell *pc, cell handler)
 		fatal_error("Invalid stack frame during signal handler", *sp);
 	}
 
-	/* Push the original PC as a return address and the C handler function
-	* pointer as an argument to the signal handler stub. */
-	cell newsp = *sp - 2*sizeof(cell);
-	*sp = newsp;
-	*(cell*)(newsp + sizeof(cell)) = *pc;
-	*(cell*)newsp = handler;
 	*pc = (cell)handler_word->code->entry_point();
 }
 

vm/vm.hpp

@@ -6,7 +6,11 @@ struct code_root;
 
 struct factor_vm
 {
-	// First 5 fields accessed directly by compiler. See basis/vm/vm.factor
+	//
+	// vvvvvv
+	// THESE FIELDS ARE ACCESSED DIRECTLY FROM FACTOR. See:
+	//   basis/vm/vm.factor
+	//   basis/compiler/constants/constants.factor
 
 	/* Current context */
 	context *ctx;
@@ -21,10 +25,17 @@ struct factor_vm
 	cell cards_offset;
 	cell decks_offset;
 
+	/* cdecl signal handler address, used by signal handler subprimitives */
+	cell signal_handler_addr;
+
 	/* Various special objects, accessed by special-object and
 	set-special-object primitives */
 	cell special_objects[special_object_count];
 
+	// THESE FIELDS ARE ACCESSED DIRECTLY FROM FACTOR.
+	// ^^^^^^
+	//
+
 	/* Data stack and retain stack sizes */
 	cell datastack_size, retainstack_size, callstack_size;