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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2008-11-07 21:09:45 -06:00
parent 1b744ab14b de0cc7f99a
commit 000affca5a
28 changed files with 213 additions and 98 deletions

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

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

19
basis/math/functions/functions-tests.factor
View File

@ -76,6 +76,25 @@ IN: math.functions.tests
gcd nip
] unit-test
[ 11 ] [
13262642990609552931815424
159151715887314635181785
gcd nip
] unit-test
[ 3 ] [
13262642990609552931
1591517158873146351
gcd nip
] unit-test
[ 26525285981219 ] [
132626429906095
159151715887314
gcd nip
] unit-test
: verify-gcd ( a b -- ? )
2dup gcd
>r rot * swap rem r> = ;

3
core/bootstrap/primitives.factor
View File

@ -20,7 +20,8 @@ H{ } clone sub-primitives set
"resource:basis/cpu/" architecture get {
{ "x86.32" "x86/32" }
{ "x86.64" "x86/64" }
{ "winnt-x86.64" "x86/64/winnt" }
{ "unix-x86.64" "x86/64/unix" }
{ "linux-ppc" "ppc/linux" }
{ "macosx-ppc" "ppc/macosx" }
{ "arm" "arm" }

5
core/math/integers/integers-tests.factor
View File

@ -101,8 +101,13 @@ unit-test
[ 268435456 ] [ -268435456 >fixnum -1 /i ] unit-test
[ 268435456 0 ] [ -268435456 >fixnum -1 /mod ] unit-test
[ 0 ] [ -1 -268435456 >fixnum /i ] unit-test
[ 4420880996869850977 ] [ 13262642990609552931 3 /i ] unit-test
[ 0 -1 ] [ -1 -268435456 >fixnum /mod ] unit-test
[ 0 -1 ] [ -1 -268435456 >bignum /mod ] unit-test
[ 14355 ] [ 1591517158873146351817850880000000 32769 mod ] unit-test
[ 8 530505719624382123 ] [ 13262642990609552931 1591517158873146351 /mod ] unit-test
[ 8 ] [ 13262642990609552931 1591517158873146351 /i ] unit-test
[ 530505719624382123 ] [ 13262642990609552931 1591517158873146351 mod ] unit-test
[ -351382792 ] [ -43922849 3 shift ] unit-test

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

27
vm/bignum.c
View File

@ -1,7 +1,7 @@
/* :tabSize=2:indentSize=2:noTabs=true:
Copyright (C) 1989-94 Massachusetts Institute of Technology
Portions copyright (C) 2004-2007 Slava Pestov
Portions copyright (C) 2004-2008 Slava Pestov
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
@ -45,6 +45,7 @@ MIT in each case. */
* - Remove unused functions
* - Add local variable GC root recording
* - Remove s48 prefix from function names
* - Various fixes for Win64
*/
#include "master.h"
@ -366,8 +367,6 @@ bignum_remainder(bignum_type numerator, bignum_type denominator)
/* all below allocate memory */
FOO_TO_BIGNUM(cell,CELL,CELL)
FOO_TO_BIGNUM(fixnum,F_FIXNUM,CELL)
FOO_TO_BIGNUM(long,long,unsigned long)
FOO_TO_BIGNUM(ulong,unsigned long,unsigned long)
FOO_TO_BIGNUM(long_long,s64,u64)
FOO_TO_BIGNUM(ulong_long,u64,u64)
@ -389,8 +388,6 @@ FOO_TO_BIGNUM(ulong_long,u64,u64)
/* all of the below allocate memory */
BIGNUM_TO_FOO(cell,CELL,CELL);
BIGNUM_TO_FOO(fixnum,F_FIXNUM,CELL);
BIGNUM_TO_FOO(long,long,unsigned long)
BIGNUM_TO_FOO(ulong,unsigned long,unsigned long)
BIGNUM_TO_FOO(long_long,s64,u64)
BIGNUM_TO_FOO(ulong_long,u64,u64)
@ -435,7 +432,7 @@ double_to_bignum(double x)
bignum_digit_type digit;
int odd_bits = (exponent % BIGNUM_DIGIT_LENGTH);
if (odd_bits > 0)
DTB_WRITE_DIGIT (1L << odd_bits);
DTB_WRITE_DIGIT ((F_FIXNUM)1 << odd_bits);
while (start < scan)
{
if (significand == 0)
@ -1117,7 +1114,7 @@ bignum_destructive_normalization(bignum_type source, bignum_type target,
bignum_digit_type * end_source = (scan_source + (BIGNUM_LENGTH (source)));
bignum_digit_type * end_target = (scan_target + (BIGNUM_LENGTH (target)));
int shift_right = (BIGNUM_DIGIT_LENGTH - shift_left);
bignum_digit_type mask = ((1L << shift_right) - 1);
bignum_digit_type mask = (((CELL)1 << shift_right) - 1);
while (scan_source < end_source)
{
digit = (*scan_source++);
@ -1139,7 +1136,7 @@ bignum_destructive_unnormalization(bignum_type bignum, int shift_right)
bignum_digit_type digit;
bignum_digit_type carry = 0;
int shift_left = (BIGNUM_DIGIT_LENGTH - shift_right);
bignum_digit_type mask = ((1L << shift_right) - 1);
bignum_digit_type mask = (((F_FIXNUM)1 << shift_right) - 1);
while (start < scan)
{
digit = (*--scan);
@ -1489,7 +1486,7 @@ bignum_bitwise_not(bignum_type x)
/* allocates memory */
bignum_type
bignum_arithmetic_shift(bignum_type arg1, long n)
bignum_arithmetic_shift(bignum_type arg1, F_FIXNUM n)
{
if (BIGNUM_NEGATIVE_P(arg1) && n < 0)
return bignum_bitwise_not(bignum_magnitude_ash(bignum_bitwise_not(arg1), n));
@ -1550,14 +1547,14 @@ bignum_bitwise_xor(bignum_type arg1, bignum_type arg2)
/* ash for the magnitude */
/* assume arg1 is a big number, n is a long */
bignum_type
bignum_magnitude_ash(bignum_type arg1, long n)
bignum_magnitude_ash(bignum_type arg1, F_FIXNUM n)
{
bignum_type result = NULL;
bignum_digit_type *scan1;
bignum_digit_type *scanr;
bignum_digit_type *end;
long digit_offset,bit_offset;
F_FIXNUM digit_offset,bit_offset;
if (BIGNUM_ZERO_P (arg1)) return (arg1);
@ -1642,10 +1639,6 @@ bignum_pospos_bitwise_op(int op, bignum_type arg1, bignum_type arg2)
while (scanr < endr) {
digit1 = (scan1 < end1) ? *scan1++ : 0;
digit2 = (scan2 < end2) ? *scan2++ : 0;
/*
fprintf(stderr, "[pospos op = %d, i = %ld, d1 = %lx, d2 = %lx]\n",
op, endr - scanr, digit1, digit2);
*/
*scanr++ = (op == AND_OP) ? digit1 & digit2 :
(op == IOR_OP) ? digit1 | digit2 :
digit1 ^ digit2;
@ -1856,8 +1849,8 @@ digit_stream_to_bignum(unsigned int n_digits,
return (BIGNUM_ZERO ());
if (n_digits == 1)
{
long digit = ((long) ((*producer) (0)));
return (long_to_bignum (negative_p ? (- digit) : digit));
F_FIXNUM digit = ((F_FIXNUM) ((*producer) (0)));
return (fixnum_to_bignum (negative_p ? (- digit) : digit));
}
{
bignum_length_type length;

8
vm/bignum.h
View File

@ -55,14 +55,10 @@ bignum_type bignum_quotient(bignum_type, bignum_type);
bignum_type bignum_remainder(bignum_type, bignum_type);
DLLEXPORT bignum_type fixnum_to_bignum(F_FIXNUM);
DLLEXPORT bignum_type cell_to_bignum(CELL);
DLLEXPORT bignum_type long_to_bignum(long);
DLLEXPORT bignum_type long_long_to_bignum(s64 n);
DLLEXPORT bignum_type ulong_long_to_bignum(u64 n);
DLLEXPORT bignum_type ulong_to_bignum(unsigned long);
F_FIXNUM bignum_to_fixnum(bignum_type);
CELL bignum_to_cell(bignum_type);
long bignum_to_long(bignum_type);
unsigned long bignum_to_ulong(bignum_type);
s64 bignum_to_long_long(bignum_type);
u64 bignum_to_ulong_long(bignum_type);
bignum_type double_to_bignum(double);
@ -71,7 +67,7 @@ double bignum_to_double(bignum_type);
/* Added bitwise operators. */
DLLEXPORT bignum_type bignum_bitwise_not(bignum_type),
bignum_arithmetic_shift(bignum_type, long),
bignum_arithmetic_shift(bignum_type, F_FIXNUM),
bignum_bitwise_and(bignum_type, bignum_type),
bignum_bitwise_ior(bignum_type, bignum_type),
bignum_bitwise_xor(bignum_type, bignum_type);
@ -116,7 +112,7 @@ bignum_type bignum_maybe_new_sign(bignum_type, int);
void bignum_destructive_copy(bignum_type, bignum_type);
/* Added for bitwise operations. */
bignum_type bignum_magnitude_ash(bignum_type arg1, long n);
bignum_type bignum_magnitude_ash(bignum_type arg1, F_FIXNUM n);
bignum_type bignum_pospos_bitwise_op(int op, bignum_type, bignum_type);
bignum_type bignum_posneg_bitwise_op(int op, bignum_type, bignum_type);
bignum_type bignum_negneg_bitwise_op(int op, bignum_type, bignum_type);

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