$(CC) -c $(CFLAGS) -o $@ $<
.S.o:
- $(CC) -c $(CFLAGS) -o $@ $<
+ $(CC) -x assembler-with-cpp -c $(CFLAGS) -o $@ $<
.m.o:
$(CC) -c $(CFLAGS) -o $@ $<
[ >float ] >>unboxer-quot
"double" define-primitive-type
- os winnt? cpu x86.64? and "longlong" "long" ? "ptrdiff_t" typedef
+ "long" "ptrdiff_t" typedef
"ulong" "size_t" typedef
] with-compilation-unit
: images ( -- seq )
{
"x86.32"
- "x86.64"
+ "winnt-x86.64" "unix-x86.64"
"linux-ppc" "macosx-ppc"
} ;
M: x86.32 temp-reg-1 EAX ;
M: x86.32 temp-reg-2 ECX ;
+M: x86.32 reserved-area-size 0 ;
+
M: x86.32 %alien-global 0 [] MOV rc-absolute-cell rel-dlsym ;
M: x86.32 %alien-invoke (CALL) rel-dlsym ;
4 \ cell set
+: stack-frame-size ( -- n ) 4 bootstrap-cells ;
: shift-arg ( -- reg ) ECX ;
: div-arg ( -- reg ) EAX ;
: mod-arg ( -- reg ) EDX ;
M: x86.64 temp-reg-1 RAX ;
M: x86.64 temp-reg-2 RCX ;
-M: int-regs return-reg drop RAX ;
-M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ;
+: param-reg-1 int-regs param-regs first ; inline
+: param-reg-2 int-regs param-regs second ; inline
+M: int-regs return-reg drop RAX ;
M: float-regs return-reg drop XMM0 ;
-M: float-regs param-regs
- drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
-
M: x86.64 rel-literal-x86 rc-relative rel-literal ;
M: x86.64 %prologue ( n -- )
M: x86.64 %prepare-unbox ( -- )
! First parameter is top of stack
- RDI R14 [] MOV
+ param-reg-1 R14 [] MOV
R14 cell SUB ;
M: x86.64 %unbox ( n reg-class func -- )
int-regs swap %unbox ;
: %unbox-struct-field ( c-type i -- )
- ! Alien must be in RDI.
- RDI swap cells [+] swap reg-class>> {
+ ! Alien must be in param-reg-1.
+ param-reg-1 swap cells [+] swap reg-class>> {
{ int-regs [ int-regs get pop swap MOV ] }
{ double-float-regs [ float-regs get pop swap MOVSD ] }
} case ;
M: x86.64 %unbox-small-struct ( c-type -- )
- ! Alien must be in RDI.
+ ! Alien must be in param-reg-1.
"alien_offset" f %alien-invoke
- ! Move alien_offset() return value to RDI so that we don't
+ ! Move alien_offset() return value to param-reg-1 so that we don't
! clobber it.
- RDI RAX MOV
+ param-reg-1 RAX MOV
[
flatten-small-struct [ %unbox-struct-field ] each-index
] with-return-regs ;
M: x86.64 %unbox-large-struct ( n c-type -- )
- ! Source is in RDI
+ ! Source is in param-reg-1
heap-size
! Load destination address
- RSI rot stack@ LEA
+ param-reg-2 rot stack@ LEA
! Load structure size
RDX swap MOV
! Copy the struct to the C stack
[
[ flatten-small-struct [ %box-struct-field ] each-index ]
[ RDX swap heap-size MOV ] bi
- RDI 0 box-struct-field@ MOV
- RSI 1 box-struct-field@ MOV
+ param-reg-1 0 box-struct-field@ MOV
+ param-reg-2 1 box-struct-field@ MOV
"box_small_struct" f %alien-invoke
] with-return-regs ;
M: x86.64 %box-large-struct ( n c-type -- )
! Struct size is parameter 2
- RSI swap heap-size MOV
+ param-reg-2 swap heap-size MOV
! Compute destination address
- RDI swap struct-return@ LEA
+ param-reg-1 swap struct-return@ LEA
! Copy the struct from the C stack
"box_value_struct" f %alien-invoke ;
RBP CALL ;
M: x86.64 %alien-callback ( quot -- )
- RDI swap %load-indirect
+ param-reg-1 swap %load-indirect
"c_to_factor" f %alien-invoke ;
M: x86.64 %callback-value ( ctype -- )
%prepare-unbox
! Save top of data stack
RSP 8 SUB
- RDI PUSH
+ param-reg-1 PUSH
! Restore data/call/retain stacks
"unnest_stacks" f %alien-invoke
- ! Put former top of data stack in RDI
- RDI POP
+ ! Put former top of data stack in param-reg-1
+ param-reg-1 POP
RSP 8 ADD
! Unbox former top of data stack to return registers
unbox-return ;
! SSE2 is always available on x86-64.
enable-float-intrinsics
+
+USE: vocabs.loader
+
+{
+ { [ os unix? ] [ "cpu.x86.64.unix" require ] }
+ { [ os winnt? ] [ "cpu.x86.64.winnt" require ] }
+} cond
: shift-arg ( -- reg ) RCX ;
: div-arg ( -- reg ) RAX ;
: mod-arg ( -- reg ) RDX ;
-: arg0 ( -- reg ) RDI ;
-: arg1 ( -- reg ) RSI ;
: temp-reg ( -- reg ) RBX ;
: stack-reg ( -- reg ) RSP ;
: ds-reg ( -- reg ) R14 ;
--- /dev/null
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: bootstrap.image.private kernel namespaces system
+cpu.x86.assembler layouts vocabs parser ;
+IN: bootstrap.x86
+
+: stack-frame-size ( -- n ) 4 bootstrap-cells ;
+: arg0 ( -- reg ) RDI ;
+: arg1 ( -- reg ) RSI ;
+
+<< "resource:basis/cpu/x86/64/bootstrap.factor" parsed-file parsed >>
+call
--- /dev/null
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel layouts system compiler.cfg.registers
+cpu.architecture cpu.x86.assembler ;
+IN: cpu.x86.64.unix
+
+M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ;
+
+M: float-regs param-regs
+ drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
+
+M: x86.64 reserved-area-size 0 ;
--- /dev/null
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: bootstrap.image.private kernel namespaces system
+cpu.x86.assembler layouts vocabs parser ;
+IN: bootstrap.x86
+
+: stack-frame-size ( -- n ) 8 bootstrap-cells ;
+: arg0 ( -- reg ) RCX ;
+: arg1 ( -- reg ) RDX ;
+
+<< "resource:basis/cpu/x86/64/bootstrap.factor" parse-file parsed >>
+call
--- /dev/null
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel layouts system alien.c-types compiler.cfg.registers
+cpu.architecture cpu.x86.assembler cpu.x86 ;
+IN: cpu.x86.64.winnt
+
+M: int-regs param-regs drop { RCX RDX R8 R9 } ;
+
+M: float-regs param-regs drop { XMM0 XMM1 XMM2 XMM3 } ;
+
+M: x86.64 reserved-area-size 4 cells ;
+
+<<
+"longlong" "ptrdiff_t" typedef
+"int" "long" typedef
+"uint" "ulong" typedef
+>>
1 jit-code-format set
-: stack-frame-size ( -- n ) 4 bootstrap-cells ;
-
[
! Load word
temp-reg 0 MOV
temp-reg 0 MOV ! load XT
stack-frame-size PUSH ! save stack frame size
temp-reg PUSH ! push XT
- arg1 PUSH ! alignment
+ stack-reg stack-frame-size 3 bootstrap-cells - SUB ! alignment
] rc-absolute-cell rt-label 1 rex-length + jit-prolog jit-define
[
shift-arg ds-reg [] MOV ! load shift count
shift-arg tag-bits get SAR ! untag shift count
ds-reg bootstrap-cell SUB ! adjust stack pointer
- arg0 ds-reg [] MOV ! load value
- arg1 arg0 MOV ! make a copy
+ temp-reg ds-reg [] MOV ! load value
+ arg1 temp-reg MOV ! make a copy
arg1 CL SHL ! compute positive shift value in arg1
shift-arg NEG ! compute negative shift value in arg0
- arg0 CL SAR
- arg0 tag-mask get bitnot AND
+ temp-reg CL SAR
+ temp-reg tag-mask get bitnot AND
shift-arg 0 CMP ! if shift count was negative, move arg0 to arg1
- arg1 arg0 CMOVGE
+ arg1 temp-reg CMOVGE
ds-reg [] arg1 MOV ! push to stack
] f f f \ fixnum-shift-fast define-sub-primitive
: align-stack ( n -- n' )
os macosx? cpu x86.64? or [ 16 align ] when ;
+HOOK: reserved-area-size cpu ( -- n )
+
M: x86 stack-frame-size ( stack-frame -- i )
[ spill-counts>> [ swap reg-size * ] { } assoc>map sum ]
[ params>> ]
[ return>> ]
tri + +
3 cells +
+ reserved-area-size +
align-stack ;
M: x86 %call ( label -- ) CALL ;
: stack@ ( n -- op ) stack-reg swap [+] ;
: spill-integer-base ( stack-frame -- n )
- [ params>> ] [ return>> ] bi + ;
+ [ params>> ] [ return>> ] bi + reserved-area-size + ;
: spill-integer@ ( n -- op )
cells
+ stack@ ;
: spill-float-base ( stack-frame -- n )
+ [ spill-integer-base ]
[ spill-counts>> int-regs swap at int-regs reg-size * ]
- [ params>> ]
- [ return>> ]
- tri + + ;
+ bi + ;
: spill-float@ ( n -- op )
double-float-regs reg-size *
#WIN64_PATH=/k/MinGW/win64/bin
-WIN64_PATH=/cygdrive/k/MinGW/win64/bin/x86_64-pc-mingw32
+#WIN64_PATH=/cygdrive/k/MinGW/win64/bin/x86_64-pc-mingw32
CC=$(WIN64_PATH)-gcc.exe
WINDRES=$(WIN64_PATH)-windres.exe
include vm/Config.windows.nt
F_STACK_FRAME *frame_successor(F_STACK_FRAME *frame)
{
+ if(frame->size == 0)
+ critical_error("Stack frame has zero size",frame);
return (F_STACK_FRAME *)((CELL)frame - frame->size);
}
#define RETURN_REG %eax
#define CELL_SIZE 4
+#define STACK_PADDING 12
#define PUSH_NONVOLATILE \
push %ebx ; \
#include "asm.h"
-#define ARG0 %rdi
-#define ARG1 %rsi
#define STACK_REG %rsp
#define DS_REG %r14
#define RETURN_REG %rax
#define CELL_SIZE 8
+#define STACK_PADDING 56
-#define PUSH_NONVOLATILE \
- push %rbx ; \
- push %rbp ; \
- push %r12 ; \
- push %r13 ;
+#ifdef WINDOWS
-#define POP_NONVOLATILE \
- pop %r13 ; \
- pop %r12 ; \
- pop %rbp ; \
- pop %rbx
+ #define ARG0 %rcx
+ #define ARG1 %rdx
+ #define ARG2 %r8
+ #define ARG3 %r9
+
+ #define PUSH_NONVOLATILE \
+ 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
+
+#else
+
+ #define ARG0 %rdi
+ #define ARG1 %rsi
+ #define ARG2 %rdx
+ #define ARG3 %rcx
+
+ #define PUSH_NONVOLATILE \
+ push %rbx ; \
+ push %rbp ; \
+ push %r12 ; \
+ push %r13
+
+ #define POP_NONVOLATILE \
+ pop %r13 ; \
+ pop %r12 ; \
+ pop %rbp ; \
+ pop %rbx
+
+#endif
#define QUOT_XT_OFFSET 21
ABI limitation which would otherwise require us to do a bizzaro PC-relative
trampoline to retrieve the function address */
DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy)):
- sub %rdx,%rdi /* compute new stack pointer */
- mov %rdi,%rsp
- call *%rcx /* call memcpy */
+ sub ARG2,ARG0 /* compute new stack pointer */
+ mov ARG0,%rsp
+ call *ARG3 /* call memcpy */
ret /* return _with new stack_ */
#include "cpu-x86.S"
DEF(F_FASTCALL void,c_to_factor,(CELL quot)):
PUSH_NONVOLATILE
- push ARG0 /* Save quot */
+ push ARG0
- lea -CELL_SIZE(STACK_REG),ARG0 /* Save stack pointer */
+ /* Save stack pointer */
+ lea -CELL_SIZE(STACK_REG),ARG0
+
+ /* Create register shadow area for Win64 */
+ sub $32,STACK_REG
call MANGLE(save_callstack_bottom)
+ add $32,STACK_REG
- mov (STACK_REG),ARG0 /* Pass quot as arg 1 */
- call *QUOT_XT_OFFSET(ARG0) /* Call quot-xt */
+ /* Call quot-xt */
+ mov (STACK_REG),ARG0
+ call *QUOT_XT_OFFSET(ARG0)
- POP ARG0
+ pop ARG0
POP_NONVOLATILE
ret
DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
- mov ARG1,STACK_REG /* rewind_to */
+ /* rewind_to */
+ mov ARG1,STACK_REG
jmp *QUOT_XT_OFFSET(ARG0)
DEF(FASTCALL void,lazy_jit_compile,(CELL quot)):
mov STACK_REG,ARG1 /* Save stack pointer */
- push ARG1 /* Alignment */
- push ARG1
- push ARG1
+ sub $STACK_PADDING,STACK_REG
call MANGLE(primitive_jit_compile)
mov RETURN_REG,ARG0 /* No-op on 32-bit */
- pop ARG1 /* OK to clobber ARG1 here */
- pop ARG1
- pop ARG1
+ add $STACK_PADDING,STACK_REG
jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
#ifdef WINDOWS
old->new references */
void collect_cards(void)
{
+ GC_PRINT("Collect cards\n");
+
int i;
for(i = collecting_gen + 1; i < data_heap->gen_count; i++)
collect_gen_cards(i);
{
CELL top = (CELL)stacks->callstack_top;
CELL bottom = (CELL)stacks->callstack_bottom;
+
+ GC_PRINT("Collect callstack %ld %ld\n",top,bottom);
iterate_callstack(top,bottom,collect_stack_frame);
+ GC_PRINT("Done\n");
}
}
the user environment and extra roots registered with REGISTER_ROOT */
void collect_roots(void)
{
+ GC_PRINT("Collect roots\n");
copy_handle(&T);
copy_handle(&bignum_zero);
copy_handle(&bignum_pos_one);
void memory_signal_handler_impl(void)
{
- memory_protection_error(signal_fault_addr,signal_callstack_top);
+ memory_protection_error(signal_fault_addr,signal_callstack_top);
}
void divide_by_zero_signal_handler_impl(void)
{
- divide_by_zero_error(signal_callstack_top);
+ divide_by_zero_error(signal_callstack_top);
}
void misc_signal_handler_impl(void)
{
- signal_error(signal_number,signal_callstack_top);
+ signal_error(signal_number,signal_callstack_top);
}
DEFINE_PRIMITIVE(throw)
}
init_factor(&p);
-
nest_stacks();
F_ARRAY *args = allot_array(ARRAY_TYPE,argc,F);
-fraptor ICON "misc/icons/Factor.ico"\r
-\r
+fraptor ICON "misc/icons/Factor.ico"
+
case BIGNUM_TYPE:
{
bignum_type zero = untag_object(bignum_zero);
- bignum_type max = ulong_to_bignum(ARRAY_SIZE_MAX);
+ bignum_type max = cell_to_bignum(ARRAY_SIZE_MAX);
bignum_type n = untag_object(dpeek());
if(bignum_compare(n,zero) != bignum_comparison_less
&& bignum_compare(n,max) == bignum_comparison_less)
{
dpop();
- return bignum_to_ulong(n);
+ return bignum_to_cell(n);
}
break;
}
projects / factor.git / commitdiff