Merge branch 'master' of git://factorcode.org/git/factor
commit
000affca5a
2
Makefile
2
Makefile
|
@ -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 $@ $<
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -31,7 +31,7 @@ IN: bootstrap.image
|
|||
: images ( -- seq )
|
||||
{
|
||||
"x86.32"
|
||||
"x86.64"
|
||||
"winnt-x86.64" "unix-x86.64"
|
||||
"linux-ppc" "macosx-ppc"
|
||||
} ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
|
@ -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 ;
|
|
@ -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
|
|
@ -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
|
||||
>>
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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 *
|
||||
|
|
|
@ -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> = ;
|
||||
|
|
|
@ -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" }
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
27
vm/bignum.c
|
@ -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;
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
@ -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 ; \
|
||||
|
|
|
@ -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
27
vm/cpu-x86.S
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -1,2 +1,2 @@
|
|||
fraptor ICON "misc/icons/Factor.ico"
|
||||
|
||||
fraptor ICON "misc/icons/Factor.ico"
|
||||
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue