steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
release
Slava Pestov 2010-04-03 20:24:33 -04:00
parent be024c228c
commit 74640b7f71
17 changed files with 151 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Nmakefile
View File

@ -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

9
basis/bootstrap/image/image.factor
View File

@ -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"
} ;

5
basis/compiler/constants/constants.factor
View File

@ -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? ;

25
basis/cpu/x86/32/bootstrap.factor
View File

@ -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 ;

14
basis/cpu/x86/32/unix/bootstrap.factor Normal file
View File

@ -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

54
basis/cpu/x86/32/winnt/bootstrap.factor Normal file
View File

@ -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

5
basis/cpu/x86/64/bootstrap.factor
View File

@ -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 ;

8
basis/cpu/x86/bootstrap.factor
View File

@ -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

3
basis/threads/threads-tests.factor
View File

@ -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

3
core/bootstrap/primitives.factor
View File

@ -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" }

20
vm/callbacks.cpp Normal file → Executable file
View File

@ -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);

5
vm/code_blocks.cpp
View File

@ -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;

2
vm/cpu-x86.hpp Normal file → Executable file
View File

@ -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) {}

5
vm/instruction_operands.hpp
View File

@ -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());

25
vm/os-windows-nt.cpp
View File

@ -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()

8
vm/os-windows-nt.hpp
View File

@ -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

2
vm/vm.hpp
View File

@ -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