fix some overflow issues
parent
e8c112ac03
commit
8dcb356cff
|
@ -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* ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -26,8 +26,8 @@
|
|||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
IN: math
|
||||
USE: arithmetic
|
||||
USE: combinators
|
||||
USE: math
|
||||
USE: real-math
|
||||
USE: stack
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -26,8 +26,8 @@
|
|||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
IN: math
|
||||
USE: arithmetic
|
||||
USE: lists
|
||||
USE: math
|
||||
USE: stack
|
||||
|
||||
: |+ ( list -- sum )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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> ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -31,8 +31,8 @@
|
|||
!!! 'math' vocabulary instead.
|
||||
|
||||
IN: real-math
|
||||
USE: arithmetic
|
||||
USE: kernel
|
||||
USE: math
|
||||
USE: stack
|
||||
|
||||
: facos ( x -- acos )
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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 . ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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) ;
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 -- ? )
|
||||
|
|
|
@ -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" )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -26,7 +26,7 @@
|
|||
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
IN: stdio
|
||||
USE: arithmetic
|
||||
USE: math
|
||||
USE: stack
|
||||
USE: streams
|
||||
USE: strings
|
||||
|
|
|
@ -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 -- ? )
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: math
|
||||
USE: test
|
||||
|
||||
[ 2000000 [ ] times ] time
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: lists
|
||||
USE: math
|
||||
USE: random
|
||||
USE: stack
|
||||
USE: test
|
||||
|
|
|
@ -1,9 +1,9 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: combinators
|
||||
USE: continuations
|
||||
USE: kernel
|
||||
USE: lists
|
||||
USE: math
|
||||
USE: namespaces
|
||||
USE: stack
|
||||
USE: stdio
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -1,2 +1,2 @@
|
|||
USE: arithmetic
|
||||
USE: math
|
||||
2 2 +
|
|
@ -1,7 +1,7 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: combinators
|
||||
USE: kernel
|
||||
USE: math
|
||||
USE: stack
|
||||
USE: stdio
|
||||
USE: test
|
||||
|
|
|
@ -1,5 +1,4 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: combinators
|
||||
USE: compiler
|
||||
USE: kernel
|
||||
|
|
|
@ -1,5 +1,4 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: combinators
|
||||
USE: compiler
|
||||
USE: inspector
|
||||
|
|
|
@ -1,5 +1,4 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: compiler
|
||||
USE: lists
|
||||
USE: math
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: combinators
|
||||
USE: kernel
|
||||
USE: lists
|
||||
USE: math
|
||||
USE: prettyprint
|
||||
USE: stack
|
||||
USE: stdio
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: compiler
|
||||
USE: lists
|
||||
USE: math
|
||||
USE: stack
|
||||
USE: stdio
|
||||
USE: strings
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: lists
|
||||
USE: math
|
||||
USE: namespaces
|
||||
USE: test
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
USE: arithmetic
|
||||
USE: compiler
|
||||
USE: lists
|
||||
USE: math
|
||||
USE: stack
|
||||
USE: strings
|
||||
USE: test
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: kernel
|
||||
USE: lists
|
||||
USE: logic
|
||||
USE: math
|
||||
USE: namespaces
|
||||
USE: stack
|
||||
USE: test
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: kernel
|
||||
USE: math
|
||||
USE: stack
|
||||
USE: test
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: kernel
|
||||
USE: math
|
||||
USE: stack
|
||||
USE: test
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: kernel
|
||||
USE: math
|
||||
USE: stack
|
||||
USE: test
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -1,5 +1,4 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: kernel
|
||||
USE: math
|
||||
USE: test
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: kernel
|
||||
USE: math
|
||||
USE: stack
|
||||
USE: test
|
||||
USE: unparser
|
||||
|
|
|
@ -1,5 +1,4 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: math
|
||||
USE: test
|
||||
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: compiler
|
||||
USE: kernel
|
||||
USE: math
|
||||
USE: namespaces
|
||||
USE: stack
|
||||
USE: test
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: math
|
||||
USE: parser
|
||||
USE: strings
|
||||
USE: test
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: kernel
|
||||
USE: lists
|
||||
USE: logic
|
||||
USE: math
|
||||
USE: namespaces
|
||||
USE: random
|
||||
USE: stack
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: combinators
|
||||
USE: kernel
|
||||
USE: math
|
||||
USE: namespaces
|
||||
USE: stack
|
||||
USE: strings
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
USE: arithmetic
|
||||
USE: lists
|
||||
USE: kernel
|
||||
USE: math
|
||||
USE: random
|
||||
USE: stack
|
||||
USE: test
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
IN: scratchpad
|
||||
USE: arithmetic
|
||||
USE: math
|
||||
USE: test
|
||||
USE: words
|
||||
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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 )
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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) \
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -1,3 +1,5 @@
|
|||
FILE* debug_fd;
|
||||
|
||||
typedef enum {
|
||||
IO_TASK_READ_LINE,
|
||||
IO_TASK_READ_COUNT,
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
@ -73,7 +73,6 @@ XT primitives[] = {
|
|||
primitive_lesseq,
|
||||
primitive_greater,
|
||||
primitive_greatereq,
|
||||
primitive_gcd,
|
||||
primitive_facos,
|
||||
primitive_fasin,
|
||||
primitive_fatan,
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
extern XT primitives[];
|
||||
#define PRIMITIVE_COUNT 141
|
||||
#define PRIMITIVE_COUNT 140
|
||||
|
||||
CELL primitive_to_xt(CELL primitive);
|
||||
|
|
Loading…
Reference in New Issue