Fix three problems discovered by running math.floats.env tests in a loop:

- Crash if allocating error triggers a GC from a signal/SEH handler
- Crash if GC runs with floating point traps enabled on Windows
- Floating point traps didn't prettyprint properly

diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor
old mode 100644 (file)
new mode 100755 (executable)
index 371902e..891dbb9
--- a/basis/bootstrap/image/image.factor
+++ b/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 ( -- )

diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor
old mode 100644 (file)
new mode 100755 (executable)
index 5eb25fc..f95bb6c
--- a/basis/cpu/x86/32/bootstrap.factor
+++ b/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

diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor
old mode 100644 (file)
new mode 100755 (executable)
index d491354..ac92fd5
--- a/basis/cpu/x86/64/bootstrap.factor
+++ b/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-vesion-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

diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor
old mode 100644 (file)
new mode 100755 (executable)
index eca34c2..9159b7f
--- a/basis/debugger/debugger.factor
+++ b/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 )

diff --git a/basis/math/floats/env/env-tests.factor b/basis/math/floats/env/env-tests.factor
index 08e2ed1a9e3c45864923f0573fd761a18ab35fe4..c762d265c3e3a532dfa7574dfea2839b41f3b749 100755 (executable)
--- a/basis/math/floats/env/env-tests.factor
+++ b/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
-

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
old mode 100644 (file)
new mode 100755 (executable)
index 7143d03..bdd9446
--- a/core/bootstrap/primitives.factor
+++ b/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" (( -- )) }

diff --git a/vm/callstack.cpp b/vm/callstack.cpp
index 64c17d8661ccd2e3d033d7fbfa23ed8455530028..efd786c9fc0b68b8ebe4d9799f85afc70ab40fdb 100755 (executable)
--- a/vm/callstack.cpp
+++ b/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 *callstack_top)
+{
+       stack_frame *top = 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))

diff --git a/vm/entry_points.cpp b/vm/entry_points.cpp
old mode 100644 (file)
new mode 100755 (executable)
index e07e343..2bc8f05
--- a/vm/entry_points.cpp
+++ b/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);
+}
+
 }

diff --git a/vm/entry_points.hpp b/vm/entry_points.hpp
old mode 100644 (file)
new mode 100755 (executable)
index 873501f..7c7a1b9
--- a/vm/entry_points.hpp
+++ b/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);
 
 }

diff --git a/vm/errors.cpp b/vm/errors.cpp
index 61d4a73194015e3821ca2c4fae39648a17b37ab5..daeed93c652b251c3b853c6f149ecd30cd3b7b2a 100755 (executable)
--- a/vm/errors.cpp
+++ b/vm/errors.cpp
@@ -128,6 +128,7 @@ void factor_vm::primitive_unimplemented()
 
 void factor_vm::memory_signal_handler_impl()
 {
+       scrub_return_address(signal_callstack_top);
        memory_protection_error(signal_fault_addr,signal_callstack_top);
 }
 
@@ -138,6 +139,7 @@ void memory_signal_handler_impl()
 
 void factor_vm::misc_signal_handler_impl()
 {
+       scrub_return_address(signal_callstack_top);
        signal_error(signal_number,signal_callstack_top);
 }
 
@@ -148,6 +150,10 @@ void misc_signal_handler_impl()
 
 void factor_vm::fp_signal_handler_impl()
 {
+       /* Clear pending exceptions to avoid getting stuck in a loop */
+       set_fpu_state(get_fpu_state());
+
+       scrub_return_address(signal_callstack_top);
        fp_trap_error(signal_fpu_status,signal_callstack_top);
 }
 

diff --git a/vm/gc.cpp b/vm/gc.cpp
index 766940a2d7160ab1152446c3b95a5b4f9ea3c72d..d898ba89af46eb687ebe70f56b04cf5b8cb4331c 100755 (executable)
--- a/vm/gc.cpp
+++ b/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

diff --git a/vm/mach_signal.cpp b/vm/mach_signal.cpp
old mode 100644 (file)
new mode 100755 (executable)
index af14c3a..d344994
--- a/vm/mach_signal.cpp
+++ b/vm/mach_signal.cpp
@@ -38,6 +38,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)

diff --git a/vm/objects.hpp b/vm/objects.hpp
old mode 100644 (file)
new mode 100755 (executable)
index 8d883ec..41265cd
--- a/vm/objects.hpp
+++ b/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 */

diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp
old mode 100644 (file)
new mode 100755 (executable)
index e95b84f..21be9f6
--- a/vm/os-unix.cpp
+++ b/vm/os-unix.cpp
@@ -119,6 +119,7 @@ void factor_vm::dispatch_signal(void *uap, void (handler)())
        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)

diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp
index 7fdb882122b0d31368321de7619d3d15a9ca188e..0b5ed049d21a11ec935550253d1b1b631fda7b38 100755 (executable)
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@@ -51,6 +51,7 @@ LONG factor_vm::exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c,
 {
        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 +73,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;

diff --git a/vm/vm.hpp b/vm/vm.hpp
index 6aa3543c8f5c4a6a33a54f66d285abff434efd12..5d818cc31b97ab1762d7b494b11531a0dc2fc7aa 100755 (executable)
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -588,6 +588,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(stack_frame *callstack_top);
        void primitive_callstack_to_array();
        stack_frame *innermost_stack_frame(callstack *stack);
        void primitive_innermost_stack_frame_executing();
@@ -654,6 +655,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);