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 \
: 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 ]
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
\ 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 ( -- )
: 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
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 -- )
[ jit-load-return-address jit-inline-cache-miss ]\r
[ 3 MTLR BLRL ]\r
[ 3 MTCTR BCTR ]\r
-\ inline-cache-miss define-sub-primitive*\r
+\ inline-cache-miss define-combinator-primitive\r
\r
[ jit-inline-cache-miss ]\r
[ 3 MTLR BLRL ]\r
[ 3 MTCTR BCTR ]\r
-\ inline-cache-miss-tail define-sub-primitive*\r
+\ inline-cache-miss-tail define-combinator-primitive\r
\r
! ! ! Megamorphic caches\r
\r
5 3 quot-xt-offset LWZ\r
]\r
[ 5 MTLR BLRL ]\r
-[ 5 MTCTR BCTR ] \ (call) define-sub-primitive*\r
+[ 5 MTCTR BCTR ] \ (call) define-combinator-primitive\r
\r
[\r
3 ds-reg 0 LWZ\r
4 3 word-xt-offset LWZ\r
]\r
[ 4 MTLR BLRL ]\r
-[ 4 MTCTR BCTR ] \ (execute) define-sub-primitive*\r
+[ 4 MTCTR BCTR ] \ (execute) define-combinator-primitive\r
\r
[\r
3 ds-reg 0 LWZ\r
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
]
[ 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 ( -- )
[ 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 -- )
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
-! 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
: 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 ;
[
! 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 ( -- )
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 ;
[ 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 -- )
ds-reg [] arg3 MOV
[ JNO ]
[
- arg3 RBP MOV
+ arg3 vm-reg MOV
RAX 0 MOV f rc-absolute-cell jit-dlsym
RAX CALL
]
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
]
: 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
]
[ temp0 word-xt-offset [+] CALL ]
[ temp0 word-xt-offset [+] JMP ]
-\ (execute) define-sub-primitive*
+\ (execute) define-combinator-primitive
[
temp0 ds-reg [] MOV
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
#! 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 ;
: remove-breakpoints ( quot pos -- quot' )
over quotation? [
- 1 + cut [ (remove-breakpoints) ] bi@
- [ -> ] glue
+ 1 + short cut [ (remove-breakpoints) ] bi@
+ [ -> ] glue
] [
drop
] if ;
{ callstack-top void* }
{ callstack-bottom void* }
{ datastack cell }
-{ callstack cell }
+{ retainstack cell }
{ magic-frame void* }
{ datastack-region void* }
{ retainstack-region void* }
[ create dup 1quotation ] dip define-declared ;
{
- { "(execute)" "kernel.private" (( word -- )) }
- { "(call)" "kernel.private" (( quot -- )) }
- { "both-fixnums?" "math.private" (( x y -- ? )) }
- { "fixnum+fast" "math.private" (( x y -- z )) }
- { "fixnum-fast" "math.private" (( x y -- z )) }
- { "fixnum*fast" "math.private" (( x y -- z )) }
- { "fixnum-bitand" "math.private" (( x y -- z )) }
- { "fixnum-bitor" "math.private" (( x y -- z )) }
- { "fixnum-bitxor" "math.private" (( x y -- z )) }
- { "fixnum-bitnot" "math.private" (( x -- y )) }
- { "fixnum-mod" "math.private" (( x y -- z )) }
- { "fixnum-shift-fast" "math.private" (( x y -- z )) }
- { "fixnum/i-fast" "math.private" (( x y -- z )) }
- { "fixnum/mod-fast" "math.private" (( x y -- z w )) }
- { "fixnum+" "math.private" (( x y -- z )) }
- { "fixnum-" "math.private" (( x y -- z )) }
- { "fixnum*" "math.private" (( x y -- z )) }
- { "fixnum<" "math.private" (( x y -- ? )) }
- { "fixnum<=" "math.private" (( x y -- z )) }
- { "fixnum>" "math.private" (( x y -- ? )) }
- { "fixnum>=" "math.private" (( x y -- ? )) }
+ { "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 -- )) }
{ "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 -- )) }
- { "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 -- )) }
+ { "both-fixnums?" "math.private" (( x y -- ? )) }
+ { "fixnum+fast" "math.private" (( x y -- z )) }
+ { "fixnum-fast" "math.private" (( x y -- z )) }
+ { "fixnum*fast" "math.private" (( x y -- z )) }
+ { "fixnum-bitand" "math.private" (( x y -- z )) }
+ { "fixnum-bitor" "math.private" (( x y -- z )) }
+ { "fixnum-bitxor" "math.private" (( x y -- z )) }
+ { "fixnum-bitnot" "math.private" (( x -- y )) }
+ { "fixnum-mod" "math.private" (( x y -- z )) }
+ { "fixnum-shift-fast" "math.private" (( x y -- z )) }
+ { "fixnum/i-fast" "math.private" (( x y -- z )) }
+ { "fixnum/mod-fast" "math.private" (( x y -- z w )) }
+ { "fixnum+" "math.private" (( x y -- z )) }
+ { "fixnum-" "math.private" (( x y -- z )) }
+ { "fixnum*" "math.private" (( x y -- z )) }
+ { "fixnum<" "math.private" (( x y -- ? )) }
+ { "fixnum<=" "math.private" (( x y -- z )) }
+ { "fixnum>" "math.private" (( x y -- ? )) }
+ { "fixnum>=" "math.private" (( x y -- ? )) }
} [ first3 make-sub-primitive ] each
! Primitive words
{ "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 )) }
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);
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:
#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
fnclex
fldcw 2(%rdi)
ret
+
+#define RETURN_REG %rax
#include "cpu-x86.S"
#ifdef WINDOWS
.section .drectve
.ascii " -export:sse_version"
- .ascii " -export:c_to_factor"
#endif
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));
-
}
--- /dev/null
+#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);
+}
+
+}
--- /dev/null
+namespace factor
+{
+
+typedef void (* c_to_factor_func_type)(cell quot);
+
+}
{
/* 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;
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. */
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 */
compile_all_words();
update_code_heap_words();
+ initialize_all_quotations();
special_objects[OBJ_STAGE2] = true_object;
std::cout << "done\n";
#include "alien.hpp"
#include "callbacks.hpp"
#include "dispatch.hpp"
+#include "entry_points.hpp"
#include "vm.hpp"
#include "allot.hpp"
#include "tagged.hpp"
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) */
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,
void factor_vm::c_to_factor_toplevel(cell quot)
{
- c_to_factor(quot,this);
+ c_to_factor(quot);
}
void init_signals()
for(;;)
{
NS_DURING
- c_to_factor(quot,this);
+ c_to_factor(quot);
NS_VOIDRETURN;
NS_HANDLER
ctx->push(allot_alien(false_object,(cell)localException));
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);
}
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)
primitive_callstack,
primitive_set_datastack,
primitive_set_retainstack,
- primitive_set_callstack,
primitive_exit,
primitive_data_room,
primitive_code_room,
{
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()
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));
}
{
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());
+ }
}
}
\r
factor_vm::factor_vm() :\r
nursery(0,0),\r
+ c_to_factor_func(NULL),\r
profiling_p(false),\r
gc_off(false),\r
current_gc(NULL),\r
/* 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;
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);
//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);
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);
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);
projects / factor.git / commitdiff