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

Starting work on Win64 port

db4
unknown 2008-11-07 20:33:32 -06:00
parent e45df2e89c
commit 7365959f01
23 changed files with 175 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -170,7 +170,7 @@ vm/resources.o:
$(CC) -c $(CFLAGS) -o $@ $<
.S.o:
$(CC) -c $(CFLAGS) -o $@ $<
$(CC) -x assembler-with-cpp -c $(CFLAGS) -o $@ $<
.m.o:
$(CC) -c $(CFLAGS) -o $@ $<

2
basis/alien/c-types/c-types.factor
View File

@ -435,7 +435,7 @@ M: long-long-type box-return ( type -- )
[ >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

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

@ -25,7 +25,7 @@ IN: bootstrap.image
: images ( -- seq )
{
"x86.32"
"x86.64"
"winnt-x86.64" "unix-x86.64"
"linux-ppc" "macosx-ppc"
} ;

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

@ -26,6 +26,8 @@ M: x86.32 stack-reg ESP ;
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 ;

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

@ -6,6 +6,7 @@ IN: bootstrap.x86
4 \ cell set
: stack-frame-size ( -- n ) 4 bootstrap-cells ;
: shift-arg ( -- reg ) ECX ;
: div-arg ( -- reg ) EAX ;
: mod-arg ( -- reg ) EDX ;

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

@ -24,14 +24,12 @@ M: x86.64 stack-reg RSP ;
M: x86.64 temp-reg-1 RAX ;
M: x86.64 temp-reg-2 RCX ;
: 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: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ;
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 -- )
@ -90,7 +88,7 @@ M: struct-type flatten-value-type ( type -- seq )
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 -- )
@ -103,27 +101,27 @@ M: x86.64 %unbox-long-long ( n 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
@ -160,8 +158,8 @@ M: x86.64 %box-small-struct ( c-type -- )
[
[ 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 ;
@ -170,9 +168,9 @@ M: x86.64 %box-small-struct ( c-type -- )
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 ;
@ -200,7 +198,7 @@ M: x86.64 %alien-indirect ( -- )
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 -- )
@ -208,11 +206,11 @@ 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 ;
@ -223,3 +221,10 @@ enable-alien-4-intrinsics
! 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

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

@ -9,8 +9,6 @@ IN: bootstrap.x86
: 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 ;

12
basis/cpu/x86/64/unix/bootstrap.factor Normal file
View File

@ -0,0 +1,12 @@
! 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

12
basis/cpu/x86/64/unix/unix.factor Normal file
View File

@ -0,0 +1,12 @@
! 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 ;

12
basis/cpu/x86/64/winnt/bootstrap.factor Normal file
View File

@ -0,0 +1,12 @@
! 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

17
basis/cpu/x86/64/winnt/winnt.factor Normal file
View File

@ -0,0 +1,17 @@
! 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
>>

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

@ -10,8 +10,6 @@ big-endian off
1 jit-code-format set
: stack-frame-size ( -- n ) 4 bootstrap-cells ;
[
! Load word
temp-reg 0 MOV
@ -30,7 +28,7 @@ big-endian off
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
[
@ -302,14 +300,14 @@ big-endian off
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

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

@ -39,12 +39,15 @@ M: x86 %inc-r ( n -- ) rs-reg (%inc) ;
: 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 ;
@ -465,7 +468,7 @@ M: x86 %compare-float-branch ( label cc src1 src2 -- )
: 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
@ -473,10 +476,9 @@ M: x86 %compare-float-branch ( label cc src1 src2 -- )
+ 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 *

2
vm/Config.windows.nt.x86.64
View File

@ -1,5 +1,5 @@
#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

2
vm/callstack.c
View File

@ -116,6 +116,8 @@ CELL frame_executing(F_STACK_FRAME *frame)
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);
}

1
vm/cpu-x86.32.S
View File

@ -11,6 +11,7 @@ and the callstack top is passed in EDX */
#define RETURN_REG %eax
#define CELL_SIZE 4
#define STACK_PADDING 12
#define PUSH_NONVOLATILE \
push %ebx ; \

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

@ -1,24 +1,55 @@
#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
@ -26,9 +57,9 @@
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"

27
vm/cpu-x86.S
View File

@ -1,31 +1,34 @@
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

6
vm/data_gc.c
View File

@ -438,6 +438,8 @@ void collect_gen_cards(CELL gen)
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);
@ -465,7 +467,10 @@ void collect_callstack(F_CONTEXT *stacks)
{
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");
}
}
@ -481,6 +486,7 @@ void collect_gc_locals(void)
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);

6
vm/errors.c
View File

@ -129,17 +129,17 @@ void divide_by_zero_error(F_STACK_FRAME *native_stack)
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)

1
vm/factor.c
View File

@ -167,7 +167,6 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded
}
init_factor(&p);
nest_stacks();
F_ARRAY *args = allot_array(ARRAY_TYPE,argc,F);

4
vm/factor.rs
View File

@ -1,2 +1,2 @@
fraptor ICON "misc/icons/Factor.ico"
fraptor ICON "misc/icons/Factor.ico"

4
vm/math.c
View File

@ -363,13 +363,13 @@ CELL unbox_array_size(void)
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;
}