Get green threads working on Windows

- store stack base and limit in TIB
- set up a frame-based structured exception handler in each context's callstack
- boot.x86.32.image has now been replaced by boot.winnt-x86.32.image and boot.unix-x86.32.image

diff --git a/Nmakefile b/Nmakefile
index 0d815b61610d1eb938960444beada4e821a0519d..9df7a6a1eee94bad9e9b40f349d01335da6f4185 100755 (executable)
--- a/Nmakefile
+++ b/Nmakefile
@@ -2,7 +2,7 @@
 LINK_FLAGS = /nologo /DEBUG shell32.lib
 CL_FLAGS = /nologo /Zi /O2 /W3 /DFACTOR_DEBUG
 !ELSE
-LINK_FLAGS = /nologo shell32.lib
+LINK_FLAGS = /nologo /safeseh:no shell32.lib
 CL_FLAGS = /nologo /O2 /W3
 !ENDIF
 

diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor
index 141a77d2b250af45e7eafdd3009407e5d6609987..62240f73ce1f044183db3af5f84f7933a5156c0c 100644 (file)
--- a/basis/bootstrap/image/image.factor
+++ b/basis/bootstrap/image/image.factor
@@ -15,10 +15,11 @@ generalizations ;
 IN: bootstrap.image
 
 : arch ( os cpu -- arch )
+    [ dup "winnt" = "winnt" "unix" ? ] dip
     {
-        { "ppc" [ "-ppc" append ] }
-        { "x86.64" [ "winnt" = "winnt" "unix" ? "-x86.64" append ] }
-        [ nip ]
+        { "ppc" [ drop "-ppc" append ] }
+        { "x86.32" [ nip "-x86.32" append ] }
+        { "x86.64" [ nip "-x86.64" append ] }
     } case ;
 
 : my-arch ( -- arch )
@@ -32,7 +33,7 @@ IN: bootstrap.image
 
 : images ( -- seq )
     {
-        "x86.32"
+        "winnt-x86.32" "unix-x86.32"
         "winnt-x86.64" "unix-x86.64"
         "linux-ppc" "macosx-ppc"
     } ;

diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor
index 9769b728015ecc8f5a3c88ab450ed08925601e59..ac0fcff0ffd2fe31af852638b77ff51f30d1b4db 100644 (file)
--- a/basis/compiler/constants/constants.factor
+++ b/basis/compiler/constants/constants.factor
@@ -34,6 +34,10 @@ CONSTANT: deck-bits 18
 : context-datastack-offset ( -- n ) 2 bootstrap-cells ; inline
 : context-retainstack-offset ( -- n ) 3 bootstrap-cells ; inline
 : context-callstack-save-offset ( -- n ) 4 bootstrap-cells ; inline
+: context-callstack-seg-offset ( -- n ) 7 bootstrap-cells ; inline
+: segment-start-offset ( -- n ) 0 bootstrap-cells ; inline
+: segment-size-offset ( -- n ) 1 bootstrap-cells ; inline
+: segment-end-offset ( -- n ) 2 bootstrap-cells ; inline
 
 ! Relocation classes
 CONSTANT: rc-absolute-cell 0
@@ -61,6 +65,7 @@ CONSTANT: rt-megamorphic-cache-hits 8
 CONSTANT: rt-vm 9
 CONSTANT: rt-cards-offset 10
 CONSTANT: rt-decks-offset 11
+CONSTANT: rt-exception-handler 12
 
 : rc-absolute? ( n -- ? )
     ${ rc-absolute-ppc-2/2 rc-absolute-cell rc-absolute } member? ;

diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor
index 293d99fe93d48b22fb3a7150529404f4861f2b7a..9b1a1de23dc6de804065ebc9dbee4909cd071473 100644 (file)
--- a/basis/cpu/x86/32/bootstrap.factor
+++ b/basis/cpu/x86/32/bootstrap.factor
@@ -108,6 +108,14 @@ IN: bootstrap.x86
 \ (call) define-combinator-primitive
 
 [
+    ! Load ds and rs registers
+    jit-load-vm
+    jit-load-context
+    jit-restore-context
+
+    ! Windows-specific setup
+    ctx-reg jit-update-seh
+
     ! Clear x87 stack, but preserve rounding mode and exception flags
     ESP 2 SUB
     ESP [] FNSTCW
@@ -122,11 +130,6 @@ IN: bootstrap.x86
     ! Unwind stack frames
     ESP EDX MOV
 
-    ! Load ds and rs registers
-    jit-load-vm
-    jit-load-context
-    jit-restore-context
-
     jit-jump-quot
 ] \ unwind-native-frames define-sub-primitive
 
@@ -253,6 +256,9 @@ IN: bootstrap.x86
     ! Load new stack pointer
     ESP ctx-reg context-callstack-top-offset [+] MOV
 
+    ! Windows-specific setup
+    ctx-reg jit-update-tib
+
     ! Load new ds, rs registers
     jit-restore-context ;
 
@@ -266,6 +272,9 @@ IN: bootstrap.x86
     ! Make the new context active
     EAX jit-switch-context
 
+    ! Windows-specific setup
+    ctx-reg jit-update-seh
+
     ! Twiddle stack for return
     ESP 4 ADD
 
@@ -293,6 +302,12 @@ IN: bootstrap.x86
     ds-reg 4 ADD
     ds-reg [] EAX MOV
 
+    ! Windows-specific setup
+    jit-install-seh
+
+    ! Push a fake return address
+    0 PUSH
+
     ! Jump to initial quotation
     EAX EBX [] MOV
     jit-jump-quot ;

diff --git a/basis/cpu/x86/32/unix/bootstrap.factor b/basis/cpu/x86/32/unix/bootstrap.factor
new file mode 100644 (file)
index 0000000..1e3bee4
--- /dev/null
+++ b/basis/cpu/x86/32/unix/bootstrap.factor
@@ -0,0 +1,14 @@
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: cpu.x86.assembler cpu.x86.assembler.operands kernel
+layouts parser sequences ;
+IN: bootstrap.x86
+
+: jit-save-tib ( -- ) ;
+: jit-restore-tib ( -- ) ;
+: jit-update-tib ( ctx-reg -- ) drop ;
+: jit-install-seh ( -- ) ESP bootstrap-cell ADD ;
+: jit-update-seh ( ctx-reg -- ) drop ;
+
+<< "vocab:cpu/x86/32/bootstrap.factor" parse-file suffix! >>
+call

diff --git a/basis/cpu/x86/32/winnt/bootstrap.factor b/basis/cpu/x86/32/winnt/bootstrap.factor
new file mode 100644 (file)
index 0000000..b8ee1da
--- /dev/null
+++ b/basis/cpu/x86/32/winnt/bootstrap.factor
@@ -0,0 +1,54 @@
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: bootstrap.image.private compiler.constants
+cpu.x86.assembler cpu.x86.assembler.operands kernel layouts
+locals parser sequences ;
+IN: bootstrap.x86
+
+: tib-exception-list-offset ( -- n ) 0 bootstrap-cells ;
+: tib-stack-base-offset ( -- n ) 1 bootstrap-cells ;
+: tib-stack-limit-offset ( -- n ) 2 bootstrap-cells ;
+
+: jit-save-tib ( -- )
+    tib-exception-list-offset [] FS PUSH
+    tib-stack-base-offset [] FS PUSH
+    tib-stack-limit-offset [] FS PUSH ;
+
+: jit-restore-tib ( -- )
+    tib-stack-limit-offset [] FS POP
+    tib-stack-base-offset [] FS POP
+    tib-exception-list-offset [] FS POP ;
+
+:: jit-update-tib ( ctx-reg -- )
+    ! There's a redundant load here because we're not allowed
+    ! to clobber ctx-reg. Clobbers EAX.
+    ! Save callstack base in TIB
+    EAX ctx-reg context-callstack-seg-offset [+] MOV
+    EAX EAX segment-end-offset [+] MOV
+    tib-stack-base-offset [] EAX FS MOV
+    ! Save callstack limit in TIB
+    EAX ctx-reg context-callstack-seg-offset [+] MOV
+    EAX EAX segment-start-offset [+] MOV
+    tib-stack-limit-offset [] EAX FS MOV ;
+
+: jit-install-seh ( -- )
+    ! Create a new exception record and store it in the TIB.
+    ! Align stack
+    ESP 3 bootstrap-cells ADD
+    ! Exception handler address filled in by callback.cpp
+    0 PUSH rc-absolute-cell rt-exception-handler jit-rel
+    ! No next handler
+    0 PUSH
+    ! This is the new exception handler
+    tib-exception-list-offset [] ESP FS MOV ;
+
+:: jit-update-seh ( ctx-reg -- )
+    ! Load exception record structure that jit-install-seh
+    ! created from the bottom of the callstack. Clobbers EAX.
+    EAX ctx-reg context-callstack-bottom-offset [+] MOV
+    EAX bootstrap-cell ADD
+    ! Store exception record in TIB.
+    tib-exception-list-offset [] EAX FS MOV ;
+
+<< "vocab:cpu/x86/32/bootstrap.factor" parse-file suffix! >>
+call

diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor
index 6c0d50f1b7e58733590ab9e898ad83a412b5f458..c7f9901d331f3c2bc74a928cf1f25c4e4374c030 100644 (file)
--- a/basis/cpu/x86/64/bootstrap.factor
+++ b/basis/cpu/x86/64/bootstrap.factor
@@ -26,6 +26,11 @@ IN: bootstrap.x86
 : fixnum>slot@ ( -- ) temp0 1 SAR ;
 : rex-length ( -- n ) 1 ;
 
+: jit-save-tib ( -- ) ;
+: jit-restore-tib ( -- ) ;
+: jit-update-tib ( ctx-reg -- ) drop ;
+: jit-install-seh ( -- ) ESP bootstrap-cell ADD ;
+
 : jit-call ( name -- )
     RAX 0 MOV rc-absolute-cell jit-dlsym
     RAX CALL ;

diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor
index 961f0c9977100c16683ac6c2e31ca00622915429..80b56f9f9159f581433fba9d18876048e75d6478 100644 (file)
--- a/basis/cpu/x86/bootstrap.factor
+++ b/basis/cpu/x86/bootstrap.factor
@@ -20,6 +20,8 @@ big-endian off
     ! Save all non-volatile registers
     nv-regs [ PUSH ] each
 
+    jit-save-tib
+
     ! Load VM into vm-reg
     vm-reg 0 MOV rc-absolute-cell rt-vm jit-rel
 
@@ -36,7 +38,9 @@ big-endian off
 
     ! Load Factor callstack pointer
     stack-reg nv-reg context-callstack-bottom-offset [+] MOV
-    stack-reg bootstrap-cell ADD
+
+    nv-reg jit-update-tib
+    jit-install-seh
 
     ! Call into Factor code
     nv-reg 0 MOV rc-absolute-cell rt-entry-point jit-rel
@@ -55,6 +59,8 @@ big-endian off
     vm-reg vm-context-offset [+] nv-reg MOV
 
     ! Restore non-volatile registers
+    jit-restore-tib
+
     nv-regs <reversed> [ POP ] each
 
     frame-reg POP

diff --git a/basis/threads/threads-tests.factor b/basis/threads/threads-tests.factor
index 742ecaa1f778ae5731c16455f637f06b817e2734..01578d4e64a8767e49918de6d1d81b1d46496874 100644 (file)
--- a/basis/threads/threads-tests.factor
+++ b/basis/threads/threads-tests.factor
@@ -56,3 +56,6 @@ yield
 [ "x" tget "p" get fulfill ] in-thread
 
 [ f ] [ "p" get ?promise ] unit-test
+
+! Test system traps inside threads
+[ ] [ [ dup ] in-thread yield ] unit-test

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 8a412b8a1482c8115b58165b208717faef934885..87963848bf32ccdba218b0ce17dcaf27a57cc913 100644 (file)
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -18,7 +18,8 @@ H{ } clone sub-primitives set
 "vocab:bootstrap/syntax.factor" parse-file
 
 architecture get {
-    { "x86.32" "x86/32" }
+    { "winnt-x86.32" "x86/32/winnt" }
+    { "unix-x86.32" "x86/32/unix" }
     { "winnt-x86.64" "x86/64/winnt" }
     { "unix-x86.64" "x86/64/unix" }
     { "linux-ppc" "ppc/linux" }

diff --git a/vm/callbacks.cpp b/vm/callbacks.cpp
old mode 100644 (file)
new mode 100755 (executable)
index 6c8165f..fbf36c7
--- a/vm/callbacks.cpp
+++ b/vm/callbacks.cpp
@@ -38,7 +38,12 @@ void callback_heap::store_callback_operand(code_block *stub, cell index, cell va
 
 void callback_heap::update(code_block *stub)
 {
-       store_callback_operand(stub,1,(cell)callback_entry_point(stub));
+#ifdef WIN32
+       cell index = 2;
+#else
+       cell index = 1;
+#endif
+       store_callback_operand(stub,index,(cell)callback_entry_point(stub));
        stub->flush_icache();
 }
 
@@ -64,12 +69,21 @@ code_block *callback_heap::add(cell owner, cell return_rewind)
 
        /* Store VM pointer */
        store_callback_operand(stub,0,(cell)parent);
-       store_callback_operand(stub,2,(cell)parent);
+
+#ifdef WIN32
+       store_callback_operand(stub,1,(cell)&exception_handler);
+       cell index = 1;
+#else
+       cell index = 0;
+#endif
+
+       /* Store VM pointer */
+       store_callback_operand(stub,index + 2,(cell)parent);
 
        /* On x86, the RET instruction takes an argument which depends on
        the callback's calling convention */
 #if defined(FACTOR_X86) || defined(FACTOR_AMD64)
-       store_callback_operand(stub,3,return_rewind);
+       store_callback_operand(stub,index + 3,return_rewind);
 #endif
 
        update(stub);

diff --git a/vm/code_blocks.cpp b/vm/code_blocks.cpp
index 894e49846d9dedd3288f7fa9c82ffa1ed52cd310..64b218f3776c69aa76260456d4375fff8e9a37f4 100755 (executable)
--- a/vm/code_blocks.cpp
+++ b/vm/code_blocks.cpp
@@ -225,6 +225,11 @@ void factor_vm::store_external_address(instruction_operand op)
        case RT_DECKS_OFFSET:
                op.store_value(decks_offset);
                break;
+#ifdef WINDOWS
+       case RT_EXCEPTION_HANDLER:
+               op.store_value(&factor::exception_handler);
+               break;
+#endif
        default:
                critical_error("Bad rel type",op.rel_type());
                break;

diff --git a/vm/cpu-x86.hpp b/vm/cpu-x86.hpp
old mode 100644 (file)
new mode 100755 (executable)
index bfdcd8a..89d7fb7
--- a/vm/cpu-x86.hpp
+++ b/vm/cpu-x86.hpp
@@ -5,7 +5,7 @@ namespace factor
 
 #define FRAME_RETURN_ADDRESS(frame,vm) *(void **)(vm->frame_successor(frame) + 1)
 
-#define CALLSTACK_BOTTOM(ctx) (stack_frame *)(ctx->callstack_seg->end - sizeof(cell))
+#define CALLSTACK_BOTTOM(ctx) (stack_frame *)(ctx->callstack_seg->end - sizeof(cell) * 5)
 
 inline static void flush_icache(cell start, cell len) {}
 

diff --git a/vm/instruction_operands.hpp b/vm/instruction_operands.hpp
index dc8aa9d841d24a2f47b275a29aaa5b1ef61565f6..66ffddc24e7771151d80ad9c24026e6a94798918 100644 (file)
--- a/vm/instruction_operands.hpp
+++ b/vm/instruction_operands.hpp
@@ -26,6 +26,10 @@ enum relocation_type {
        RT_CARDS_OFFSET,
        /* value of vm->decks_offset */
        RT_DECKS_OFFSET,
+       /* address of exception_handler -- this exists as a separate relocation
+       type since its used in a situation where relocation arguments cannot
+       be passed in, and so RT_DLSYM is inappropriate (Windows only) */
+       RT_EXCEPTION_HANDLER,
 };
 
 enum relocation_class {
@@ -105,6 +109,7 @@ struct relocation_entry {
                case RT_MEGAMORPHIC_CACHE_HITS:
                case RT_CARDS_OFFSET:
                case RT_DECKS_OFFSET:
+               case RT_EXCEPTION_HANDLER:
                        return 0;
                default:
                        critical_error("Bad rel type",rel_type());

diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp
index 2d5881252a10872e4ab6b123de9260c8cc0cdfb5..4f90d7f641d24ed5bfe34d85c6356aa8f8062d1f 100755 (executable)
--- a/vm/os-windows-nt.cpp
+++ b/vm/os-windows-nt.cpp
@@ -48,11 +48,8 @@ void sleep_nanos(u64 nsec)
        Sleep((DWORD)(nsec/1000000));
 }
 
-LONG factor_vm::exception_handler(PEXCEPTION_POINTERS pe)
+LONG factor_vm::exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c, void *dispatch)
 {
-       PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord;
-       CONTEXT *c = (CONTEXT*)pe->ContextRecord;
-
        c->ESP = (cell)fix_callstack_top((stack_frame *)c->ESP);
        signal_callstack_top = (stack_frame *)c->ESP;
 
@@ -81,35 +78,23 @@ LONG factor_vm::exception_handler(PEXCEPTION_POINTERS pe)
                MXCSR(c) &= 0xffffffc0;
                c->EIP = (cell)factor::fp_signal_handler_impl;
                break;
-       case 0x40010006:
-               /* If the Widcomm bluetooth stack is installed, the BTTray.exe
-               process injects code into running programs. For some reason this
-               results in random SEH exceptions with this (undocumented)
-               exception code being raised. The workaround seems to be ignoring
-               this altogether, since that is what happens if SEH is not
-               enabled. Don't really have any idea what this exception means. */
-               break;
        default:
                signal_number = e->ExceptionCode;
                c->EIP = (cell)factor::misc_signal_handler_impl;
                break;
        }
-       return EXCEPTION_CONTINUE_EXECUTION;
+
+       return ExceptionContinueExecution;
 }
 
-FACTOR_STDCALL(LONG) exception_handler(PEXCEPTION_POINTERS pe)
+LONG exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c, void *dispatch)
 {
-       return current_vm()->exception_handler(pe);
+       return current_vm()->exception_handler(e,frame,c,dispatch);
 }
 
 void factor_vm::c_to_factor_toplevel(cell quot)
 {
-       if(!AddVectoredExceptionHandler(0, (PVECTORED_EXCEPTION_HANDLER)factor::exception_handler))
-               fatal_error("AddVectoredExceptionHandler failed", 0);
-
        c_to_factor(quot);
-
-       RemoveVectoredExceptionHandler((void *)factor::exception_handler);
 }
 
 void factor_vm::open_console()

diff --git a/vm/os-windows-nt.hpp b/vm/os-windows-nt.hpp
index f274d7813fc5be06a9248fd61e8198d068a95e43..d84ac972982991b63c83d90704afb9ce6135603c 100755 (executable)
--- a/vm/os-windows-nt.hpp
+++ b/vm/os-windows-nt.hpp
@@ -22,13 +22,7 @@ typedef char symbol_char;
 
 #define FACTOR_DLL NULL
 
-#ifdef _MSC_VER
-       #define FACTOR_STDCALL(return_type) return_type __stdcall
-#else
-       #define FACTOR_STDCALL(return_type) __attribute__((stdcall)) return_type
-#endif
-
-FACTOR_STDCALL(LONG) exception_handler(PEXCEPTION_POINTERS pe);
+LONG exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c, void *dispatch);
 
 // SSE traps raise these exception codes, which are defined in internal NT headers
 // but not winbase.h

diff --git a/vm/vm.hpp b/vm/vm.hpp
index cf2f0ca433bb5787b6580cc49d3d9e59a14a2128..36ec3260d6563352128e28876f5d052b92836ec2 100755 (executable)
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -706,7 +706,7 @@ struct factor_vm
 
   #if defined(WINNT)
        void open_console();
-       LONG exception_handler(PEXCEPTION_POINTERS pe);
+       LONG exception_handler(PEXCEPTION_RECORD e, void *frame, PCONTEXT c, void *dispatch);
   #endif
 
   #else  // UNIX