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

vm: move c_to_factor, lazy_jit_compile_impl, throw_impl, set_callstack assembly routines into non-optimizing compiler for x86-64

db4
Slava Pestov 2010-01-06 15:47:36 +13:00
parent 18929373b9
commit 36d2ac8921
33 changed files with 253 additions and 320 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile
View File

@ -47,6 +47,7 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \
vm/data_heap_checker.o \
vm/debug.o \
vm/dispatch.o \
vm/entry_points.o \
vm/errors.o \
vm/factor.o \
vm/free_list.o \

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

@ -155,7 +155,7 @@ SYMBOL: jit-literals
: define-sub-primitive ( quot word -- )
[ make-jit 3array ] dip sub-primitives get set-at ;
: define-sub-primitive* ( quot non-tail-quot tail-quot word -- )
: define-combinator-primitive ( quot non-tail-quot tail-quot word -- )
[
[ make-jit ]
[ make-jit 2nip ]
@ -202,6 +202,10 @@ USERENV: jit-3dip 39
USERENV: jit-execute 40
USERENV: jit-declare-word 41
USERENV: c-to-factor-word 42
USERENV: lazy-jit-compile-word 43
USERENV: unwind-native-frames-word 44
USERENV: callback-stub 48
! PIC stubs
@ -534,11 +538,14 @@ M: quotation '
\ dip jit-dip-word set
\ 2dip jit-2dip-word set
\ 3dip jit-3dip-word set
\ inline-cache-miss \ pic-miss-word set
\ inline-cache-miss-tail \ pic-miss-tail-word set
\ mega-cache-lookup \ mega-lookup-word set
\ mega-cache-miss \ mega-miss-word set
\ inline-cache-miss pic-miss-word set
\ inline-cache-miss-tail pic-miss-tail-word set
\ mega-cache-lookup mega-lookup-word set
\ mega-cache-miss mega-miss-word set
\ declare jit-declare-word set
\ c-to-factor c-to-factor-word set
\ lazy-jit-compile lazy-jit-compile-word set
\ unwind-native-frames unwind-native-frames-word set
[ undefined ] undefined-quot set ;
: emit-userenvs ( -- )

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

@ -25,6 +25,8 @@ CONSTANT: deck-bits 18
: word-code-offset ( -- n ) 11 \ word type-number slot-offset ; inline
: array-start-offset ( -- n ) 2 array type-number slot-offset ; inline
: compiled-header-size ( -- n ) 4 bootstrap-cells ; inline
: callstack-length-offset ( -- n ) 1 \ callstack type-number slot-offset ; inline
: callstack-top-offset ( -- n ) 2 \ callstack type-number slot-offset ; inline
! Relocation classes
CONSTANT: rc-absolute-cell 0

2
basis/cpu/architecture/architecture.factor
View File

@ -550,7 +550,7 @@ HOOK: %save-param-reg cpu ( stack reg rep -- )
HOOK: %load-param-reg cpu ( stack reg rep -- )
HOOK: %load-context cpu ( temp1 temp2 -- )
HOOK: %restore-context cpu ( temp1 temp2 -- )
HOOK: %save-context cpu ( temp1 temp2 -- )

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

@ -215,12 +215,12 @@ CONSTANT: vm-reg 15
[ jit-load-return-address jit-inline-cache-miss ]
[ 3 MTLR BLRL ]
[ 3 MTCTR BCTR ]
\ inline-cache-miss define-sub-primitive*
\ inline-cache-miss define-combinator-primitive
[ jit-inline-cache-miss ]
[ 3 MTLR BLRL ]
[ 3 MTCTR BCTR ]
\ inline-cache-miss-tail define-sub-primitive*
\ inline-cache-miss-tail define-combinator-primitive
! ! ! Megamorphic caches
@ -271,7 +271,7 @@ CONSTANT: vm-reg 15
5 3 quot-xt-offset LWZ
]
[ 5 MTLR BLRL ]
[ 5 MTCTR BCTR ] \ (call) define-sub-primitive*
[ 5 MTCTR BCTR ] \ (call) define-combinator-primitive
[
3 ds-reg 0 LWZ
@ -279,7 +279,7 @@ CONSTANT: vm-reg 15
4 3 word-xt-offset LWZ
]
[ 4 MTLR BLRL ]
[ 4 MTCTR BCTR ] \ (execute) define-sub-primitive*
[ 4 MTCTR BCTR ] \ (execute) define-combinator-primitive
[
3 ds-reg 0 LWZ

2
basis/cpu/x86/32/32.factor
View File

@ -235,7 +235,7 @@ M: x86.32 %alien-indirect ( -- )
EBP CALL ;
M: x86.32 %alien-callback ( quot -- )
EAX EDX %load-context
EAX EDX %restore-context
EAX swap %load-reference
EDX %mov-vm-ptr
EAX quot-xt-offset [+] CALL

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

@ -77,7 +77,7 @@ IN: bootstrap.x86
]
[ EAX quot-xt-offset [+] CALL ]
[ EAX quot-xt-offset [+] JMP ]
\ (call) define-sub-primitive*
\ (call) define-combinator-primitive
! Inline cache miss entry points
: jit-load-return-address ( -- )
@ -96,12 +96,12 @@ IN: bootstrap.x86
[ jit-load-return-address jit-inline-cache-miss ]
[ EAX CALL ]
[ EAX JMP ]
\ inline-cache-miss define-sub-primitive*
\ inline-cache-miss define-combinator-primitive
[ jit-inline-cache-miss ]
[ EAX CALL ]
[ EAX JMP ]
\ inline-cache-miss-tail define-sub-primitive*
\ inline-cache-miss-tail define-combinator-primitive
! Overflowing fixnum arithmetic
: jit-overflow ( insn func -- )

2
basis/cpu/x86/64/64.factor
View File

@ -223,7 +223,7 @@ M: x86.64 %alien-indirect ( -- )
RBP CALL ;
M: x86.64 %alien-callback ( quot -- )
param-reg-0 param-reg-1 %load-context
param-reg-0 param-reg-1 %restore-context
param-reg-0 swap %load-reference
param-reg-1 %mov-vm-ptr
param-reg-0 quot-xt-offset [+] CALL

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

@ -1,9 +1,10 @@
! Copyright (C) 2007, 2009 Slava Pestov.
! Copyright (C) 2007, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.private kernel kernel.private namespaces
system layouts vocabs parser compiler.constants math
math.private cpu.x86.assembler cpu.x86.assembler.operands
sequences generic.single.private ;
FROM: vm => context-field-offset vm-field-offset ;
IN: bootstrap.x86
8 \ cell set
@ -15,9 +16,12 @@ IN: bootstrap.x86
: temp1 ( -- reg ) RSI ;
: temp2 ( -- reg ) RDX ;
: temp3 ( -- reg ) RBX ;
: return-reg ( -- reg ) RAX ;
: safe-reg ( -- reg ) RAX ;
: stack-reg ( -- reg ) RSP ;
: frame-reg ( -- reg ) RBP ;
: vm-reg ( -- reg ) R12 ;
: ctx-reg ( -- reg ) R13 ;
: ds-reg ( -- reg ) R14 ;
: rs-reg ( -- reg ) R15 ;
: fixnum>slot@ ( -- ) temp0 1 SAR ;
@ -25,60 +29,114 @@ IN: bootstrap.x86
[
! load XT
RDI 0 MOV rc-absolute-cell rt-this jit-rel
safe-reg 0 MOV rc-absolute-cell rt-this jit-rel
! save stack frame size
stack-frame-size PUSH
! push XT
RDI PUSH
safe-reg PUSH
! alignment
RSP stack-frame-size 3 bootstrap-cells - SUB
] jit-prolog jit-define
: jit-load-vm ( -- )
RBP 0 MOV 0 rc-absolute-cell jit-vm ;
vm-reg 0 MOV 0 rc-absolute-cell jit-vm ;
: jit-load-context ( -- )
! VM pointer must be in vm-reg already
ctx-reg vm-reg "ctx" vm-field-offset [+] MOV ;
: jit-save-context ( -- )
! VM pointer must be in RBP already
RCX RBP [] MOV
! save ctx->callstack_top
RAX RSP -8 [+] LEA
RCX [] RAX MOV
! save ctx->datastack
RCX 16 [+] ds-reg MOV
! save ctx->retainstack
RCX 24 [+] rs-reg MOV ;
jit-load-context
safe-reg RSP -8 [+] LEA
ctx-reg "callstack-top" context-field-offset [+] safe-reg MOV
ctx-reg "datastack" context-field-offset [+] ds-reg MOV
ctx-reg "retainstack" context-field-offset [+] rs-reg MOV ;
: jit-restore-context ( -- )
! VM pointer must be in EBP already
RCX RBP [] MOV
! restore ctx->datastack
ds-reg RCX 16 [+] MOV
! restore ctx->retainstack
rs-reg RCX 24 [+] MOV ;
jit-load-context
ds-reg ctx-reg "datastack" context-field-offset [+] MOV
rs-reg ctx-reg "retainstack" context-field-offset [+] MOV ;
[
jit-load-vm
! save ds, rs registers
jit-save-context
! call the primitive
arg1 RBP MOV
arg1 vm-reg MOV
RAX 0 MOV rc-absolute-cell rt-primitive jit-rel
RAX CALL
! restore ds, rs registers
jit-restore-context
] jit-primitive jit-define
[
! load from stack
jit-load-vm
jit-restore-context
! save ctx->callstack_bottom
safe-reg stack-reg stack-frame-size bootstrap-cell - [+] LEA
ctx-reg "callstack-bottom" context-field-offset [+] safe-reg MOV
! call the quotation
arg1 quot-xt-offset [+] CALL
jit-save-context
] \ c-to-factor define-sub-primitive
[
arg1 ds-reg [] MOV
! pop stack
ds-reg bootstrap-cell SUB
! load VM pointer
arg2 0 MOV 0 rc-absolute-cell jit-vm
]
[ arg1 quot-xt-offset [+] CALL ]
[ arg1 quot-xt-offset [+] JMP ]
\ (call) define-sub-primitive*
\ (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
! Load ds and rs registers
jit-load-vm
jit-restore-context
! Call quotation
arg1 quot-xt-offset [+] JMP
] \ unwind-native-frames define-sub-primitive
[
! Load callstack object
arg4 ds-reg [] MOV
ds-reg bootstrap-cell SUB
! Get ctx->callstack_bottom
jit-load-vm
jit-load-context
arg1 ctx-reg "callstack-bottom" context-field-offset [+] MOV
! Get top of callstack object -- 'src' for memcpy
arg2 arg4 callstack-top-offset [+] LEA
! Get callstack length, in bytes --- 'len' for memcpy
arg3 arg4 callstack-length-offset [+] MOV
arg3 tag-bits get SHR
! Compute new stack pointer -- 'dst' for memcpy
arg1 arg3 SUB
RSP arg1 MOV
! Call memcpy; arguments are now in the correct registers
safe-reg 0 MOV "memcpy" f rc-absolute-cell jit-dlsym
safe-reg CALL
! Return with new callstack
0 RET
] \ set-callstack define-sub-primitive
[
jit-load-vm
jit-save-context
arg2 vm-reg MOV
safe-reg 0 MOV "lazy_jit_compile" f rc-absolute-cell jit-dlsym
safe-reg CALL
]
[ return-reg quot-xt-offset [+] CALL ]
[ return-reg quot-xt-offset [+] JMP ]
\ lazy-jit-compile define-combinator-primitive
! Inline cache miss entry points
: jit-load-return-address ( -- )
@ -90,7 +148,7 @@ IN: bootstrap.x86
jit-load-vm
jit-save-context
arg1 RBX MOV
arg2 RBP MOV
arg2 vm-reg MOV
RAX 0 MOV "inline_cache_miss" f rc-absolute-cell jit-dlsym
RAX CALL
jit-restore-context ;
@ -98,12 +156,12 @@ IN: bootstrap.x86
[ jit-load-return-address jit-inline-cache-miss ]
[ RAX CALL ]
[ RAX JMP ]
\ inline-cache-miss define-sub-primitive*
\ inline-cache-miss define-combinator-primitive
[ jit-inline-cache-miss ]
[ RAX CALL ]
[ RAX JMP ]
\ inline-cache-miss-tail define-sub-primitive*
\ inline-cache-miss-tail define-combinator-primitive
! Overflowing fixnum arithmetic
: jit-overflow ( insn func -- )
@ -117,7 +175,7 @@ IN: bootstrap.x86
ds-reg [] arg3 MOV
[ JNO ]
[
arg3 RBP MOV
arg3 vm-reg MOV
RAX 0 MOV f rc-absolute-cell jit-dlsym
RAX CALL
]
@ -142,7 +200,7 @@ IN: bootstrap.x86
arg1 RCX MOV
arg1 tag-bits get SAR
arg2 RBX MOV
arg3 RBP MOV
arg3 vm-reg MOV
RAX 0 MOV "overflow_fixnum_multiply" f rc-absolute-cell jit-dlsym
RAX CALL
]

5
basis/cpu/x86/assembler/assembler.factor
View File

@ -385,6 +385,11 @@ PRIVATE>
: FLDS ( operand -- ) { BIN: 000 f HEX: d9 } 1-operand ;
: FLDL ( operand -- ) { BIN: 000 f HEX: dd } 1-operand ;
: FNSTCW ( operand -- ) { BIN: 111 f HEX: d9 } 1-operand ;
: FLDCW ( operand -- ) { BIN: 101 f HEX: d9 } 1-operand ;
: FNINIT ( -- ) HEX: db , HEX: e3 , ;
! SSE multimedia instructions
<PRIVATE

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

@ -169,7 +169,7 @@ big-endian off
]
[ temp0 word-xt-offset [+] CALL ]
[ temp0 word-xt-offset [+] JMP ]
\ (execute) define-sub-primitive*
\ (execute) define-combinator-primitive
[
temp0 ds-reg [] MOV

20
basis/cpu/x86/x86.factor
View File

@ -1410,18 +1410,15 @@ M:: x86 %reload ( dst rep src -- ) dst src rep %copy ;
M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
M:: x86 %load-context ( temp1 temp2 -- )
M:: x86 %restore-context ( temp1 temp2 -- )
#! Load Factor stack pointers on entry from C to Factor.
#! Also save callstack bottom!
temp1 "ctx" %vm-field-ptr
temp1 temp1 [] MOV
! callstack_bottom
temp2 stack-reg stack-frame get total-size>> cell - [+] LEA
temp1 1 cells [+] temp2 MOV
! datastack
ds-reg temp1 2 cells [+] MOV
! retainstack
rs-reg temp1 3 cells [+] MOV ;
temp1 "callstack-bottom" context-field-offset [+] temp2 MOV
ds-reg temp1 "datastack" context-field-offset [+] MOV
rs-reg temp1 "retainstack" context-field-offset [+] MOV ;
M:: x86 %save-context ( temp1 temp2 -- )
#! Save Factor stack pointers in case the C code calls a
@ -1429,13 +1426,10 @@ M:: x86 %save-context ( temp1 temp2 -- )
#! all roots.
temp1 "ctx" %vm-field-ptr
temp1 temp1 [] MOV
! callstack_top
temp2 stack-reg cell neg [+] LEA
temp1 [] temp2 MOV
! datastack
temp1 2 cells [+] ds-reg MOV
! retainstack
temp1 3 cells [+] rs-reg MOV ;
temp1 "callstack-top" context-field-offset [+] temp2 MOV
temp1 "datastack" context-field-offset [+] ds-reg MOV
temp1 "retainstack" context-field-offset [+] rs-reg MOV ;
M: x86 value-struct? drop t ;

2
basis/prettyprint/prettyprint.factor
View File

@ -73,7 +73,7 @@ SYMBOL: ->
: remove-breakpoints ( quot pos -- quot' )
over quotation? [
1 + cut [ (remove-breakpoints) ] bi@
1 + short cut [ (remove-breakpoints) ] bi@
[ -> ] glue
] [
drop

2
basis/vm/vm.factor
View File

@ -9,7 +9,7 @@ STRUCT: context
{ callstack-top void* }
{ callstack-bottom void* }
{ datastack cell }
{ callstack cell }
{ retainstack cell }
{ magic-frame void* }
{ datastack-region void* }
{ retainstack-region void* }

57
core/bootstrap/primitives.factor
View File

@ -312,8 +312,36 @@ tuple
[ create dup 1quotation ] dip define-declared ;
{
{ "mega-cache-lookup" "generic.single.private" (( methods index cache -- )) }
{ "inline-cache-miss" "generic.single.private" (( generic methods index cache -- )) }
{ "inline-cache-miss-tail" "generic.single.private" (( generic methods index cache -- )) }
{ "drop" "kernel" (( x -- )) }
{ "2drop" "kernel" (( x y -- )) }
{ "3drop" "kernel" (( x y z -- )) }
{ "dup" "kernel" (( x -- x x )) }
{ "2dup" "kernel" (( x y -- x y x y )) }
{ "3dup" "kernel" (( x y z -- x y z x y z )) }
{ "rot" "kernel" (( x y z -- y z x )) }
{ "-rot" "kernel" (( x y z -- z x y )) }
{ "dupd" "kernel" (( x y -- x x y )) }
{ "swapd" "kernel" (( x y z -- y x z )) }
{ "nip" "kernel" (( x y -- y )) }
{ "2nip" "kernel" (( x y z -- z )) }
{ "over" "kernel" (( x y -- x y x )) }
{ "pick" "kernel" (( x y z -- x y z x )) }
{ "swap" "kernel" (( x y -- y x )) }
{ "eq?" "kernel" (( obj1 obj2 -- ? )) }
{ "tag" "kernel.private" (( object -- n )) }
{ "(execute)" "kernel.private" (( word -- )) }
{ "(call)" "kernel.private" (( quot -- )) }
{ "unwind-native-frames" "kernel.private" (( -- )) }
{ "set-callstack" "kernel.private" (( cs -- * )) }
{ "lazy-jit-compile" "kernel.private" (( -- )) }
{ "c-to-factor" "kernel.private" (( -- )) }
{ "slot" "slots.private" (( obj m -- value )) }
{ "get-local" "locals.backend" (( n -- obj )) }
{ "load-local" "locals.backend" (( obj -- )) }
{ "drop-locals" "locals.backend" (( n -- )) }
{ "both-fixnums?" "math.private" (( x y -- ? )) }
{ "fixnum+fast" "math.private" (( x y -- z )) }
{ "fixnum-fast" "math.private" (( x y -- z )) }
@ -333,30 +361,6 @@ tuple
{ "fixnum<=" "math.private" (( x y -- z )) }
{ "fixnum>" "math.private" (( x y -- ? )) }
{ "fixnum>=" "math.private" (( x y -- ? )) }
{ "drop" "kernel" (( x -- )) }
{ "2drop" "kernel" (( x y -- )) }
{ "3drop" "kernel" (( x y z -- )) }
{ "dup" "kernel" (( x -- x x )) }
{ "2dup" "kernel" (( x y -- x y x y )) }
{ "3dup" "kernel" (( x y z -- x y z x y z )) }
{ "rot" "kernel" (( x y z -- y z x )) }
{ "-rot" "kernel" (( x y z -- z x y )) }
{ "dupd" "kernel" (( x y -- x x y )) }
{ "swapd" "kernel" (( x y z -- y x z )) }
{ "nip" "kernel" (( x y -- y )) }
{ "2nip" "kernel" (( x y z -- z )) }
{ "over" "kernel" (( x y -- x y x )) }
{ "pick" "kernel" (( x y z -- x y z x )) }
{ "swap" "kernel" (( x y -- y x )) }
{ "eq?" "kernel" (( obj1 obj2 -- ? )) }
{ "tag" "kernel.private" (( object -- n )) }
{ "slot" "slots.private" (( obj m -- value )) }
{ "get-local" "locals.backend" (( n -- obj )) }
{ "load-local" "locals.backend" (( obj -- )) }
{ "drop-locals" "locals.backend" (( n -- )) }
{ "mega-cache-lookup" "generic.single.private" (( methods index cache -- )) }
{ "inline-cache-miss" "generic.single.private" (( generic methods index cache -- )) }
{ "inline-cache-miss-tail" "generic.single.private" (( generic methods index cache -- )) }
} [ first3 make-sub-primitive ] each
! Primitive words
@ -428,9 +432,8 @@ tuple
{ "datastack" "kernel" (( -- ds )) }
{ "retainstack" "kernel" (( -- rs )) }
{ "callstack" "kernel" (( -- cs )) }
{ "set-datastack" "kernel" (( ds -- )) }
{ "set-retainstack" "kernel" (( rs -- )) }
{ "set-callstack" "kernel" (( cs -- * )) }
{ "set-datastack" "kernel.private" (( ds -- )) }
{ "set-retainstack" "kernel.private" (( rs -- )) }
{ "(exit)" "system" (( n -- )) }
{ "data-room" "memory" (( -- data-room )) }
{ "code-room" "memory" (( -- code-room )) }

14
vm/callstack.cpp
View File

@ -60,20 +60,6 @@ void factor_vm::primitive_callstack()
ctx->push(tag<callstack>(stack));
}
void factor_vm::primitive_set_callstack()
{
callstack *stack = untag_check<callstack>(ctx->pop());
set_callstack(this,
ctx->callstack_bottom,
stack->top(),
untag_fixnum(stack->length),
memcpy);
/* We cannot return here ... */
critical_error("Bug in set_callstack()",0);
}
code_block *factor_vm::frame_code(stack_frame *frame)
{
check_frame(frame);

2
vm/code_block_visitor.hpp
View File

@ -72,8 +72,6 @@ void code_block_visitor<Visitor>::visit_object_code_block(object *obj)
quotation *q = (quotation *)obj;
if(q->code)
parent->set_quot_xt(q,visitor(q->code));
else
q->xt = (void *)lazy_jit_compile_impl;
break;
}
case CALLSTACK_TYPE:

177
vm/cpu-x86.64.S
View File

@ -1,180 +1,5 @@
#include "asm.h"
#define DS_REG %r14
#define RS_REG %r15
#define RETURN_REG %rax
#define QUOT_XT_OFFSET 28
#ifdef WINDOWS
#define ARG0 %rcx
#define ARG1 %rdx
#define ARG2 %r8
#define ARG3 %r9
#define PUSH_NONVOLATILE \
push %r15 ; \
push %r14 ; \
push %r12 ; \
push %r13 ; \
push %rdi ; \
push %rsi ; \
push %rbx ; \
push %rbp
#define POP_NONVOLATILE \
pop %rbp ; \
pop %rbx ; \
pop %rsi ; \
pop %rdi ; \
pop %r13 ; \
pop %r12 ; \
pop %r14 ; \
pop %r15
#else
#define ARG0 %rdi
#define ARG1 %rsi
#define ARG2 %rdx
#define ARG3 %rcx
#define PUSH_NONVOLATILE \
push %rbx ; \
push %rbp ; \
push %r12 ; \
push %r13 ; \
push %r14 ; \
push %r15
#define POP_NONVOLATILE \
pop %r15 ; \
pop %r14 ; \
pop %r13 ; \
pop %r12 ; \
pop %rbp ; \
pop %rbx
#endif
DEF(void,c_to_factor,(cell quot, void *vm)):
PUSH_NONVOLATILE
/* Save old stack pointer and align */
mov %rsp,%rbp
and $-16,%rsp
push %rbp
/* Set up stack frame for the call to the boot quotation */
push ARG0
push ARG1
/* Create register shadow area (required for Win64 only) */
sub $40,%rsp
/* Load context */
mov (ARG1),ARG2
/* Save ctx->callstack_bottom */
lea -8(%rsp),ARG3
mov ARG3,8(ARG2)
/* Load ctx->datastack */
mov 16(ARG2),DS_REG
/* Load ctx->retainstack */
mov 24(ARG2),RS_REG
/* Call quot-xt */
call *QUOT_XT_OFFSET(ARG0)
/* Tear down register shadow area */
add $40,%rsp
/* Tear down stack frame for the call to the boot quotation */
pop ARG1
pop ARG0
/* Undo stack alignment */
pop %rbp
mov %rbp,%rsp
/* Load context */
mov (ARG1),ARG2
/* Save ctx->datastack */
mov DS_REG,16(ARG2)
/* Save ctx->retainstack */
mov RS_REG,24(ARG2)
POP_NONVOLATILE
ret
DEF(void,set_callstack,(void *vm, stack_frame *to, stack_frame *from, cell length)):
/* save VM pointer in non-volatile register */
mov ARG0,%rbp
/* compute new stack pointer */
sub ARG3,ARG1
mov ARG1,%rsp
/* call memcpy */
mov ARG1,ARG0
mov ARG2,ARG1
mov ARG3,ARG2
call MANGLE(memcpy)
/* load context */
mov (%rbp),ARG2
/* load datastack */
mov 16(ARG2),DS_REG
/* load retainstack */
mov 24(ARG2),RS_REG
/* return with new stack */
ret
DEF(void,throw_impl,(cell quot, void *new_stack, void *vm)):
/* clear x87 stack, but preserve rounding mode and exception flags */
sub $2,%rsp
fnstcw (%rsp)
fninit
fldcw (%rsp)
/* shuffle args */
mov ARG1,%rsp
mov ARG2,ARG1
/* load context */
mov (ARG1),ARG2
/* load datastack */
mov 16(ARG2),DS_REG
/* load retainstack */
mov 24(ARG2),RS_REG
jmp *QUOT_XT_OFFSET(ARG0)
DEF(void,lazy_jit_compile_impl,(cell quot, void *vm)):
/* load context */
mov (ARG1),ARG2
/* save datastack */
mov DS_REG,16(ARG2)
/* save retainstack */
mov RS_REG,24(ARG2)
/* save callstack */
lea -8(%rsp),%rbp
mov %rbp,(ARG2)
/* compile quotation */
sub $8,%rsp
call MANGLE(lazy_jit_compile)
add $8,%rsp
/* call quotation */
jmp *QUOT_XT_OFFSET(RETURN_REG)
DEF(long long,read_timestamp_counter,(void)):
mov $0,%rax
rdtsc
@ -200,4 +25,6 @@ DEF(void,set_x87_env,(const void*)):
fldcw 2(%rdi)
ret
#define RETURN_REG %rax
#include "cpu-x86.S"

1
vm/cpu-x86.S
View File

@ -38,5 +38,4 @@ sse_1:
#ifdef WINDOWS
.section .drectve
.ascii " -export:sse_version"
.ascii " -export:c_to_factor"
#endif

12
vm/cpu-x86.hpp
View File

@ -73,16 +73,4 @@ inline static unsigned int fpu_status(unsigned int status)
return r;
}
/* Defined in assembly */
VM_C_API void c_to_factor(cell quot, void *vm);
VM_C_API void throw_impl(cell quot, void *new_stack, void *vm);
VM_C_API void lazy_jit_compile_impl(cell quot, void *vm);
VM_C_API void set_callstack(
void *vm,
stack_frame *to,
stack_frame *from,
cell length,
void *(*memcpy)(void*,const void*, size_t));
}

22
vm/entry_points.cpp Normal file
View File

@ -0,0 +1,22 @@
#include "master.hpp"
namespace factor
{
void factor_vm::c_to_factor(cell quot)
{
/* First time this is called, wrap the c-to-factor sub-primitive inside
of a callback stub, which saves and restores non-volatile registers
as per platform ABI conventions, so that the Factor compiler can treat
all registers as volatile */
if(!c_to_factor_func)
{
tagged<word> c_to_factor_word(special_objects[C_TO_FACTOR_WORD]);
code_block *c_to_factor_block = callbacks->add(c_to_factor_word.value(),0);
c_to_factor_func = (c_to_factor_func_type)c_to_factor_block->xt();
}
c_to_factor_func(quot);
}
}

6
vm/entry_points.hpp Normal file
View File

@ -0,0 +1,6 @@
namespace factor
{
typedef void (* c_to_factor_func_type)(cell quot);
}

6
vm/errors.cpp
View File

@ -31,7 +31,7 @@ void factor_vm::throw_error(cell error, stack_frame *callstack_top)
{
/* 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[OBJ_BREAK]))
if(!current_gc && to_boolean(special_objects[ERROR_HANDLER_QUOT]))
{
/* If error was thrown during heap scan, we re-enable the GC */
gc_off = false;
@ -56,7 +56,7 @@ void factor_vm::throw_error(cell error, stack_frame *callstack_top)
else
callstack_top = ctx->callstack_top;
throw_impl(special_objects[OBJ_BREAK],callstack_top,this);
unwind_native_frames(special_objects[ERROR_HANDLER_QUOT],callstack_top);
}
/* Error was thrown in early startup before error handler is set, just
crash. */
@ -130,7 +130,7 @@ void factor_vm::fp_trap_error(unsigned int fpu_status, stack_frame *signal_calls
void factor_vm::primitive_call_clear()
{
throw_impl(ctx->pop(),ctx->callstack_bottom,this);
unwind_native_frames(ctx->pop(),ctx->callstack_bottom);
}
/* For testing purposes */

1
vm/factor.cpp
View File

@ -87,6 +87,7 @@ void factor_vm::do_stage1_init()
compile_all_words();
update_code_heap_words();
initialize_all_quotations();
special_objects[OBJ_STAGE2] = true_object;
std::cout << "done\n";

1
vm/master.hpp
View File

@ -74,6 +74,7 @@ namespace factor
#include "alien.hpp"
#include "callbacks.hpp"
#include "dispatch.hpp"
#include "entry_points.hpp"
#include "vm.hpp"
#include "allot.hpp"
#include "tagged.hpp"

7
vm/objects.hpp
View File

@ -11,7 +11,7 @@ enum special_object {
OBJ_WALKER_HOOK, /* non-local exit hook, used by library only */
OBJ_CALLCC_1, /* used to pass the value in callcc1 */
OBJ_BREAK = 5, /* quotation called by throw primitive */
ERROR_HANDLER_QUOT = 5, /* quotation called when VM throws an error */
OBJ_ERROR, /* a marker consed onto kernel errors */
OBJ_CELL_SIZE = 7, /* sizeof(cell) */
@ -57,6 +57,11 @@ enum special_object {
JIT_EXECUTE,
JIT_DECLARE_WORD,
/* External entry points */
C_TO_FACTOR_WORD,
LAZY_JIT_COMPILE_WORD,
UNWIND_NATIVE_FRAMES_WORD,
/* Incremented on every modify-code-heap call; invalidates call( inline
caching */
REDEFINITION_COUNTER = 47,

2
vm/os-genunix.cpp
View File

@ -6,7 +6,7 @@ namespace factor
void factor_vm::c_to_factor_toplevel(cell quot)
{
c_to_factor(quot,this);
c_to_factor(quot);
}
void init_signals()

2
vm/os-macosx.mm
View File

@ -11,7 +11,7 @@ void factor_vm::c_to_factor_toplevel(cell quot)
for(;;)
{
NS_DURING
c_to_factor(quot,this);
c_to_factor(quot);
NS_VOIDRETURN;
NS_HANDLER
ctx->push(allot_alien(false_object,(cell)localException));

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

@ -117,16 +117,13 @@ FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
return tls_vm()->exception_handler(pe);
}
bool handler_added = 0;
void factor_vm::c_to_factor_toplevel(cell quot)
{
if(!handler_added){
if(!AddVectoredExceptionHandler(0, (PVECTORED_EXCEPTION_HANDLER)factor::exception_handler))
fatal_error("AddVectoredExceptionHandler failed", 0);
handler_added = 1;
}
c_to_factor(quot,this);
if(!AddVectoredExceptionHandler(0, (PVECTORED_EXCEPTION_HANDLER)factor::exception_handler))
fatal_error("AddVectoredExceptionHandler failed", 0);
c_to_factor(quot);
RemoveVectoredExceptionHandler((void *)factor::exception_handler);
}

2
vm/primitives.cpp
View File

@ -62,7 +62,6 @@ PRIMITIVE_FORWARD(retainstack)
PRIMITIVE_FORWARD(callstack)
PRIMITIVE_FORWARD(set_datastack)
PRIMITIVE_FORWARD(set_retainstack)
PRIMITIVE_FORWARD(set_callstack)
PRIMITIVE_FORWARD(exit)
PRIMITIVE_FORWARD(data_room)
PRIMITIVE_FORWARD(code_room)
@ -196,7 +195,6 @@ const primitive_type primitives[] = {
primitive_callstack,
primitive_set_datastack,
primitive_set_retainstack,
primitive_set_callstack,
primitive_exit,
primitive_data_room,
primitive_code_room,

39
vm/quotations.cpp
View File

@ -294,10 +294,11 @@ void factor_vm::jit_compile_quot(cell quot_, bool relocating)
{
data_root<quotation> quot(quot_,this);
if(quot->code) return;
code_block *compiled = jit_compile_quot(quot.value(),quot.value(),relocating);
set_quot_xt(quot.untagged(),compiled);
if(quot->code == NULL || quot->code == lazy_jit_compile_block())
{
code_block *compiled = jit_compile_quot(quot.value(),quot.value(),relocating);
set_quot_xt(quot.untagged(),compiled);
}
}
void factor_vm::primitive_jit_compile()
@ -305,15 +306,21 @@ void factor_vm::primitive_jit_compile()
jit_compile_quot(ctx->pop(),true);
}
code_block *factor_vm::lazy_jit_compile_block()
{
return untag<word>(special_objects[LAZY_JIT_COMPILE_WORD])->code;
}
/* push a new quotation on the stack */
void factor_vm::primitive_array_to_quotation()
{
quotation *quot = allot<quotation>(sizeof(quotation));
quot->array = ctx->peek();
quot->cached_effect = false_object;
quot->cache_counter = false_object;
quot->xt = (void *)lazy_jit_compile_impl;
quot->code = NULL;
set_quot_xt(quot,lazy_jit_compile_block());
ctx->replace(tag<quotation>(quot));
}
@ -353,7 +360,25 @@ void factor_vm::primitive_quot_compiled_p()
{
tagged<quotation> quot(ctx->pop());
quot.untag_check(this);
ctx->push(tag_boolean(quot->code != NULL));
ctx->push(tag_boolean(quot->code != lazy_jit_compile_block()));
}
cell factor_vm::find_all_quotations()
{
return instances(QUOTATION_TYPE);
}
void factor_vm::initialize_all_quotations()
{
data_root<array> quotations(find_all_quotations(),this);
cell length = array_capacity(quotations.untagged());
for(cell i = 0; i < length; i++)
{
data_root<quotation> quot(array_nth(quotations.untagged(),i),this);
if(!quot->code)
set_quot_xt(quot.untagged(),lazy_jit_compile_block());
}
}
}

1
vm/vm.cpp
View File

@ -5,6 +5,7 @@ namespace factor
factor_vm::factor_vm() :
nursery(0,0),
c_to_factor_func(NULL),
profiling_p(false),
gc_off(false),
current_gc(NULL),

13
vm/vm.hpp
View File

@ -30,6 +30,9 @@ struct factor_vm
/* Canonical truth value. In Factor, 't' */
cell true_object;
/* External entry points */
c_to_factor_func_type c_to_factor_func;
/* Is call counting enabled? */
bool profiling_p;
@ -562,7 +565,6 @@ struct factor_vm
stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom);
stack_frame *second_from_top_stack_frame();
void primitive_callstack();
void primitive_set_callstack();
code_block *frame_code(stack_frame *frame);
code_block_type frame_type(stack_frame *frame);
cell frame_executing(stack_frame *frame);
@ -596,6 +598,7 @@ struct factor_vm
//quotations
void primitive_jit_compile();
code_block *lazy_jit_compile_block();
void primitive_array_to_quotation();
void primitive_quotation_xt();
void set_quot_xt(quotation *quot, code_block *code);
@ -604,6 +607,8 @@ struct factor_vm
fixnum quot_code_offset_to_scan(cell quot_, cell offset);
cell lazy_jit_compile(cell quot);
void primitive_quot_compiled_p();
cell find_all_quotations();
void initialize_all_quotations();
//dispatch
cell search_lookup_alist(cell table, cell klass);
@ -632,9 +637,13 @@ struct factor_vm
void update_pic_transitions(cell pic_size);
void *inline_cache_miss(cell return_address);
//entry points
void c_to_factor(cell quot);
void unwind_native_frames(cell quot, stack_frame *to);
//factor
void default_parameters(vm_parameters *p);
bool factor_arg(const vm_char* str, const vm_char* arg, cell* value);
bool factor_arg(const vm_char *str, const vm_char *arg, cell *value);
void init_parameters_from_args(vm_parameters *p, int argc, vm_char **argv);
void do_stage1_init();
void init_factor(vm_parameters *p);