Merge branch 'master' of factorcode.org:/git/factor

basis/bootstrap/image/image.factor

@@ -201,6 +201,8 @@ SPECIAL-OBJECT: jit-declare-word 41
 SPECIAL-OBJECT: c-to-factor-word 42
 SPECIAL-OBJECT: lazy-jit-compile-word 43
 SPECIAL-OBJECT: unwind-native-frames-word 44
+SPECIAL-OBJECT: get-fpu-state-word 45
+SPECIAL-OBJECT: set-fpu-state-word 46
 
 SPECIAL-OBJECT: callback-stub 48
 
@@ -540,6 +542,8 @@ M: quotation '
     \ c-to-factor c-to-factor-word set
     \ lazy-jit-compile lazy-jit-compile-word set
     \ unwind-native-frames unwind-native-frames-word set
+    \ get-fpu-state get-fpu-state-word set
+    \ set-fpu-state set-fpu-state-word set
     undefined-def undefined-quot set ;
 
 : emit-special-objects ( -- )

basis/cpu/x86/32/bootstrap.factor

@@ -64,9 +64,6 @@ IN: bootstrap.x86
     ds-reg ctx-reg context-datastack-offset [+] MOV
     rs-reg ctx-reg context-retainstack-offset [+] MOV ;
 
-: jit-scrub-return ( n -- )
-    ESP swap [+] 0 MOV ;
-
 [
     ! ctx-reg is preserved across the call because it is non-volatile
     ! in the C ABI
@@ -115,24 +112,28 @@ IN: bootstrap.x86
     ! Windows-specific setup
     ctx-reg jit-update-seh
 
-    ! Clear x87 stack, but preserve rounding mode and exception flags
-    ESP 2 SUB
-    ESP [] FNSTCW
-    FNINIT
-    ESP [] FLDCW
-    ESP 2 ADD
-
     ! Load arguments
     EAX ESP stack-frame-size [+] MOV
     EDX ESP stack-frame-size 4 + [+] MOV
 
     ! Unwind stack frames
     ESP EDX MOV
-    0 jit-scrub-return
 
     jit-jump-quot
 ] \ unwind-native-frames define-sub-primitive
 
+[
+    ESP 2 SUB
+    ESP [] FNSTCW
+    FNINIT
+    AX ESP [] MOV
+    ESP 2 ADD
+] \ get-fpu-state define-sub-primitive
+
+[
+    ESP stack-frame-size [+] FLDCW
+] \ set-fpu-state define-sub-primitive
+
 [
     ! Load callstack object
     temp3 ds-reg [] MOV
@@ -251,7 +252,9 @@ IN: bootstrap.x86
 
 ! Contexts
 : jit-switch-context ( reg -- )
-    -4 jit-scrub-return
+    ! Reset return value since its bogus right now, to avoid
+    ! confusing the GC
+    ESP -4 [+] 0 MOV
 
     ! Make the new context the current one
     ctx-reg swap MOV

basis/cpu/x86/64/bootstrap.factor

@@ -62,9 +62,6 @@ IN: bootstrap.x86
     ds-reg ctx-reg context-datastack-offset [+] MOV
     rs-reg ctx-reg context-retainstack-offset [+] MOV ;
 
-: jit-scrub-return ( n -- )
-    RSP swap [+] 0 MOV ;
-
 [
     ! ctx-reg is preserved across the call because it is non-volatile
     ! in the C ABI
@@ -102,15 +99,8 @@ IN: bootstrap.x86
 \ (call) define-combinator-primitive
 
 [
-    ! Clear x87 stack, but preserve rounding mode and exception flags
-    RSP 2 SUB
-    RSP [] FNSTCW
-    FNINIT
-    RSP [] FLDCW
-
     ! Unwind stack frames
     RSP arg2 MOV
-    0 jit-scrub-return
 
     ! Load VM pointer into vm-reg, since we're entering from
     ! C code
@@ -124,6 +114,21 @@ IN: bootstrap.x86
     jit-jump-quot
 ] \ unwind-native-frames define-sub-primitive
 
+[
+    RSP 2 SUB
+    RSP [] FNSTCW
+    FNINIT
+    AX RSP [] MOV
+    RSP 2 ADD
+] \ get-fpu-state define-sub-primitive
+
+[
+    RSP 2 SUB
+    RSP [] arg1 16-bit-version-of MOV
+    RSP [] FLDCW
+    RSP 2 ADD
+] \ set-fpu-state define-sub-primitive
+
 [
     ! Load callstack object
     arg4 ds-reg [] MOV
@@ -228,7 +233,9 @@ IN: bootstrap.x86
 
 ! Contexts
 : jit-switch-context ( reg -- )
-    -8 jit-scrub-return
+    ! Reset return value since its bogus right now, to avoid
+    ! confusing the GC
+    RSP -8 [+] 0 MOV
 
     ! Make the new context the current one
     ctx-reg swap MOV

basis/debugger/debugger.factor

@@ -136,7 +136,7 @@ PREDICATE: vm-error < array
     {
         { [ dup empty? ] [ drop f ] }
         { [ dup first "kernel-error" = not ] [ drop f ] }
-        [ second 0 16 between? ]
+        [ second 0 17 between? ]
     } cond ;
 
 : vm-errors ( error -- n errors )

basis/io/launcher/unix/unix-tests.factor

@@ -3,7 +3,8 @@ USING: io.files io.files.temp io.directories io.pathnames
 tools.test io.launcher arrays io namespaces continuations math
 io.encodings.binary io.encodings.ascii accessors kernel
 sequences io.encodings.utf8 destructors io.streams.duplex locals
-concurrency.promises threads unix.process calendar unix ;
+concurrency.promises threads unix.process calendar unix
+unix.process debugger.unix io.timeouts io.launcher.unix ;
 
 [ ] [
     [ "launcher-test-1" temp-file delete-file ] ignore-errors
@@ -138,3 +139,21 @@ concurrency.promises threads unix.process calendar unix ;
         s 3 seconds ?promise-timeout 0 =
     ]
 ] unit-test
+
+! Make sure that subprocesses don't inherit our signal mask
+
+! First, ensure that the Factor VM ignores SIGPIPE
+: send-sigpipe ( pid -- )
+    "SIGPIPE" signal-names index 1 +
+    kill io-error ;
+
+[ ] [ current-process-handle send-sigpipe ] unit-test
+
+! Spawn a process
+[ T{ signal f 13 } ] [
+    "sleep 1000" run-detached
+    [ handle>> send-sigpipe ]
+    [ 2 seconds swap set-timeout ]
+    [ wait-for-process ]
+    tri
+] unit-test

basis/math/floats/env/env-tests.factor

@@ -1,7 +1,7 @@
 USING: kernel math math.floats.env math.floats.env.private
 math.functions math.libm sequences tools.test locals
 compiler.units kernel.private fry compiler.test math.private
-words system ;
+words system memory ;
 IN: math.floats.env.tests
 
 : set-default-fp-env ( -- )
@@ -193,6 +193,9 @@ os openbsd eq? cpu x86.32 eq? and [
 [ +denormal-keep+ ] [ denormal-mode ] unit-test
 [ { } ] [ fp-traps ] unit-test
 
+[ ] [
+    all-fp-exceptions [ compact-gc ] with-fp-traps
+] unit-test
+
 ! In case the tests screw up the FP env because of bugs in math.floats.env
 set-default-fp-env
-

core/bootstrap/primitives.factor

@@ -340,6 +340,8 @@ tuple
     { "tag" "kernel.private" (( object -- n )) }
     { "(execute)" "kernel.private" (( word -- )) }
     { "(call)" "kernel.private" (( quot -- )) }
+    { "get-fpu-state" "kernel.private" (( -- )) }
+    { "set-fpu-state" "kernel.private" (( -- )) }
     { "unwind-native-frames" "kernel.private" (( -- )) }
     { "set-callstack" "kernel.private" (( callstack -- * )) }
     { "lazy-jit-compile" "kernel.private" (( -- )) }

vm/callstack.cpp

@@ -127,6 +127,23 @@ void factor_vm::set_frame_offset(stack_frame *frame, cell offset)
 		FRAME_RETURN_ADDRESS(frame,this) = entry_point + offset;
 }
 
+void factor_vm::scrub_return_address()
+{
+	stack_frame *top = ctx->callstack_top;
+	stack_frame *bottom = ctx->callstack_bottom;
+	stack_frame *frame = bottom - 1;
+
+	while(frame >= top && frame_successor(frame) >= top)
+		frame = frame_successor(frame);
+
+	set_frame_offset(frame,0);
+
+#ifdef FACTOR_DEBUG
+	/* Doing a GC here triggers all kinds of funny errors */
+	primitive_compact_gc();
+#endif
+}
+
 cell factor_vm::frame_scan(stack_frame *frame)
 {
 	switch(frame_type(frame))

vm/entry_points.cpp

@@ -26,4 +26,18 @@ void factor_vm::unwind_native_frames(cell quot, stack_frame *to)
 	unwind_native_frames_func(quot,to);
 }
 
+cell factor_vm::get_fpu_state()
+{
+	tagged<word> get_fpu_state_word(special_objects[GET_FPU_STATE_WORD]);
+	get_fpu_state_func_type get_fpu_state_func = (get_fpu_state_func_type)get_fpu_state_word->entry_point;
+	return get_fpu_state_func();
+}
+
+void factor_vm::set_fpu_state(cell state)
+{
+	tagged<word> set_fpu_state_word(special_objects[SET_FPU_STATE_WORD]);
+	set_fpu_state_func_type set_fpu_state_func = (set_fpu_state_func_type)set_fpu_state_word->entry_point;
+	set_fpu_state_func(state);
+}
+
 }

vm/entry_points.hpp

@@ -3,5 +3,7 @@ namespace factor
 
 typedef void (* c_to_factor_func_type)(cell quot);
 typedef void (* unwind_native_frames_func_type)(cell quot, stack_frame *to);
+typedef cell (* get_fpu_state_func_type)();
+typedef void (* set_fpu_state_func_type)(cell state);
 
 }

vm/errors.cpp

@@ -27,10 +27,8 @@ void out_of_memory()
 	exit(1);
 }
 
-void factor_vm::throw_error(cell error, stack_frame *stack)
+void factor_vm::throw_error(cell error)
 {
-	assert(stack);
-
 	/* If the error handler is set, we rewind any C stack frames and
 	pass the error to user-space. */
 	if(!current_gc && to_boolean(special_objects[ERROR_HANDLER_QUOT]))
@@ -49,7 +47,8 @@ void factor_vm::throw_error(cell error, stack_frame *stack)
 
 		ctx->push(error);
 
-		unwind_native_frames(special_objects[ERROR_HANDLER_QUOT],stack);
+		unwind_native_frames(special_objects[ERROR_HANDLER_QUOT],
+			ctx->callstack_top);
 	}
 	/* Error was thrown in early startup before error handler is set, just
 	crash. */
@@ -63,16 +62,10 @@ void factor_vm::throw_error(cell error, stack_frame *stack)
 	}
 }
 
-void factor_vm::general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *stack)
-{
-	throw_error(allot_array_4(special_objects[OBJ_ERROR],
-		tag_fixnum(error),arg1,arg2),stack);
-}
-
 void factor_vm::general_error(vm_error_type error, cell arg1, cell arg2)
 {
 	throw_error(allot_array_4(special_objects[OBJ_ERROR],
-		tag_fixnum(error),arg1,arg2),ctx->callstack_top);
+		tag_fixnum(error),arg1,arg2));
 }
 
 void factor_vm::type_error(cell type, cell tagged)
@@ -85,29 +78,29 @@ void factor_vm::not_implemented_error()
 	general_error(ERROR_NOT_IMPLEMENTED,false_object,false_object);
 }
 
-void factor_vm::memory_protection_error(cell addr, stack_frame *stack)
+void factor_vm::memory_protection_error(cell addr)
 {
 	/* Retain and call stack underflows are not supposed to happen */
 
 	if(ctx->datastack_seg->underflow_p(addr))
-		general_error(ERROR_DATASTACK_UNDERFLOW,false_object,false_object,stack);
+		general_error(ERROR_DATASTACK_UNDERFLOW,false_object,false_object);
 	else if(ctx->datastack_seg->overflow_p(addr))
-		general_error(ERROR_DATASTACK_OVERFLOW,false_object,false_object,stack);
+		general_error(ERROR_DATASTACK_OVERFLOW,false_object,false_object);
 	else if(ctx->retainstack_seg->underflow_p(addr))
-		general_error(ERROR_RETAINSTACK_UNDERFLOW,false_object,false_object,stack);
+		general_error(ERROR_RETAINSTACK_UNDERFLOW,false_object,false_object);
 	else if(ctx->retainstack_seg->overflow_p(addr))
-		general_error(ERROR_RETAINSTACK_OVERFLOW,false_object,false_object,stack);
+		general_error(ERROR_RETAINSTACK_OVERFLOW,false_object,false_object);
 	else if(ctx->callstack_seg->underflow_p(addr))
-		general_error(ERROR_CALLSTACK_OVERFLOW,false_object,false_object,stack);
+		general_error(ERROR_CALLSTACK_OVERFLOW,false_object,false_object);
 	else if(ctx->callstack_seg->overflow_p(addr))
-		general_error(ERROR_CALLSTACK_UNDERFLOW,false_object,false_object,stack);
+		general_error(ERROR_CALLSTACK_UNDERFLOW,false_object,false_object);
 	else
-		general_error(ERROR_MEMORY,from_unsigned_cell(addr),false_object,stack);
+		general_error(ERROR_MEMORY,from_unsigned_cell(addr),false_object);
 }
 
-void factor_vm::signal_error(cell signal, stack_frame *stack)
+void factor_vm::signal_error(cell signal)
 {
-	general_error(ERROR_SIGNAL,from_unsigned_cell(signal),false_object,stack);
+	general_error(ERROR_SIGNAL,from_unsigned_cell(signal),false_object);
 }
 
 void factor_vm::divide_by_zero_error()
@@ -115,9 +108,9 @@ void factor_vm::divide_by_zero_error()
 	general_error(ERROR_DIVIDE_BY_ZERO,false_object,false_object);
 }
 
-void factor_vm::fp_trap_error(unsigned int fpu_status, stack_frame *stack)
+void factor_vm::fp_trap_error(unsigned int fpu_status)
 {
-	general_error(ERROR_FP_TRAP,tag_fixnum(fpu_status),false_object,stack);
+	general_error(ERROR_FP_TRAP,tag_fixnum(fpu_status),false_object);
 }
 
 /* For testing purposes */
@@ -128,7 +121,8 @@ void factor_vm::primitive_unimplemented()
 
 void factor_vm::memory_signal_handler_impl()
 {
-	memory_protection_error(signal_fault_addr,signal_callstack_top);
+	scrub_return_address();
+	memory_protection_error(signal_fault_addr);
 }
 
 void memory_signal_handler_impl()
@@ -138,7 +132,8 @@ void memory_signal_handler_impl()
 
 void factor_vm::misc_signal_handler_impl()
 {
-	signal_error(signal_number,signal_callstack_top);
+	scrub_return_address();
+	signal_error(signal_number);
 }
 
 void misc_signal_handler_impl()
@@ -148,7 +143,11 @@ void misc_signal_handler_impl()
 
 void factor_vm::fp_signal_handler_impl()
 {
-	fp_trap_error(signal_fpu_status,signal_callstack_top);
+	/* Clear pending exceptions to avoid getting stuck in a loop */
+	set_fpu_state(get_fpu_state());
+
+	scrub_return_address();
+	fp_trap_error(signal_fpu_status);
 }
 
 void fp_signal_handler_impl()

vm/gc.cpp

@@ -128,6 +128,11 @@ void factor_vm::start_gc_again()
 
 void factor_vm::gc(gc_op op, cell requested_bytes, bool trace_contexts_p)
 {
+	/* Save and reset FPU state before, restore it after, so that
+	nano_count() doesn't bomb on Windows if inexact traps are enabled
+	(fun huh?) */
+	cell fpu_state = get_fpu_state();
+
 	assert(!gc_off);
 	assert(!current_gc);
 
@@ -192,6 +197,8 @@ void factor_vm::gc(gc_op op, cell requested_bytes, bool trace_contexts_p)
 
 	delete current_gc;
 	current_gc = NULL;
+
+	set_fpu_state(fpu_state);
 }
 
 /* primitive_minor_gc() is invoked by inline GC checks, and it needs to fill in

vm/mach_signal.cpp

@@ -37,7 +37,7 @@ void factor_vm::call_fault_handler(
 {
 	MACH_STACK_POINTER(thread_state) = (cell)fix_callstack_top((stack_frame *)MACH_STACK_POINTER(thread_state));
 
-	signal_callstack_top = (stack_frame *)MACH_STACK_POINTER(thread_state);
+	ctx->callstack_top = (stack_frame *)MACH_STACK_POINTER(thread_state);
 
 	/* Now we point the program counter at the right handler function. */
 	if(exception == EXC_BAD_ACCESS)

vm/objects.hpp

@@ -55,6 +55,8 @@ enum special_object {
 	C_TO_FACTOR_WORD,
 	LAZY_JIT_COMPILE_WORD,
 	UNWIND_NATIVE_FRAMES_WORD,
+	GET_FPU_STATE_WORD,
+	SET_FPU_STATE_WORD,
 
 	/* Incremented on every modify-code-heap call; invalidates call( inline
 	caching */

vm/os-unix.cpp

@@ -118,7 +118,7 @@ void factor_vm::dispatch_signal(void *uap, void (handler)())
 	UAP_STACK_POINTER(uap) = (UAP_STACK_POINTER_TYPE)fix_callstack_top((stack_frame *)UAP_STACK_POINTER(uap));
 	UAP_PROGRAM_COUNTER(uap) = (cell)handler;
 
-	signal_callstack_top = (stack_frame *)UAP_STACK_POINTER(uap);
+	ctx->callstack_top = (stack_frame *)UAP_STACK_POINTER(uap);
 }
 
 void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
@@ -135,6 +135,10 @@ void misc_signal_handler(int signal, siginfo_t *siginfo, void *uap)
 	vm->dispatch_signal(uap,factor::misc_signal_handler_impl);
 }
 
+void ignore_signal_handler(int signal, siginfo_t *siginfo, void *uap)
+{
+}
+
 void fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap)
 {
 	factor_vm *vm = current_vm();
@@ -206,9 +210,13 @@ void factor_vm::unix_init_signals()
 	sigaction_safe(SIGQUIT,&misc_sigaction,NULL);
 	sigaction_safe(SIGILL,&misc_sigaction,NULL);
 
+	/* We don't use SA_IGN here because then the ignore action is inherited
+	by subprocesses, which we don't want. There is a unit test in
+	io.launcher.unix for this. */
 	memset(&ignore_sigaction,0,sizeof(struct sigaction));
 	sigemptyset(&ignore_sigaction.sa_mask);
-	ignore_sigaction.sa_handler = SIG_IGN;
+	ignore_sigaction.sa_sigaction = ignore_signal_handler;
+	ignore_sigaction.sa_flags = SA_SIGINFO | SA_ONSTACK;
 	sigaction_safe(SIGPIPE,&ignore_sigaction,NULL);
 }
 

vm/os-unix.hpp

@@ -37,9 +37,6 @@ typedef pthread_t THREADHANDLE;
 THREADHANDLE start_thread(void *(*start_routine)(void *),void *args);
 inline static THREADHANDLE thread_id() { return pthread_self(); }
 
-void signal_handler(int signal, siginfo_t* siginfo, void* uap);
-void dump_stack_signal(int signal, siginfo_t* siginfo, void* uap);
-
 u64 nano_count();
 void sleep_nanos(u64 nsec);
 void open_console();

vm/os-windows-nt.cpp

@@ -50,7 +50,7 @@ void sleep_nanos(u64 nsec)
 LONG factor_vm::exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c, void *dispatch)
 {
 	c->ESP = (cell)fix_callstack_top((stack_frame *)c->ESP);
-	signal_callstack_top = (stack_frame *)c->ESP;
+	ctx->callstack_top = (stack_frame *)c->ESP;
 
 	switch (e->ExceptionCode)
 	{
@@ -72,6 +72,8 @@ LONG factor_vm::exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c,
 		signal_fpu_status = fpu_status(MXCSR(c));
 #else
 		signal_fpu_status = fpu_status(X87SW(c) | MXCSR(c));
+
+		/* This seems to have no effect */
 		X87SW(c) = 0;
 #endif
 		MXCSR(c) &= 0xffffffc0;

vm/vm.hpp

@@ -49,12 +49,11 @@ struct factor_vm
 	/* Is call counting enabled? */
 	bool profiling_p;
 
-	/* Global variables used to pass fault handler state from signal handler to
-	   user-space */
+	/* Global variables used to pass fault handler state from signal handler
+	to VM */
 	cell signal_number;
 	cell signal_fault_addr;
 	unsigned int signal_fpu_status;
-	stack_frame *signal_callstack_top;
 
 	/* GC is off during heap walking */
 	bool gc_off;
@@ -168,15 +167,14 @@ struct factor_vm
 	void primitive_profiling();
 
 	// errors
-	void throw_error(cell error, stack_frame *stack);
-	void general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *stack);
+	void throw_error(cell error);
 	void general_error(vm_error_type error, cell arg1, cell arg2);
 	void type_error(cell type, cell tagged);
 	void not_implemented_error();
-	void memory_protection_error(cell addr, stack_frame *stack);
-	void signal_error(cell signal, stack_frame *stack);
+	void memory_protection_error(cell addr);
+	void signal_error(cell signal);
 	void divide_by_zero_error();
-	void fp_trap_error(unsigned int fpu_status, stack_frame *stack);
+	void fp_trap_error(unsigned int fpu_status);
 	void primitive_unimplemented();
 	void memory_signal_handler_impl();
 	void misc_signal_handler_impl();
@@ -588,6 +586,7 @@ struct factor_vm
 	cell frame_scan(stack_frame *frame);
 	cell frame_offset(stack_frame *frame);
 	void set_frame_offset(stack_frame *frame, cell offset);
+	void scrub_return_address();
 	void primitive_callstack_to_array();
 	stack_frame *innermost_stack_frame(callstack *stack);
 	void primitive_innermost_stack_frame_executing();
@@ -654,6 +653,8 @@ struct factor_vm
 	// entry points
 	void c_to_factor(cell quot);
 	void unwind_native_frames(cell quot, stack_frame *to);
+	cell get_fpu_state();
+	void set_fpu_state(cell state);
 
 	// factor
 	void default_parameters(vm_parameters *p);