cpu.*.bootstrap: clear faulting flag directly

No reason to go through a safepoint in unwind-native-frames really.

basis/compiler/constants/constants.factor

@@ -30,6 +30,7 @@ CONSTANT: deck-bits 18
 : 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
+: vm-fault-flag-offset ( -- n ) 9 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/32/bootstrap.factor

@@ -140,16 +140,14 @@ IN: bootstrap.x86
 [ jit-jump-quot ]
 \ (call) define-combinator-primitive
 
-: (jit-safepoint) ( -- )
-    0 EAX MOVABS rc-absolute rel-safepoint ;
 [
     ! Load ds and rs registers
     jit-load-vm
     jit-load-context
     jit-restore-context
 
-    ! Safepoint to clear the faulting flag in the VM
+    ! clear the fault flag
-     (jit-safepoint)
+    vm-reg vm-fault-flag-offset [+] 0 MOV
 
     ! Windows-specific setup
     ctx-reg jit-update-seh
@@ -400,7 +398,9 @@ IN: bootstrap.x86
     EAX EDX [] MOV
     jit-jump-quot ;
 
-[ (jit-safepoint) ] \ jit-safepoint jit-define
+[
+    0 EAX MOVABS rc-absolute rel-safepoint
+] \ jit-safepoint jit-define
 
 [
     jit-start-context-and-delete

basis/cpu/x86/64/bootstrap.factor

@@ -122,9 +122,6 @@ IN: bootstrap.x86
 [ jit-jump-quot ]
 \ (call) define-combinator-primitive
 
-: (jit-safepoint)
-    0 [RIP+] EAX MOV rc-relative rel-safepoint ;
-
 [
     ! Unwind stack frames
     RSP arg2 MOV
@@ -137,8 +134,8 @@ IN: bootstrap.x86
     jit-load-context
     jit-restore-context
 
-    ! Safepoint to clear the faulting flag in the VM
+    ! Clear the fault flag
-    (jit-safepoint)
+    vm-reg vm-fault-flag-offset [+] 0 MOV
 
     ! Call quotation
     jit-jump-quot
@@ -342,7 +339,9 @@ IN: bootstrap.x86
     jit-push-param
     jit-jump-quot ;
 
-[ (jit-safepoint) ] \ jit-safepoint jit-define
+[
+    0 [RIP+] EAX MOV rc-relative rel-safepoint
+] \ jit-safepoint jit-define
 
 [
     jit-start-context-and-delete

basis/vm/vm.factor

@@ -31,6 +31,7 @@ STRUCT: vm
 { cards-offset cell }
 { decks-offset cell }
 { signal-handler-addr cell }
+{ faulting? cell }
 { special-objects cell[special-object-count] } ;
 
 : vm-field-offset ( field -- offset ) vm offset-of ; inline

vm/errors.cpp

@@ -73,9 +73,8 @@ void factor_vm::general_error(vm_error_type error, cell arg1, cell arg2)
 
 		ctx->push(error_object);
 
-		/* Guard the safepoint, which will clear faulting_p if unwind-native-frames
+		/* The unwind-native-frames subprimitive will clear faulting_p
-		succeeds */
+		if it was successfully reached. */
-		code->guard_safepoint();
 		unwind_native_frames(special_objects[ERROR_HANDLER_QUOT],
 			ctx->callstack_top);
 	}

vm/vm.hpp

@@ -28,6 +28,9 @@ struct factor_vm
 	/* cdecl signal handler address, used by signal handler subprimitives */
 	cell signal_handler_addr;
 
+	/* are we handling a memory error? used to detect double faults */
+	cell faulting_p;
+
 	/* Various special objects, accessed by special-object and
 	set-special-object primitives */
 	cell special_objects[special_object_count];
@@ -142,7 +145,6 @@ struct factor_vm
 	segment *signal_callstack_seg;
 
 	/* Are we already handling a fault? Used to catch double memory faults */
-	bool faulting_p;
 	static bool fatal_erroring_p;
 
 	/* Safepoint state */