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 $@ $<
|
$(CC) -c $(CFLAGS) -o $@ $<
|
||||||
|
|
||||||
.S.o:
|
.S.o:
|
||||||
$(CC) -c $(CFLAGS) -o $@ $<
|
$(CC) -x assembler-with-cpp -c $(CFLAGS) -o $@ $<
|
||||||
|
|
||||||
.m.o:
|
.m.o:
|
||||||
$(CC) -c $(CFLAGS) -o $@ $<
|
$(CC) -c $(CFLAGS) -o $@ $<
|
||||||
|
|
|
@ -435,7 +435,7 @@ M: long-long-type box-return ( type -- )
|
||||||
[ >float ] >>unboxer-quot
|
[ >float ] >>unboxer-quot
|
||||||
"double" define-primitive-type
|
"double" define-primitive-type
|
||||||
|
|
||||||
os winnt? cpu x86.64? and "longlong" "long" ? "ptrdiff_t" typedef
|
"long" "ptrdiff_t" typedef
|
||||||
|
|
||||||
"ulong" "size_t" typedef
|
"ulong" "size_t" typedef
|
||||||
] with-compilation-unit
|
] with-compilation-unit
|
||||||
|
|
|
@ -31,7 +31,7 @@ IN: bootstrap.image
|
||||||
: images ( -- seq )
|
: images ( -- seq )
|
||||||
{
|
{
|
||||||
"x86.32"
|
"x86.32"
|
||||||
"x86.64"
|
"winnt-x86.64" "unix-x86.64"
|
||||||
"linux-ppc" "macosx-ppc"
|
"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-1 EAX ;
|
||||||
M: x86.32 temp-reg-2 ECX ;
|
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-global 0 [] MOV rc-absolute-cell rel-dlsym ;
|
||||||
|
|
||||||
M: x86.32 %alien-invoke (CALL) rel-dlsym ;
|
M: x86.32 %alien-invoke (CALL) rel-dlsym ;
|
||||||
|
|
|
@ -6,6 +6,7 @@ IN: bootstrap.x86
|
||||||
|
|
||||||
4 \ cell set
|
4 \ cell set
|
||||||
|
|
||||||
|
: stack-frame-size ( -- n ) 4 bootstrap-cells ;
|
||||||
: shift-arg ( -- reg ) ECX ;
|
: shift-arg ( -- reg ) ECX ;
|
||||||
: div-arg ( -- reg ) EAX ;
|
: div-arg ( -- reg ) EAX ;
|
||||||
: mod-arg ( -- reg ) EDX ;
|
: 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-1 RAX ;
|
||||||
M: x86.64 temp-reg-2 RCX ;
|
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 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 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 rel-literal-x86 rc-relative rel-literal ;
|
||||||
|
|
||||||
M: x86.64 %prologue ( n -- )
|
M: x86.64 %prologue ( n -- )
|
||||||
|
@ -90,7 +88,7 @@ M: struct-type flatten-value-type ( type -- seq )
|
||||||
|
|
||||||
M: x86.64 %prepare-unbox ( -- )
|
M: x86.64 %prepare-unbox ( -- )
|
||||||
! First parameter is top of stack
|
! First parameter is top of stack
|
||||||
RDI R14 [] MOV
|
param-reg-1 R14 [] MOV
|
||||||
R14 cell SUB ;
|
R14 cell SUB ;
|
||||||
|
|
||||||
M: x86.64 %unbox ( n reg-class func -- )
|
M: x86.64 %unbox ( n reg-class func -- )
|
||||||
|
@ -103,27 +101,27 @@ M: x86.64 %unbox-long-long ( n func -- )
|
||||||
int-regs swap %unbox ;
|
int-regs swap %unbox ;
|
||||||
|
|
||||||
: %unbox-struct-field ( c-type i -- )
|
: %unbox-struct-field ( c-type i -- )
|
||||||
! Alien must be in RDI.
|
! Alien must be in param-reg-1.
|
||||||
RDI swap cells [+] swap reg-class>> {
|
param-reg-1 swap cells [+] swap reg-class>> {
|
||||||
{ int-regs [ int-regs get pop swap MOV ] }
|
{ int-regs [ int-regs get pop swap MOV ] }
|
||||||
{ double-float-regs [ float-regs get pop swap MOVSD ] }
|
{ double-float-regs [ float-regs get pop swap MOVSD ] }
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
M: x86.64 %unbox-small-struct ( c-type -- )
|
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
|
"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.
|
! clobber it.
|
||||||
RDI RAX MOV
|
param-reg-1 RAX MOV
|
||||||
[
|
[
|
||||||
flatten-small-struct [ %unbox-struct-field ] each-index
|
flatten-small-struct [ %unbox-struct-field ] each-index
|
||||||
] with-return-regs ;
|
] with-return-regs ;
|
||||||
|
|
||||||
M: x86.64 %unbox-large-struct ( n c-type -- )
|
M: x86.64 %unbox-large-struct ( n c-type -- )
|
||||||
! Source is in RDI
|
! Source is in param-reg-1
|
||||||
heap-size
|
heap-size
|
||||||
! Load destination address
|
! Load destination address
|
||||||
RSI rot stack@ LEA
|
param-reg-2 rot stack@ LEA
|
||||||
! Load structure size
|
! Load structure size
|
||||||
RDX swap MOV
|
RDX swap MOV
|
||||||
! Copy the struct to the C stack
|
! 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 ]
|
[ flatten-small-struct [ %box-struct-field ] each-index ]
|
||||||
[ RDX swap heap-size MOV ] bi
|
[ RDX swap heap-size MOV ] bi
|
||||||
RDI 0 box-struct-field@ MOV
|
param-reg-1 0 box-struct-field@ MOV
|
||||||
RSI 1 box-struct-field@ MOV
|
param-reg-2 1 box-struct-field@ MOV
|
||||||
"box_small_struct" f %alien-invoke
|
"box_small_struct" f %alien-invoke
|
||||||
] with-return-regs ;
|
] with-return-regs ;
|
||||||
|
|
||||||
|
@ -170,9 +168,9 @@ M: x86.64 %box-small-struct ( c-type -- )
|
||||||
|
|
||||||
M: x86.64 %box-large-struct ( n c-type -- )
|
M: x86.64 %box-large-struct ( n c-type -- )
|
||||||
! Struct size is parameter 2
|
! Struct size is parameter 2
|
||||||
RSI swap heap-size MOV
|
param-reg-2 swap heap-size MOV
|
||||||
! Compute destination address
|
! Compute destination address
|
||||||
RDI swap struct-return@ LEA
|
param-reg-1 swap struct-return@ LEA
|
||||||
! Copy the struct from the C stack
|
! Copy the struct from the C stack
|
||||||
"box_value_struct" f %alien-invoke ;
|
"box_value_struct" f %alien-invoke ;
|
||||||
|
|
||||||
|
@ -200,7 +198,7 @@ M: x86.64 %alien-indirect ( -- )
|
||||||
RBP CALL ;
|
RBP CALL ;
|
||||||
|
|
||||||
M: x86.64 %alien-callback ( quot -- )
|
M: x86.64 %alien-callback ( quot -- )
|
||||||
RDI swap %load-indirect
|
param-reg-1 swap %load-indirect
|
||||||
"c_to_factor" f %alien-invoke ;
|
"c_to_factor" f %alien-invoke ;
|
||||||
|
|
||||||
M: x86.64 %callback-value ( ctype -- )
|
M: x86.64 %callback-value ( ctype -- )
|
||||||
|
@ -208,11 +206,11 @@ M: x86.64 %callback-value ( ctype -- )
|
||||||
%prepare-unbox
|
%prepare-unbox
|
||||||
! Save top of data stack
|
! Save top of data stack
|
||||||
RSP 8 SUB
|
RSP 8 SUB
|
||||||
RDI PUSH
|
param-reg-1 PUSH
|
||||||
! Restore data/call/retain stacks
|
! Restore data/call/retain stacks
|
||||||
"unnest_stacks" f %alien-invoke
|
"unnest_stacks" f %alien-invoke
|
||||||
! Put former top of data stack in RDI
|
! Put former top of data stack in param-reg-1
|
||||||
RDI POP
|
param-reg-1 POP
|
||||||
RSP 8 ADD
|
RSP 8 ADD
|
||||||
! Unbox former top of data stack to return registers
|
! Unbox former top of data stack to return registers
|
||||||
unbox-return ;
|
unbox-return ;
|
||||||
|
@ -223,3 +221,10 @@ enable-alien-4-intrinsics
|
||||||
|
|
||||||
! SSE2 is always available on x86-64.
|
! SSE2 is always available on x86-64.
|
||||||
enable-float-intrinsics
|
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 ;
|
: shift-arg ( -- reg ) RCX ;
|
||||||
: div-arg ( -- reg ) RAX ;
|
: div-arg ( -- reg ) RAX ;
|
||||||
: mod-arg ( -- reg ) RDX ;
|
: mod-arg ( -- reg ) RDX ;
|
||||||
: arg0 ( -- reg ) RDI ;
|
|
||||||
: arg1 ( -- reg ) RSI ;
|
|
||||||
: temp-reg ( -- reg ) RBX ;
|
: temp-reg ( -- reg ) RBX ;
|
||||||
: stack-reg ( -- reg ) RSP ;
|
: stack-reg ( -- reg ) RSP ;
|
||||||
: ds-reg ( -- reg ) R14 ;
|
: 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
|
1 jit-code-format set
|
||||||
|
|
||||||
: stack-frame-size ( -- n ) 4 bootstrap-cells ;
|
|
||||||
|
|
||||||
[
|
[
|
||||||
! Load word
|
! Load word
|
||||||
temp-reg 0 MOV
|
temp-reg 0 MOV
|
||||||
|
@ -30,7 +28,7 @@ big-endian off
|
||||||
temp-reg 0 MOV ! load XT
|
temp-reg 0 MOV ! load XT
|
||||||
stack-frame-size PUSH ! save stack frame size
|
stack-frame-size PUSH ! save stack frame size
|
||||||
temp-reg PUSH ! push XT
|
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
|
] 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 ds-reg [] MOV ! load shift count
|
||||||
shift-arg tag-bits get SAR ! untag shift count
|
shift-arg tag-bits get SAR ! untag shift count
|
||||||
ds-reg bootstrap-cell SUB ! adjust stack pointer
|
ds-reg bootstrap-cell SUB ! adjust stack pointer
|
||||||
arg0 ds-reg [] MOV ! load value
|
temp-reg ds-reg [] MOV ! load value
|
||||||
arg1 arg0 MOV ! make a copy
|
arg1 temp-reg MOV ! make a copy
|
||||||
arg1 CL SHL ! compute positive shift value in arg1
|
arg1 CL SHL ! compute positive shift value in arg1
|
||||||
shift-arg NEG ! compute negative shift value in arg0
|
shift-arg NEG ! compute negative shift value in arg0
|
||||||
arg0 CL SAR
|
temp-reg CL SAR
|
||||||
arg0 tag-mask get bitnot AND
|
temp-reg tag-mask get bitnot AND
|
||||||
shift-arg 0 CMP ! if shift count was negative, move arg0 to arg1
|
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
|
ds-reg [] arg1 MOV ! push to stack
|
||||||
] f f f \ fixnum-shift-fast define-sub-primitive
|
] 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' )
|
: align-stack ( n -- n' )
|
||||||
os macosx? cpu x86.64? or [ 16 align ] when ;
|
os macosx? cpu x86.64? or [ 16 align ] when ;
|
||||||
|
|
||||||
|
HOOK: reserved-area-size cpu ( -- n )
|
||||||
|
|
||||||
M: x86 stack-frame-size ( stack-frame -- i )
|
M: x86 stack-frame-size ( stack-frame -- i )
|
||||||
[ spill-counts>> [ swap reg-size * ] { } assoc>map sum ]
|
[ spill-counts>> [ swap reg-size * ] { } assoc>map sum ]
|
||||||
[ params>> ]
|
[ params>> ]
|
||||||
[ return>> ]
|
[ return>> ]
|
||||||
tri + +
|
tri + +
|
||||||
3 cells +
|
3 cells +
|
||||||
|
reserved-area-size +
|
||||||
align-stack ;
|
align-stack ;
|
||||||
|
|
||||||
M: x86 %call ( label -- ) CALL ;
|
M: x86 %call ( label -- ) CALL ;
|
||||||
|
@ -465,7 +468,7 @@ M: x86 %compare-float-branch ( label cc src1 src2 -- )
|
||||||
: stack@ ( n -- op ) stack-reg swap [+] ;
|
: stack@ ( n -- op ) stack-reg swap [+] ;
|
||||||
|
|
||||||
: spill-integer-base ( stack-frame -- n )
|
: spill-integer-base ( stack-frame -- n )
|
||||||
[ params>> ] [ return>> ] bi + ;
|
[ params>> ] [ return>> ] bi + reserved-area-size + ;
|
||||||
|
|
||||||
: spill-integer@ ( n -- op )
|
: spill-integer@ ( n -- op )
|
||||||
cells
|
cells
|
||||||
|
@ -473,10 +476,9 @@ M: x86 %compare-float-branch ( label cc src1 src2 -- )
|
||||||
+ stack@ ;
|
+ stack@ ;
|
||||||
|
|
||||||
: spill-float-base ( stack-frame -- n )
|
: spill-float-base ( stack-frame -- n )
|
||||||
|
[ spill-integer-base ]
|
||||||
[ spill-counts>> int-regs swap at int-regs reg-size * ]
|
[ spill-counts>> int-regs swap at int-regs reg-size * ]
|
||||||
[ params>> ]
|
bi + ;
|
||||||
[ return>> ]
|
|
||||||
tri + + ;
|
|
||||||
|
|
||||||
: spill-float@ ( n -- op )
|
: spill-float@ ( n -- op )
|
||||||
double-float-regs reg-size *
|
double-float-regs reg-size *
|
||||||
|
|
|
@ -76,6 +76,25 @@ IN: math.functions.tests
|
||||||
gcd nip
|
gcd nip
|
||||||
] unit-test
|
] 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 -- ? )
|
: verify-gcd ( a b -- ? )
|
||||||
2dup gcd
|
2dup gcd
|
||||||
>r rot * swap rem r> = ;
|
>r rot * swap rem r> = ;
|
||||||
|
|
|
@ -20,7 +20,8 @@ H{ } clone sub-primitives set
|
||||||
|
|
||||||
"resource:basis/cpu/" architecture get {
|
"resource:basis/cpu/" architecture get {
|
||||||
{ "x86.32" "x86/32" }
|
{ "x86.32" "x86/32" }
|
||||||
{ "x86.64" "x86/64" }
|
{ "winnt-x86.64" "x86/64/winnt" }
|
||||||
|
{ "unix-x86.64" "x86/64/unix" }
|
||||||
{ "linux-ppc" "ppc/linux" }
|
{ "linux-ppc" "ppc/linux" }
|
||||||
{ "macosx-ppc" "ppc/macosx" }
|
{ "macosx-ppc" "ppc/macosx" }
|
||||||
{ "arm" "arm" }
|
{ "arm" "arm" }
|
||||||
|
|
|
@ -101,8 +101,13 @@ unit-test
|
||||||
[ 268435456 ] [ -268435456 >fixnum -1 /i ] unit-test
|
[ 268435456 ] [ -268435456 >fixnum -1 /i ] unit-test
|
||||||
[ 268435456 0 ] [ -268435456 >fixnum -1 /mod ] unit-test
|
[ 268435456 0 ] [ -268435456 >fixnum -1 /mod ] unit-test
|
||||||
[ 0 ] [ -1 -268435456 >fixnum /i ] 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 >fixnum /mod ] unit-test
|
||||||
|
[ 0 -1 ] [ -1 -268435456 >bignum /mod ] unit-test
|
||||||
[ 14355 ] [ 1591517158873146351817850880000000 32769 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
|
[ -351382792 ] [ -43922849 3 shift ] unit-test
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
#WIN64_PATH=/k/MinGW/win64/bin
|
#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
|
CC=$(WIN64_PATH)-gcc.exe
|
||||||
WINDRES=$(WIN64_PATH)-windres.exe
|
WINDRES=$(WIN64_PATH)-windres.exe
|
||||||
include vm/Config.windows.nt
|
include vm/Config.windows.nt
|
||||||
|
|
27
vm/bignum.c
27
vm/bignum.c
|
@ -1,7 +1,7 @@
|
||||||
/* :tabSize=2:indentSize=2:noTabs=true:
|
/* :tabSize=2:indentSize=2:noTabs=true:
|
||||||
|
|
||||||
Copyright (C) 1989-94 Massachusetts Institute of Technology
|
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
|
This material was developed by the Scheme project at the Massachusetts
|
||||||
Institute of Technology, Department of Electrical Engineering and
|
Institute of Technology, Department of Electrical Engineering and
|
||||||
|
@ -45,6 +45,7 @@ MIT in each case. */
|
||||||
* - Remove unused functions
|
* - Remove unused functions
|
||||||
* - Add local variable GC root recording
|
* - Add local variable GC root recording
|
||||||
* - Remove s48 prefix from function names
|
* - Remove s48 prefix from function names
|
||||||
|
* - Various fixes for Win64
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include "master.h"
|
#include "master.h"
|
||||||
|
@ -366,8 +367,6 @@ bignum_remainder(bignum_type numerator, bignum_type denominator)
|
||||||
/* all below allocate memory */
|
/* all below allocate memory */
|
||||||
FOO_TO_BIGNUM(cell,CELL,CELL)
|
FOO_TO_BIGNUM(cell,CELL,CELL)
|
||||||
FOO_TO_BIGNUM(fixnum,F_FIXNUM,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(long_long,s64,u64)
|
||||||
FOO_TO_BIGNUM(ulong_long,u64,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 */
|
/* all of the below allocate memory */
|
||||||
BIGNUM_TO_FOO(cell,CELL,CELL);
|
BIGNUM_TO_FOO(cell,CELL,CELL);
|
||||||
BIGNUM_TO_FOO(fixnum,F_FIXNUM,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(long_long,s64,u64)
|
||||||
BIGNUM_TO_FOO(ulong_long,u64,u64)
|
BIGNUM_TO_FOO(ulong_long,u64,u64)
|
||||||
|
|
||||||
|
@ -435,7 +432,7 @@ double_to_bignum(double x)
|
||||||
bignum_digit_type digit;
|
bignum_digit_type digit;
|
||||||
int odd_bits = (exponent % BIGNUM_DIGIT_LENGTH);
|
int odd_bits = (exponent % BIGNUM_DIGIT_LENGTH);
|
||||||
if (odd_bits > 0)
|
if (odd_bits > 0)
|
||||||
DTB_WRITE_DIGIT (1L << odd_bits);
|
DTB_WRITE_DIGIT ((F_FIXNUM)1 << odd_bits);
|
||||||
while (start < scan)
|
while (start < scan)
|
||||||
{
|
{
|
||||||
if (significand == 0)
|
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_source = (scan_source + (BIGNUM_LENGTH (source)));
|
||||||
bignum_digit_type * end_target = (scan_target + (BIGNUM_LENGTH (target)));
|
bignum_digit_type * end_target = (scan_target + (BIGNUM_LENGTH (target)));
|
||||||
int shift_right = (BIGNUM_DIGIT_LENGTH - shift_left);
|
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)
|
while (scan_source < end_source)
|
||||||
{
|
{
|
||||||
digit = (*scan_source++);
|
digit = (*scan_source++);
|
||||||
|
@ -1139,7 +1136,7 @@ bignum_destructive_unnormalization(bignum_type bignum, int shift_right)
|
||||||
bignum_digit_type digit;
|
bignum_digit_type digit;
|
||||||
bignum_digit_type carry = 0;
|
bignum_digit_type carry = 0;
|
||||||
int shift_left = (BIGNUM_DIGIT_LENGTH - shift_right);
|
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)
|
while (start < scan)
|
||||||
{
|
{
|
||||||
digit = (*--scan);
|
digit = (*--scan);
|
||||||
|
@ -1489,7 +1486,7 @@ bignum_bitwise_not(bignum_type x)
|
||||||
|
|
||||||
/* allocates memory */
|
/* allocates memory */
|
||||||
bignum_type
|
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)
|
if (BIGNUM_NEGATIVE_P(arg1) && n < 0)
|
||||||
return bignum_bitwise_not(bignum_magnitude_ash(bignum_bitwise_not(arg1), n));
|
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 */
|
/* ash for the magnitude */
|
||||||
/* assume arg1 is a big number, n is a long */
|
/* assume arg1 is a big number, n is a long */
|
||||||
bignum_type
|
bignum_type
|
||||||
bignum_magnitude_ash(bignum_type arg1, long n)
|
bignum_magnitude_ash(bignum_type arg1, F_FIXNUM n)
|
||||||
{
|
{
|
||||||
bignum_type result = NULL;
|
bignum_type result = NULL;
|
||||||
bignum_digit_type *scan1;
|
bignum_digit_type *scan1;
|
||||||
bignum_digit_type *scanr;
|
bignum_digit_type *scanr;
|
||||||
bignum_digit_type *end;
|
bignum_digit_type *end;
|
||||||
|
|
||||||
long digit_offset,bit_offset;
|
F_FIXNUM digit_offset,bit_offset;
|
||||||
|
|
||||||
if (BIGNUM_ZERO_P (arg1)) return (arg1);
|
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) {
|
while (scanr < endr) {
|
||||||
digit1 = (scan1 < end1) ? *scan1++ : 0;
|
digit1 = (scan1 < end1) ? *scan1++ : 0;
|
||||||
digit2 = (scan2 < end2) ? *scan2++ : 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 :
|
*scanr++ = (op == AND_OP) ? digit1 & digit2 :
|
||||||
(op == IOR_OP) ? digit1 | digit2 :
|
(op == IOR_OP) ? digit1 | digit2 :
|
||||||
digit1 ^ digit2;
|
digit1 ^ digit2;
|
||||||
|
@ -1856,8 +1849,8 @@ digit_stream_to_bignum(unsigned int n_digits,
|
||||||
return (BIGNUM_ZERO ());
|
return (BIGNUM_ZERO ());
|
||||||
if (n_digits == 1)
|
if (n_digits == 1)
|
||||||
{
|
{
|
||||||
long digit = ((long) ((*producer) (0)));
|
F_FIXNUM digit = ((F_FIXNUM) ((*producer) (0)));
|
||||||
return (long_to_bignum (negative_p ? (- digit) : digit));
|
return (fixnum_to_bignum (negative_p ? (- digit) : digit));
|
||||||
}
|
}
|
||||||
{
|
{
|
||||||
bignum_length_type length;
|
bignum_length_type length;
|
||||||
|
|
|
@ -55,14 +55,10 @@ bignum_type bignum_quotient(bignum_type, bignum_type);
|
||||||
bignum_type bignum_remainder(bignum_type, bignum_type);
|
bignum_type bignum_remainder(bignum_type, bignum_type);
|
||||||
DLLEXPORT bignum_type fixnum_to_bignum(F_FIXNUM);
|
DLLEXPORT bignum_type fixnum_to_bignum(F_FIXNUM);
|
||||||
DLLEXPORT bignum_type cell_to_bignum(CELL);
|
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 long_long_to_bignum(s64 n);
|
||||||
DLLEXPORT bignum_type ulong_long_to_bignum(u64 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);
|
F_FIXNUM bignum_to_fixnum(bignum_type);
|
||||||
CELL bignum_to_cell(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);
|
s64 bignum_to_long_long(bignum_type);
|
||||||
u64 bignum_to_ulong_long(bignum_type);
|
u64 bignum_to_ulong_long(bignum_type);
|
||||||
bignum_type double_to_bignum(double);
|
bignum_type double_to_bignum(double);
|
||||||
|
@ -71,7 +67,7 @@ double bignum_to_double(bignum_type);
|
||||||
/* Added bitwise operators. */
|
/* Added bitwise operators. */
|
||||||
|
|
||||||
DLLEXPORT bignum_type bignum_bitwise_not(bignum_type),
|
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_and(bignum_type, bignum_type),
|
||||||
bignum_bitwise_ior(bignum_type, bignum_type),
|
bignum_bitwise_ior(bignum_type, bignum_type),
|
||||||
bignum_bitwise_xor(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);
|
void bignum_destructive_copy(bignum_type, bignum_type);
|
||||||
|
|
||||||
/* Added for bitwise operations. */
|
/* 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_pospos_bitwise_op(int op, bignum_type, bignum_type);
|
||||||
bignum_type bignum_posneg_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);
|
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)
|
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);
|
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 RETURN_REG %eax
|
||||||
|
|
||||||
#define CELL_SIZE 4
|
#define CELL_SIZE 4
|
||||||
|
#define STACK_PADDING 12
|
||||||
|
|
||||||
#define PUSH_NONVOLATILE \
|
#define PUSH_NONVOLATILE \
|
||||||
push %ebx ; \
|
push %ebx ; \
|
||||||
|
|
|
@ -1,24 +1,55 @@
|
||||||
#include "asm.h"
|
#include "asm.h"
|
||||||
|
|
||||||
#define ARG0 %rdi
|
|
||||||
#define ARG1 %rsi
|
|
||||||
#define STACK_REG %rsp
|
#define STACK_REG %rsp
|
||||||
#define DS_REG %r14
|
#define DS_REG %r14
|
||||||
#define RETURN_REG %rax
|
#define RETURN_REG %rax
|
||||||
|
|
||||||
#define CELL_SIZE 8
|
#define CELL_SIZE 8
|
||||||
|
#define STACK_PADDING 56
|
||||||
|
|
||||||
#define PUSH_NONVOLATILE \
|
#ifdef WINDOWS
|
||||||
push %rbx ; \
|
|
||||||
push %rbp ; \
|
|
||||||
push %r12 ; \
|
|
||||||
push %r13 ;
|
|
||||||
|
|
||||||
#define POP_NONVOLATILE \
|
#define ARG0 %rcx
|
||||||
pop %r13 ; \
|
#define ARG1 %rdx
|
||||||
pop %r12 ; \
|
#define ARG2 %r8
|
||||||
pop %rbp ; \
|
#define ARG3 %r9
|
||||||
pop %rbx
|
|
||||||
|
#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
|
#define QUOT_XT_OFFSET 21
|
||||||
|
|
||||||
|
@ -26,9 +57,9 @@
|
||||||
ABI limitation which would otherwise require us to do a bizzaro PC-relative
|
ABI limitation which would otherwise require us to do a bizzaro PC-relative
|
||||||
trampoline to retrieve the function address */
|
trampoline to retrieve the function address */
|
||||||
DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy)):
|
DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy)):
|
||||||
sub %rdx,%rdi /* compute new stack pointer */
|
sub ARG2,ARG0 /* compute new stack pointer */
|
||||||
mov %rdi,%rsp
|
mov ARG0,%rsp
|
||||||
call *%rcx /* call memcpy */
|
call *ARG3 /* call memcpy */
|
||||||
ret /* return _with new stack_ */
|
ret /* return _with new stack_ */
|
||||||
|
|
||||||
#include "cpu-x86.S"
|
#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)):
|
DEF(F_FASTCALL void,c_to_factor,(CELL quot)):
|
||||||
PUSH_NONVOLATILE
|
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)
|
call MANGLE(save_callstack_bottom)
|
||||||
|
add $32,STACK_REG
|
||||||
|
|
||||||
mov (STACK_REG),ARG0 /* Pass quot as arg 1 */
|
/* Call quot-xt */
|
||||||
call *QUOT_XT_OFFSET(ARG0) /* Call quot-xt */
|
mov (STACK_REG),ARG0
|
||||||
|
call *QUOT_XT_OFFSET(ARG0)
|
||||||
|
|
||||||
POP ARG0
|
pop ARG0
|
||||||
POP_NONVOLATILE
|
POP_NONVOLATILE
|
||||||
ret
|
ret
|
||||||
|
|
||||||
DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
|
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)
|
jmp *QUOT_XT_OFFSET(ARG0)
|
||||||
|
|
||||||
DEF(FASTCALL void,lazy_jit_compile,(CELL quot)):
|
DEF(FASTCALL void,lazy_jit_compile,(CELL quot)):
|
||||||
mov STACK_REG,ARG1 /* Save stack pointer */
|
mov STACK_REG,ARG1 /* Save stack pointer */
|
||||||
push ARG1 /* Alignment */
|
sub $STACK_PADDING,STACK_REG
|
||||||
push ARG1
|
|
||||||
push ARG1
|
|
||||||
call MANGLE(primitive_jit_compile)
|
call MANGLE(primitive_jit_compile)
|
||||||
mov RETURN_REG,ARG0 /* No-op on 32-bit */
|
mov RETURN_REG,ARG0 /* No-op on 32-bit */
|
||||||
pop ARG1 /* OK to clobber ARG1 here */
|
add $STACK_PADDING,STACK_REG
|
||||||
pop ARG1
|
|
||||||
pop ARG1
|
|
||||||
jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
|
jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
|
||||||
|
|
||||||
#ifdef WINDOWS
|
#ifdef WINDOWS
|
||||||
|
|
|
@ -438,6 +438,8 @@ void collect_gen_cards(CELL gen)
|
||||||
old->new references */
|
old->new references */
|
||||||
void collect_cards(void)
|
void collect_cards(void)
|
||||||
{
|
{
|
||||||
|
GC_PRINT("Collect cards\n");
|
||||||
|
|
||||||
int i;
|
int i;
|
||||||
for(i = collecting_gen + 1; i < data_heap->gen_count; i++)
|
for(i = collecting_gen + 1; i < data_heap->gen_count; i++)
|
||||||
collect_gen_cards(i);
|
collect_gen_cards(i);
|
||||||
|
@ -465,7 +467,10 @@ void collect_callstack(F_CONTEXT *stacks)
|
||||||
{
|
{
|
||||||
CELL top = (CELL)stacks->callstack_top;
|
CELL top = (CELL)stacks->callstack_top;
|
||||||
CELL bottom = (CELL)stacks->callstack_bottom;
|
CELL bottom = (CELL)stacks->callstack_bottom;
|
||||||
|
|
||||||
|
GC_PRINT("Collect callstack %ld %ld\n",top,bottom);
|
||||||
iterate_callstack(top,bottom,collect_stack_frame);
|
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 */
|
the user environment and extra roots registered with REGISTER_ROOT */
|
||||||
void collect_roots(void)
|
void collect_roots(void)
|
||||||
{
|
{
|
||||||
|
GC_PRINT("Collect roots\n");
|
||||||
copy_handle(&T);
|
copy_handle(&T);
|
||||||
copy_handle(&bignum_zero);
|
copy_handle(&bignum_zero);
|
||||||
copy_handle(&bignum_pos_one);
|
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)
|
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)
|
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)
|
void misc_signal_handler_impl(void)
|
||||||
{
|
{
|
||||||
signal_error(signal_number,signal_callstack_top);
|
signal_error(signal_number,signal_callstack_top);
|
||||||
}
|
}
|
||||||
|
|
||||||
DEFINE_PRIMITIVE(throw)
|
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);
|
init_factor(&p);
|
||||||
|
|
||||||
nest_stacks();
|
nest_stacks();
|
||||||
|
|
||||||
F_ARRAY *args = allot_array(ARRAY_TYPE,argc,F);
|
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:
|
case BIGNUM_TYPE:
|
||||||
{
|
{
|
||||||
bignum_type zero = untag_object(bignum_zero);
|
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());
|
bignum_type n = untag_object(dpeek());
|
||||||
if(bignum_compare(n,zero) != bignum_comparison_less
|
if(bignum_compare(n,zero) != bignum_comparison_less
|
||||||
&& bignum_compare(n,max) == bignum_comparison_less)
|
&& bignum_compare(n,max) == bignum_comparison_less)
|
||||||
{
|
{
|
||||||
dpop();
|
dpop();
|
||||||
return bignum_to_ulong(n);
|
return bignum_to_cell(n);
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue