fix some overflow issues

cvs
Slava Pestov 2004-08-27 02:21:17 +00:00
parent e8c112ac03
commit 8dcb356cff
88 changed files with 181 additions and 120 deletions

View File

@ -35,7 +35,7 @@ USE: strings
rect> dup CHAR: ~ mandel-step >char write ;
: mandel-y ( y -- )
75 [ dupd 25 / 2 - >float swap mandel-x ] times* drop terpri ;
75 [ dupd 25 / 2 - swap mandel-x ] times* drop terpri ;
: mandel ( -- )
21 [ 10 / 1 - >float mandel-y ] times* ;
21 [ 10 / 1 - mandel-y ] times* ;

View File

@ -26,9 +26,9 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: cross-compiler
USE: arithmetic
USE: kernel
USE: lists
USE: math
USE: namespaces
USE: parser
USE: real-math
@ -40,10 +40,6 @@ USE: vectors
USE: vectors
USE: words
IN: arithmetic
DEFER: number=
DEFER: /i
IN: kernel
DEFER: getenv
DEFER: setenv
@ -79,6 +75,10 @@ DEFER: add-write-io-task
DEFER: write-fd-8
DEFER: next-io-task
IN: math
DEFER: number=
DEFER: /i
IN: parser
DEFER: str>float
@ -177,7 +177,6 @@ IN: cross-compiler
<=
>
>=
gcd
facos
fasin
fatan

View File

@ -26,11 +26,11 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: errors
USE: arithmetic
USE: combinators
USE: continuations
USE: kernel
USE: lists
USE: math
USE: namespaces
USE: stack
USE: strings

View File

@ -26,9 +26,9 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: format
USE: arithmetic
USE: combinators
USE: kernel
USE: math
USE: namespaces
USE: strings
USE: stack

View File

@ -26,10 +26,10 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: hashtables
USE: arithmetic
USE: combinators
USE: kernel
USE: lists
USE: math
USE: stack
USE: vectors

View File

@ -26,7 +26,6 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: httpd
USE: arithmetic
USE: combinators
USE: errors
USE: httpd-responder
@ -34,6 +33,7 @@ USE: kernel
USE: lists
USE: logging
USE: logic
USE: math
USE: namespaces
USE: stack
USE: stdio

View File

@ -26,11 +26,11 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: url-encoding
USE: arithmetic
USE: combinators
USE: kernel
USE: logic
USE: format
USE: math
USE: parser
USE: stack
USE: strings

View File

@ -26,7 +26,6 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: cross-compiler
USE: arithmetic
USE: combinators
USE: errors
USE: format
@ -34,6 +33,7 @@ USE: hashtables
USE: kernel
USE: lists
USE: logic
USE: math
USE: namespaces
USE: prettyprint
USE: stack

View File

@ -26,13 +26,13 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: interpreter
USE: arithmetic
USE: combinators
USE: continuations
USE: errors
USE: kernel
USE: lists
USE: logic
USE: math
USE: namespaces
USE: parser
USE: stack

View File

@ -26,8 +26,8 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: jedit
USE: arithmetic
USE: combinators
USE: math
USE: namespaces
USE: stack
USE: strings

View File

@ -26,11 +26,11 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: jedit
USE: arithmetic
USE: combinators
USE: errors
USE: kernel
USE: logic
USE: math
USE: namespaces
USE: stack
USE: stdio

View File

@ -26,10 +26,10 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: lists
USE: arithmetic
USE: combinators
USE: kernel
USE: logic
USE: math
USE: stack
USE: vectors

View File

@ -26,8 +26,8 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: math
USE: arithmetic
USE: combinators
USE: math
USE: real-math
USE: stack

View File

@ -25,7 +25,7 @@
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: arithmetic
IN: math
USE: combinators
USE: kernel
USE: logic

View File

@ -26,8 +26,8 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: math
USE: arithmetic
USE: lists
USE: math
USE: stack
: |+ ( list -- sum )

View File

@ -25,7 +25,7 @@
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: arithmetic
IN: math
USE: combinators
USE: kernel
USE: stack

View File

@ -26,10 +26,10 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: math
USE: arithmetic
USE: combinators
USE: kernel
USE: logic
USE: math
USE: real-math
USE: stack
@ -57,7 +57,11 @@ USE: stack
: abs ( z -- abs )
#! Compute the complex absolute value.
>rect mag2 ; inline
dup complex? [
>rect mag2
] [
dup 0 < [ neg ] when
] ifte ;
: conjugate ( z -- z* )
>rect neg rect> ;

View File

@ -25,7 +25,7 @@
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: arithmetic
IN: math
USE: combinators
USE: logic
USE: namespaces

View File

@ -26,8 +26,8 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: math
USE: arithmetic
USE: combinators
USE: math
USE: real-math
USE: kernel
USE: stack

View File

@ -26,8 +26,8 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: math
USE: arithmetic
USE: combinators
USE: math
USE: stack
: quadratic-complete ( a b c -- a b c a b )

View File

@ -26,11 +26,11 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: math
USE: arithmetic
USE: combinators
USE: kernel
USE: lists
USE: logic
USE: math
USE: stack
: multiplier ( n -- 2|4 )

View File

@ -26,9 +26,9 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: math
USE: arithmetic
USE: combinators
USE: kernel
USE: math
USE: real-math
USE: stack

View File

@ -25,7 +25,7 @@
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: arithmetic
IN: math
USE: combinators
USE: kernel
USE: logic

View File

@ -26,9 +26,9 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: cross-compiler
USE: arithmetic
USE: kernel
USE: lists
USE: math
USE: parser
USE: stack
USE: stdio

View File

@ -82,7 +82,7 @@ IN: kernel
: garbage-collection ( -- )
[ ] "java.lang.System" "gc" jinvoke-static ;
IN: arithmetic
IN: math
DEFER: >bignum
IN: kernel
@ -106,10 +106,12 @@ IN: kernel
: free-memory ( -- int )
#! Return the free memory in the JVM.
jvm-runtime f "java.lang.Runtime" "freeMemory" jinvoke ;
jvm-runtime f "java.lang.Runtime" "freeMemory" jinvoke
>bignum ;
: total-memory ( -- int )
#! Return the total memory available to the JVM.
jvm-runtime f "java.lang.Runtime" "totalMemory" jinvoke ;
jvm-runtime f "java.lang.Runtime" "totalMemory" jinvoke
>bignum ;
: room free-memory total-memory ;

View File

@ -25,7 +25,7 @@
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: arithmetic
IN: math
USE: combinators
USE: kernel
USE: logic

View File

@ -26,9 +26,9 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: prettyprint
USE: arithmetic
USE: combinators
USE: lists
USE: math
USE: prettyprint
USE: stack
USE: stdio

View File

@ -31,8 +31,8 @@
!!! 'math' vocabulary instead.
IN: real-math
USE: arithmetic
USE: kernel
USE: math
USE: stack
: facos ( x -- acos )

View File

@ -26,11 +26,11 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: regexp
USE: arithmetic
USE: combinators
USE: kernel
USE: logic
USE: lists
USE: math
USE: stack
: <regex> ( pattern -- regex )

View File

@ -82,6 +82,7 @@ USE: stdio
"/library/platform/native/init.factor"
"/library/math/math.factor"
"/library/platform/native/math.factor"
"/library/math/pow.factor"
"/library/math/trig-hyp.factor"
"/library/math/arc-trig-hyp.factor"

View File

@ -26,12 +26,12 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: errors
USE: arithmetic
USE: combinators
USE: continuations
USE: kernel
USE: lists
USE: logic
USE: math
USE: namespaces
USE: prettyprint
USE: stack
@ -77,7 +77,7 @@ USE: vectors
" with " write unparse print ;
: float-format-error ( list -- )
"Invalid floating point literal format: " write car . ;
"Invalid floating point literal format: " write . ;
: signal-error ( obj -- )
"Operating system signal " write . ;

View File

@ -29,12 +29,12 @@ IN: vectors
DEFER: vector=
IN: kernel
USE: arithmetic
USE: combinators
USE: errors
USE: io-internals
USE: lists
USE: logic
USE: math
USE: namespaces
USE: stack
USE: stdio

View File

@ -0,0 +1,39 @@
! :folding=indent:collapseFolds=0:
! $Id$
!
! Copyright (C) 2004 Slava Pestov.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice,
! this list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: math
USE: combinators
USE: kernel
USE: stack
: (gcd) ( x y -- z )
USE: prettyprint .s
dup 0 = [ drop ] [ tuck mod (gcd) ] ifte ;
: gcd ( x y -- z )
#! Greatest common divisor.
abs swap abs 2dup < [ swap ] when (gcd) ;

View File

@ -26,11 +26,11 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: namespaces
USE: arithmetic
USE: combinators
USE: hashtables
USE: kernel
USE: lists
USE: math
USE: stack
USE: strings
USE: vectors

View File

@ -26,12 +26,12 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: parser
USE: arithmetic
USE: combinators
USE: errors
USE: kernel
USE: lists
USE: logic
USE: math
USE: namespaces
USE: stack
USE: strings

View File

@ -26,11 +26,11 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: parser
USE: arithmetic
USE: combinators
USE: errors
USE: kernel
USE: lists
USE: math
USE: namespaces
USE: stack
USE: stdio

View File

@ -29,13 +29,13 @@
! that it does not contain Java words anymore!
IN: builtins
USE: arithmetic
USE: combinators
USE: cross-compiler
USE: errors
USE: kernel
USE: lists
USE: logic
USE: math
USE: namespaces
USE: parser
USE: stack

View File

@ -26,12 +26,12 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: parser
USE: arithmetic
USE: combinators
USE: errors
USE: kernel
USE: lists
USE: logic
USE: math
USE: namespaces
USE: stack
USE: strings

View File

@ -26,9 +26,9 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: profiler
USE: arithmetic
USE: kernel
USE: lists
USE: math
USE: prettyprint
USE: stack
USE: words

View File

@ -26,8 +26,8 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: random
USE: arithmetic
USE: kernel
USE: math
USE: stack
: power-of-2? ( n -- ? )

View File

@ -26,9 +26,9 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: strings
USE: arithmetic
USE: kernel
USE: logic
USE: math
USE: stack
: cat2 ( "a" "b" -- "ab" )

View File

@ -26,12 +26,12 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: unparser
USE: arithmetic
USE: combinators
USE: kernel
USE: format
USE: lists
USE: logic
USE: math
USE: namespaces
USE: parser
USE: stack

View File

@ -26,10 +26,10 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: vectors
USE: arithmetic
USE: combinators
USE: kernel
USE: lists
USE: math
USE: stack
: 2vector-nth ( n vec vec -- obj obj )

View File

@ -26,13 +26,13 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: prettyprint
USE: arithmetic
USE: combinators
USE: errors
USE: format
USE: kernel
USE: logic
USE: lists
USE: math
USE: namespaces
USE: prettyprint
USE: stack

View File

@ -26,10 +26,10 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: random
USE: arithmetic
USE: combinators
USE: kernel
USE: lists
USE: math
USE: stack
: random-digit ( -- digit )

View File

@ -26,10 +26,10 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: strings
USE: arithmetic
USE: combinators
USE: kernel
USE: lists
USE: math
USE: namespaces
USE: strings
USE: stack

View File

@ -26,7 +26,7 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: stdio
USE: arithmetic
USE: math
USE: stack
USE: streams
USE: strings

View File

@ -26,11 +26,11 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: strings
USE: arithmetic
USE: combinators
USE: kernel
USE: lists
USE: logic
USE: math
USE: stack
: f-or-"" ( obj -- ? )

View File

@ -1,5 +1,5 @@
IN: scratchpad
USE: arithmetic
USE: math
USE: test
[ 2000000 [ ] times ] time

View File

@ -1,6 +1,6 @@
IN: scratchpad
USE: arithmetic
USE: lists
USE: math
USE: random
USE: stack
USE: test

View File

@ -1,9 +1,9 @@
IN: scratchpad
USE: arithmetic
USE: combinators
USE: continuations
USE: kernel
USE: lists
USE: math
USE: namespaces
USE: stack
USE: stdio

View File

@ -1,10 +1,10 @@
IN: scratchpad
USE: arithmetic
USE: combinators
USE: hashtables
USE: kernel
USE: lists
USE: logic
USE: math
USE: namespaces
USE: stack
USE: test

View File

@ -1,2 +1,2 @@
USE: arithmetic
USE: math
2 2 +

View File

@ -1,7 +1,7 @@
IN: scratchpad
USE: arithmetic
USE: combinators
USE: kernel
USE: math
USE: stack
USE: stdio
USE: test

View File

@ -1,5 +1,4 @@
IN: scratchpad
USE: arithmetic
USE: combinators
USE: compiler
USE: kernel

View File

@ -1,5 +1,4 @@
IN: scratchpad
USE: arithmetic
USE: combinators
USE: compiler
USE: inspector

View File

@ -1,5 +1,4 @@
IN: scratchpad
USE: arithmetic
USE: compiler
USE: lists
USE: math

View File

@ -1,11 +1,11 @@
IN: scratchpad
USE: arithmetic
USE: combinators
USE: compiler
USE: continuations
USE: kernel
USE: lists
USE: logic
USE: math
USE: namespaces
USE: random
USE: stack

View File

@ -1,8 +1,8 @@
IN: scratchpad
USE: arithmetic
USE: combinators
USE: kernel
USE: lists
USE: math
USE: prettyprint
USE: stack
USE: stdio

View File

@ -1,7 +1,7 @@
IN: scratchpad
USE: arithmetic
USE: compiler
USE: lists
USE: math
USE: stack
USE: stdio
USE: strings

View File

@ -1,6 +1,6 @@
IN: scratchpad
USE: arithmetic
USE: lists
USE: math
USE: namespaces
USE: test

View File

@ -1,6 +1,6 @@
USE: arithmetic
USE: compiler
USE: lists
USE: math
USE: stack
USE: strings
USE: test

View File

@ -1,8 +1,8 @@
IN: scratchpad
USE: arithmetic
USE: kernel
USE: lists
USE: logic
USE: math
USE: namespaces
USE: stack
USE: test

View File

@ -1,6 +1,6 @@
IN: scratchpad
USE: arithmetic
USE: stack
USE: math
USE: test
USE: unparser
@ -17,3 +17,9 @@ unit-test
[ 4294967296 ] [ 1 16 shift 16 shift ] unit-test
[ 4294967296 ] [ 1 32 shift ] unit-test
[ 1267650600228229401496703205376 ] [ 1 100 shift ] unit-test
[ 268435456 ] [ -268435456 >fixnum -1 / ] unit-test
[ 268435456 ] [ -268435456 >fixnum -1 /i ] unit-test
[ 268435456 0 ] [ -268435456 >fixnum -1 /mod ] unit-test
[ 1/268435456 ] [ -1 -268435456 >fixnum / ] unit-test
[ 0 ] [ -1 -268435456 >fixnum /i ] unit-test
[ 0 -1 ] [ -1 -268435456 >fixnum /mod ] unit-test

View File

@ -1,6 +1,6 @@
IN: scratchpad
USE: arithmetic
USE: kernel
USE: math
USE: stack
USE: test

View File

@ -1,6 +1,6 @@
IN: scratchpad
USE: arithmetic
USE: kernel
USE: math
USE: stack
USE: test

View File

@ -1,6 +1,6 @@
IN: scratchpad
USE: arithmetic
USE: kernel
USE: math
USE: stack
USE: test

View File

@ -1,5 +1,5 @@
IN: scratchpad
USE: arithmetic
USE: math
USE: test
[ 100 ] [ 100 100 gcd ] unit-test
@ -19,3 +19,9 @@ USE: test
[ 4 ] [ -132 >bignum -64 >bignum gcd ] unit-test
[ 4 ] [ 132 >bignum -64 >bignum gcd ] unit-test
[ 4 ] [ -132 >bignum -64 >bignum gcd ] unit-test
[ 6 ] [
1326264299060955293181542400000006
1591517158873146351817850880000000
gcd
] unit-test

View File

@ -1,5 +1,4 @@
IN: scratchpad
USE: arithmetic
USE: kernel
USE: math
USE: test

View File

@ -1,6 +1,6 @@
IN: scratchpad
USE: arithmetic
USE: kernel
USE: math
USE: stack
USE: test
USE: unparser

View File

@ -1,5 +1,4 @@
IN: scratchpad
USE: arithmetic
USE: math
USE: test

View File

@ -1,7 +1,7 @@
IN: scratchpad
USE: arithmetic
USE: compiler
USE: kernel
USE: math
USE: namespaces
USE: stack
USE: test

View File

@ -1,5 +1,5 @@
IN: scratchpad
USE: arithmetic
USE: math
USE: parser
USE: strings
USE: test

View File

@ -1,8 +1,8 @@
IN: scratchpad
USE: arithmetic
USE: kernel
USE: lists
USE: logic
USE: math
USE: namespaces
USE: random
USE: stack

View File

@ -1,7 +1,7 @@
IN: scratchpad
USE: arithmetic
USE: combinators
USE: kernel
USE: math
USE: namespaces
USE: stack
USE: strings

View File

@ -3,12 +3,12 @@
! Some of these words should be moved to the standard library.
IN: test
USE: arithmetic
USE: combinators
USE: compiler
USE: errors
USE: kernel
USE: lists
USE: math
USE: namespaces
USE: parser
USE: prettyprint
@ -22,7 +22,7 @@ USE: unparser
[ "Assertion failed!" throw ] unless ;
: print-test ( input output -- )
"TESTING: " write 2list . ;
"TESTING: " write 2list . flush ;
: keep-datastack ( quot -- )
datastack >r call r> set-datastack drop ;

View File

@ -1,6 +1,6 @@
USE: arithmetic
USE: lists
USE: kernel
USE: math
USE: random
USE: stack
USE: test

View File

@ -1,5 +1,5 @@
IN: scratchpad
USE: arithmetic
USE: math
USE: test
USE: words

View File

@ -26,10 +26,10 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: vectors
USE: arithmetic
USE: combinators
USE: kernel
USE: logic
USE: math
USE: stack
: vector-each ( vector code -- )

View File

@ -26,9 +26,9 @@
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
IN: vectors
USE: arithmetic
USE: kernel
USE: lists
USE: math
USE: stack
: empty-vector ( len -- vec )

View File

@ -1,5 +1,13 @@
#include "factor.h"
CELL tag_fixnum_or_bignum(FIXNUM x)
{
if(x < FIXNUM_MIN || x > FIXNUM_MAX)
return tag_object(s48_long_to_bignum(x));
else
return tag_fixnum(x);
}
CELL upgraded_arithmetic_type(CELL type1, CELL type2)
{
switch(type1)
@ -193,10 +201,6 @@ BINARY_OP(greater)
BINARY_OP_NUMBER_ONLY(greatereq)
BINARY_OP(greatereq)
BINARY_OP_INTEGER_ONLY(gcd)
BINARY_OP_NUMBER_ONLY(gcd)
BINARY_OP(gcd)
UNARY_OP_INTEGER_ONLY(not)
UNARY_OP_NUMBER_ONLY(not)
UNARY_OP(not)

View File

@ -9,12 +9,7 @@ RATIO* bignum_to_ratio(CELL n);
FLOAT* bignum_to_float(CELL n);
FLOAT* ratio_to_float(CELL n);
#define CELL_TO_INTEGER(result) \
FIXNUM _result = (result); \
if(_result < FIXNUM_MIN || _result > FIXNUM_MAX) \
return tag_object(s48_long_to_bignum(_result)); \
else \
return tag_fixnum(_result);
CELL tag_fixnum_or_bignum(FIXNUM x);
#define BINARY_OP(OP) \
CELL OP(CELL x, CELL y) \

View File

@ -25,11 +25,11 @@
/* CELL must be 32 bits and your system must have 32-bit pointers */
typedef unsigned long int CELL;
#define CELLS sizeof(CELL)
#define CELLS ((signed)sizeof(CELL))
/* must always be 16 bits */
typedef unsigned short CHAR;
#define CHARS sizeof(CHAR)
#define CHARS ((signed)sizeof(CHAR))
/* Memory heap size */
#define DEFAULT_ARENA (5 * 1024 * 1024)

View File

@ -40,12 +40,14 @@ CELL number_eq_fixnum(CELL x, CELL y)
CELL add_fixnum(CELL x, CELL y)
{
CELL_TO_INTEGER(untag_fixnum_fast(x) + untag_fixnum_fast(y));
return tag_fixnum_or_bignum(untag_fixnum_fast(x)
+ untag_fixnum_fast(y));
}
CELL subtract_fixnum(CELL x, CELL y)
{
CELL_TO_INTEGER(untag_fixnum_fast(x) - untag_fixnum_fast(y));
return tag_fixnum_or_bignum(untag_fixnum_fast(x)
- untag_fixnum_fast(y));
}
CELL multiply_fixnum(CELL _x, CELL _y)
@ -67,7 +69,7 @@ CELL divint_fixnum(CELL x, CELL y)
{
/* division takes common factor of 8 out. */
/* we have to do SIGNED division here */
return tag_fixnum((FIXNUM)x / (FIXNUM)y);
return tag_fixnum_or_bignum((FIXNUM)x / (FIXNUM)y);
}
CELL divfloat_fixnum(CELL x, CELL y)
@ -79,17 +81,19 @@ CELL divfloat_fixnum(CELL x, CELL y)
return tag_object(make_float((double)_x / (double)_y));
}
CELL divmod_fixnum(CELL x, CELL y)
CELL divmod_fixnum(CELL _x, CELL _y)
{
ldiv_t q = ldiv(x,y);
/* division takes common factor of 8 out. */
dpush(tag_fixnum(q.quot));
return q.rem;
FIXNUM x = untag_fixnum_fast(_x);
FIXNUM y = untag_fixnum_fast(_y);
dpush(tag_fixnum_or_bignum(x / y));
return tag_fixnum_or_bignum(x % y);
}
CELL mod_fixnum(CELL x, CELL y)
CELL mod_fixnum(CELL _x, CELL _y)
{
return x % y;
FIXNUM x = untag_fixnum_fast(_x);
FIXNUM y = untag_fixnum_fast(_y);
return tag_fixnum(x % y);
}
FIXNUM gcd_fixnum(FIXNUM x, FIXNUM y)
@ -141,9 +145,13 @@ CELL divide_fixnum(CELL x, CELL y)
}
if(_y == 1)
return tag_fixnum(_x);
return tag_fixnum_or_bignum(_x);
else
return tag_ratio(ratio(tag_fixnum(_x),tag_fixnum(_y)));
{
return tag_ratio(ratio(
tag_fixnum_or_bignum(_x),
tag_fixnum_or_bignum(_y)));
}
}
CELL and_fixnum(CELL x, CELL y)
@ -164,7 +172,7 @@ CELL xor_fixnum(CELL x, CELL y)
CELL shift_fixnum(CELL _x, FIXNUM y)
{
FIXNUM x = untag_fixnum_fast(_x);
if(y > CELLS * -8 && y < CELLS * 8)
if(y > -CELLS * 8 && y < CELLS * 8)
{
long long result = (y < 0
? (long long)x >> -y

View File

@ -1,3 +1,5 @@
FILE* debug_fd;
typedef enum {
IO_TASK_READ_LINE,
IO_TASK_READ_COUNT,

View File

@ -46,10 +46,11 @@ void check_memory(void)
{
if(active->here > active->limit)
{
printf("Out of memory\n");
printf("active->base = %ld\n",active->base);
printf("active->here = %ld\n",active->here);
printf("active->limit = %ld\n",active->limit);
fprintf(stderr,"Out of memory\n");
fprintf(stderr,"active->base = %ld\n",active->base);
fprintf(stderr,"active->here = %ld\n",active->here);
fprintf(stderr,"active->limit = %ld\n",active->limit);
fflush(stderr);
exit(1);
}

View File

@ -73,7 +73,6 @@ XT primitives[] = {
primitive_lesseq,
primitive_greater,
primitive_greatereq,
primitive_gcd,
primitive_facos,
primitive_fasin,
primitive_fatan,

View File

@ -1,4 +1,4 @@
extern XT primitives[];
#define PRIMITIVE_COUNT 141
#define PRIMITIVE_COUNT 140
CELL primitive_to_xt(CELL primitive);