updated intrinsics tests for 64-bit

cvs
Slava Pestov 2005-12-07 04:09:51 +00:00
parent eac3146be6
commit 2c756975ae
5 changed files with 34 additions and 11 deletions

View File

@ -37,7 +37,7 @@ cpu "amd64" = [
! Handle -libraries:... overrides ! Handle -libraries:... overrides
parse-command-line parse-command-line
"compile" get supported-cpu? and [ "compile" get "native-io" get and supported-cpu? and [
unix? [ unix? [
"/library/unix/load.factor" run-resource "/library/unix/load.factor" run-resource
] when ] when

View File

@ -47,6 +47,7 @@ parser sequences strings ;
#! -no-<flag> CLI switch #! -no-<flag> CLI switch
"user-init" on "user-init" on
"compile" on "compile" on
"native-io" on
"null-stdio" off "null-stdio" off
os "win32" = "ui" "tty" ? "shell" set ; os "win32" = "ui" "tty" ? "shell" set ;

View File

@ -56,15 +56,6 @@ M: %fixnum* generate-node ( vop -- )
"end" get save-xt "end" get save-xt
3 6 MR ; 3 6 MR ;
: first-bignum ( -- n )
1 cell 8 * tag-bits - 1- shift ; inline
: most-positive-fixnum ( -- n )
first-bignum 1- >fixnum ; inline
: most-negative-fixnum ( -- n )
first-bignum neg >fixnum ; inline
: generate-fixnum/i : generate-fixnum/i
6 3 4 DIVW ! divide in2 by in1, store result in out1 6 3 4 DIVW ! divide in2 by in1, store result in out1
! if the result is greater than the most positive fixnum, ! if the result is greater than the most positive fixnum,

View File

@ -1,7 +1,8 @@
! Copyright (C) 2004, 2005 Slava Pestov. ! Copyright (C) 2004, 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license. ! See http://factor.sf.net/license.txt for BSD license.
IN: math IN: math
USING: errors generic kernel math sequences sequences-internals ; USING: errors generic kernel kernel-internals math sequences
sequences-internals ;
UNION: integer fixnum bignum ; UNION: integer fixnum bignum ;
@ -31,6 +32,15 @@ UNION: integer fixnum bignum ;
: next-power-of-2 ( n -- n ) : next-power-of-2 ( n -- n )
1 swap (next-power-of-2) ; 1 swap (next-power-of-2) ;
: first-bignum ( -- n )
1 cell 8 * tag-bits - 1- shift ; inline
: most-positive-fixnum ( -- n )
first-bignum 1- >fixnum ; inline
: most-negative-fixnum ( -- n )
first-bignum neg >fixnum ; inline
IN: math-internals IN: math-internals
: fraction> ( a b -- a/b ) : fraction> ( a b -- a/b )

View File

@ -187,3 +187,24 @@ math-internals sequences strings test words ;
100001 <array> 3 100000 pick set-nth 100001 <array> 3 100000 pick set-nth
[ 100000 swap array-nth ] compile-1 [ 100000 swap array-nth ] compile-1
] unit-test ] unit-test
! 64-bit overflow
cell 8 = [
[ t ] [ 1 59 fixnum-shift dup [ fixnum+ ] compile-1 1 60 fixnum-shift = ] unit-test
[ -1152921504606846977 ] [ 1 60 shift neg >fixnum [ -1 fixnum+ ] compile-1 ] unit-test
[ 18446744073709551616 ] [ 1 64 [ fixnum-shift ] compile-1 ] unit-test
[ 18446744073709551616 ] [ 1 [ 64 fixnum-shift ] compile-1 ] unit-test
[ 18446744073709551616 ] [ 1 [ 32 fixnum-shift 32 fixnum-shift ] compile-1 ] unit-test
[ -18446744073709551616 ] [ -1 64 [ fixnum-shift ] compile-1 ] unit-test
[ -18446744073709551616 ] [ -1 [ 64 fixnum-shift ] compile-1 ] unit-test
[ -18446744073709551616 ] [ -1 [ 32 fixnum-shift 32 fixnum-shift ] compile-1 ] unit-test
[ t ] [ 1 40 shift 1 40 shift [ fixnum* ] compile-1 1 80 shift = ] unit-test
[ t ] [ 1 40 shift neg 1 40 shift [ fixnum* ] compile-1 1 80 shift neg = ] unit-test
[ t ] [ 1 40 shift neg 1 40 shift neg [ fixnum* ] compile-1 1 80 shift = ] unit-test
[ 1152921504606846976 ] [ -1152921504606846976 >fixnum -1 [ fixnum/i ] compile-1 ] unit-test
[ 1152921504606846976 0 ] [ -1152921504606846976 >fixnum -1 [ fixnum/mod ] compile-1 ] unit-test
] when