* changing representation for all non-fixnum numbers.
This commit is contained in:
Abdulaziz Ghuloum
parent
783beb990b
commit
1c37a4ee54
|
|
@ -1189,7 +1189,7 @@ chicken-int) NAME='Chicken-int'
|
|||
esac
|
||||
;;
|
||||
|
||||
ikarus) NAME='Ikarus-Scheme'
|
||||
ikarus) NAME='Ikarus'
|
||||
COMP=ikarus_comp
|
||||
COMPOPTS=""
|
||||
EXEC=ikarus_exec
|
||||
|
|
|
|||
|
|
@ -1,585 +0,0 @@
|
|||
|
||||
****************************
|
||||
Benchmarking Ikarus-Scheme-r6rs on Sat Jan 20 19:09:21 EST 2007 under Darwin 10-231-80-30.dhcp-bl.indiana.edu 8.8.3 Darwin Kernel Version 8.8.3: Wed Oct 18 21:57:10 PDT 2006; root:xnu-792.15.4.obj~4/RELEASE_I386 i386 i386
|
||||
|
||||
Testing boyer under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
17 collections
|
||||
1.024s real 1.008s user 0.010s sys
|
||||
72832056 bytes allocated
|
||||
|
||||
Testing browse under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
151 collections
|
||||
2.578s real 2.526s user 0.039s sys
|
||||
633609656 bytes allocated
|
||||
|
||||
Testing cpstak under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
243 collections
|
||||
2.605s real 2.534s user 0.053s sys
|
||||
1017728056 bytes allocated
|
||||
|
||||
Testing ctak under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
127 collections
|
||||
1.363s real 1.118s user 0.236s sys
|
||||
534317320 bytes allocated
|
||||
|
||||
Testing dderiv under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
248 collections
|
||||
1.486s real 1.463s user 0.016s sys
|
||||
1040000056 bytes allocated
|
||||
|
||||
Testing deriv under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
187 collections
|
||||
0.984s real 0.963s user 0.015s sys
|
||||
784000056 bytes allocated
|
||||
|
||||
Testing destruc under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
61 collections
|
||||
3.416s real 3.378s user 0.022s sys
|
||||
257444056 bytes allocated
|
||||
|
||||
Testing diviter under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
191 collections
|
||||
1.973s real 1.944s user 0.017s sys
|
||||
800000056 bytes allocated
|
||||
|
||||
Testing divrec under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
191 collections
|
||||
1.995s real 1.972s user 0.016s sys
|
||||
800000056 bytes allocated
|
||||
|
||||
Testing puzzle under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
17 collections
|
||||
4.453s real 4.426s user 0.017s sys
|
||||
70742488 bytes allocated
|
||||
|
||||
Testing takl under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
no collections
|
||||
1.524s real 1.519s user 0.002s sys
|
||||
48 bytes allocated
|
||||
|
||||
Testing triangl under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
no collections
|
||||
5.408s real 5.387s user 0.007s sys
|
||||
930048 bytes allocated
|
||||
|
||||
Testing fft under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
Error in top-level-value: / is unbound.
|
||||
>
|
||||
|
||||
Testing fib under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
no collections
|
||||
7.563s real 7.531s user 0.010s sys
|
||||
48 bytes allocated
|
||||
|
||||
Testing fibfp under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
Error in <: 35.0 is not a number.
|
||||
>
|
||||
|
||||
Testing mbrot under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
Error in >: 0.4138 is not a number.
|
||||
>
|
||||
|
||||
Testing pnpoly under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
> Error in andmap: vararg not supported yet.
|
||||
>
|
||||
|
||||
Testing sum under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
no collections
|
||||
6.137s real 6.116s user 0.008s sys
|
||||
80048 bytes allocated
|
||||
|
||||
Testing sumfp under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
Error in <: 10000.0 is not a number.
|
||||
>
|
||||
|
||||
Testing tak under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
no collections
|
||||
3.974s real 3.960s user 0.005s sys
|
||||
48 bytes allocated
|
||||
|
||||
Testing ack under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
no collections
|
||||
0.500s real 0.498s user 0.000s sys
|
||||
48 bytes allocated
|
||||
|
||||
Testing array1 under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
40 collections
|
||||
2.139s real 2.094s user 0.039s sys
|
||||
160005672 bytes allocated
|
||||
|
||||
Testing cat under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
no collections
|
||||
0.220s real 0.175s user 0.043s sys
|
||||
34520 bytes allocated
|
||||
|
||||
Testing string under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
10 collections
|
||||
0.303s real 0.291s user 0.011s sys
|
||||
31464952 bytes allocated
|
||||
|
||||
Testing sum1 under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
./bench: line 1400: 29584 Done printf "$REPLCOMMANDS" "$1"
|
||||
29585 Segmentation fault | ikarus
|
||||
|
||||
Testing sumloop under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
no collections
|
||||
5.110s real 5.090s user 0.005s sys
|
||||
64 bytes allocated
|
||||
|
||||
Testing tail under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
18 collections
|
||||
0.567s real 0.478s user 0.087s sys
|
||||
77128368 bytes allocated
|
||||
|
||||
Testing wc under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
no collections
|
||||
0.350s real 0.344s user 0.005s sys
|
||||
12960 bytes allocated
|
||||
|
||||
Testing conform under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
38 collections
|
||||
1.370s real 1.352s user 0.017s sys
|
||||
162415416 bytes allocated
|
||||
|
||||
Testing dynamic under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
11 collections
|
||||
0.618s real 0.604s user 0.013s sys
|
||||
44168760 bytes allocated
|
||||
|
||||
Testing earley under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
Error: BUG in borrow
|
||||
|
||||
Testing fibc under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
80 collections
|
||||
1.468s real 1.320s user 0.146s sys
|
||||
334408904 bytes allocated
|
||||
|
||||
Testing graphs under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
189 collections
|
||||
2.292s real 2.244s user 0.048s sys
|
||||
790269656 bytes allocated
|
||||
|
||||
Testing lattice under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
91 collections
|
||||
1.646s real 1.620s user 0.025s sys
|
||||
381967088 bytes allocated
|
||||
|
||||
Testing matrix under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
Error in top-level-value: modulo is unbound.
|
||||
>
|
||||
|
||||
Testing maze under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
Error in top-level-value: modulo is unbound.
|
||||
>
|
||||
|
||||
Testing mazefun under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
Error in top-level-value: modulo is unbound.
|
||||
>
|
||||
|
||||
Testing nqueens under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
65 collections
|
||||
3.409s real 3.396s user 0.012s sys
|
||||
274320056 bytes allocated
|
||||
|
||||
Testing paraffins under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
198 collections
|
||||
1.478s real 1.192s user 0.285s sys
|
||||
831232056 bytes allocated
|
||||
|
||||
Testing peval under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
36 collections
|
||||
1.026s real 1.012s user 0.013s sys
|
||||
151770008 bytes allocated
|
||||
|
||||
Testing primes under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
Error in top-level-value: modulo is unbound.
|
||||
>
|
||||
|
||||
Testing ray under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
> Error in tokenize: invalid number syntax: 1e.
|
||||
>
|
||||
|
||||
Testing scheme under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
> Error in top-level-value: / is unbound.
|
||||
>
|
||||
|
||||
Testing simplex under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
> Error in tokenize: invalid number syntax: 1e.
|
||||
>
|
||||
|
||||
Testing slatex under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
9 collections
|
||||
1.944s real 0.499s user 0.992s sys
|
||||
36085736 bytes allocated
|
||||
|
||||
Testing perm9 under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
40 collections
|
||||
2.512s real 2.314s user 0.197s sys
|
||||
170498936 bytes allocated
|
||||
|
||||
Testing nboyer under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
49 collections
|
||||
1.562s real 1.551s user 0.009s sys
|
||||
203661656 bytes allocated
|
||||
|
||||
Testing sboyer under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
16 collections
|
||||
1.590s real 1.580s user 0.008s sys
|
||||
66159256 bytes allocated
|
||||
|
||||
Testing gcbench under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
> The garbage collector should touch about 32 megabytes of heap storage.
|
||||
The use of more or less memory will skew the results.
|
||||
|
||||
Garbage Collector Test
|
||||
Stretching memory with a binary tree of depth 18
|
||||
Total memory available= ???????? bytes Free memory= ???????? bytes
|
||||
GCBench: Main
|
||||
Creating a long-lived binary tree of depth 16
|
||||
Creating a long-lived array of 524284 inexact reals
|
||||
Error in top-level-value: / is unbound.
|
||||
>
|
||||
|
||||
Testing parsing under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
>
|
||||
running stats for (run-bench name count ok? run):
|
||||
41 collections
|
||||
4.876s real 4.859s user 0.017s sys
|
||||
171456072 bytes allocated
|
||||
|
||||
Testing gcold under Ikarus-Scheme-r6rs
|
||||
Compiling...
|
||||
Running...
|
||||
Ikarus Scheme (Build 2007-01-20)
|
||||
Copyright (c) 2006-2007 Abdulaziz Ghuloum
|
||||
|
||||
> Error in top-level-value: gcold is unbound.
|
||||
>
|
||||
|
|
@ -193,7 +193,7 @@
|
|||
(do ((i 0 (+ i 1)))
|
||||
((>= i ntrees))
|
||||
(vector-set! trees i (makeTree treeHeight))
|
||||
(doYoungGenAlloc (* promoteRate ntrees treesize) words/dead))
|
||||
(doYoungGenAlloc (* promoteRate ntrees treeSize) words/dead))
|
||||
(println " (" nodes " nodes)")))
|
||||
|
||||
; Confirms that all trees are balanced and have the correct height.
|
||||
|
|
@ -381,4 +381,4 @@
|
|||
(+ mutatorSum (vector-length aexport))))
|
||||
|
||||
(define (main . args)
|
||||
(gcold 25 0 10 10 gcold-iters))
|
||||
(GCOld 25 0 10 10 gcold-iters))
|
||||
|
|
|
|||
|
|
@ -9,13 +9,15 @@
|
|||
(string-append in setting)
|
||||
(string-append out setting))))))
|
||||
|
||||
((summarize bigloo-results) "results.Bigloo" "summary.Bigloo")
|
||||
((summarize chez-results) "results.Chez-Scheme" "summary.Chez")
|
||||
((summarize chicken-results) "results.Chicken" "summary.Chicken")
|
||||
((summarize gambit-results) "results.Gambit-C" "summary.Gambit")
|
||||
;((summarize bigloo-results) "results.Bigloo" "summary.Bigloo")
|
||||
;((summarize chez-results) "results.Chez-Scheme" "summary.Chez")
|
||||
((summarize ikarus-results) "results.Ikarus-Scheme" "summary.Ikarus")
|
||||
;((summarize chicken-results) "results.Chicken" "summary.Chicken")
|
||||
;((summarize gambit-results) "results.Gambit-C" "summary.Gambit")
|
||||
((summarize larceny-results) "results.Larceny" "summary.Larceny")
|
||||
((summarize mzscheme-results) "results.MzScheme" "summary.MzScheme")
|
||||
((summarize scheme48-results) "results.Scheme48" "summary.Scheme48")))
|
||||
;((summarize mzscheme-results) "results.MzScheme" "summary.MzScheme")
|
||||
;((summarize scheme48-results) "results.Scheme48" "summary.Scheme48")
|
||||
))
|
||||
|
||||
(define (decode-usual-suspects . rest)
|
||||
(let* ((setting (if (null? rest) "-r6rs" (car rest)))
|
||||
|
|
@ -24,12 +26,14 @@
|
|||
(decode-summary (string-append in setting)))))
|
||||
(map decode-summary
|
||||
'("summary.Larceny"
|
||||
"summary.Bigloo"
|
||||
"summary.Chez"
|
||||
"summary.Chicken"
|
||||
"summary.Gambit"
|
||||
"summary.MzScheme"
|
||||
"summary.Scheme48"))))
|
||||
;"summary.Bigloo"
|
||||
;"summary.Chez"
|
||||
;"summary.Chicken"
|
||||
;"summary.Gambit"
|
||||
"summary.Ikarus"
|
||||
;"summary.MzScheme"
|
||||
;"summary.Scheme48"
|
||||
))))
|
||||
|
||||
(define (summarize-usual-suspects-linux . rest)
|
||||
(let* ((setting (if (null? rest) "-r6rs" (car rest)))
|
||||
|
|
@ -47,6 +51,7 @@
|
|||
((summarize larceny-results) "results.Larceny" "summary.Larceny")
|
||||
((summarize mit-results) "results.MIT-Scheme" "summary.MIT")
|
||||
((summarize mzscheme-results) "results.MzScheme" "summary.MzScheme")
|
||||
((summarize ikarus-results) "results.Ikarus" "summary.Ikarus")
|
||||
((summarize petite-chez-results) "results.Petite-Chez-Scheme" "summary.Petite")
|
||||
((summarize scheme48-results) "results.Scheme48" "summary.Scheme48")))
|
||||
|
||||
|
|
@ -58,13 +63,15 @@
|
|||
(map decode-summary
|
||||
'(;"summary.Henchman"
|
||||
"summary.Larceny"
|
||||
"summary.Bigloo"
|
||||
"summary.Chicken"
|
||||
"summary.Gambit"
|
||||
"summary.MIT"
|
||||
"summary.MzScheme"
|
||||
"summary.Petite"
|
||||
"summary.Scheme48"))))
|
||||
;"summary.Bigloo"
|
||||
;"summary.Chicken"
|
||||
;"summary.Gambit"
|
||||
"summary.Ikarus"
|
||||
;"summary.MIT"
|
||||
;"summary.MzScheme"
|
||||
;"summary.Petite"
|
||||
;"summary.Scheme48"
|
||||
))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;
|
||||
|
|
@ -356,7 +363,7 @@
|
|||
(display (make-string name-width #\space) out)))
|
||||
(loop (cdr lines) real)))))))
|
||||
|
||||
; Chez Scheme.
|
||||
; Chez and Ikarus Scheme.
|
||||
|
||||
(define (chez-results lines out)
|
||||
(chez-results-proto "Chez-Scheme" lines out))
|
||||
|
|
@ -364,6 +371,9 @@
|
|||
(define (petite-chez-results lines out)
|
||||
(chez-results-proto "Petite-Chez-Scheme" lines out))
|
||||
|
||||
(define (ikarus-results lines out)
|
||||
(chez-results-proto "Ikarus" lines out))
|
||||
|
||||
(define (chez-results-proto sysname lines out)
|
||||
(let ((system-key "Benchmarking ")
|
||||
(test-key "Testing ")
|
||||
|
|
@ -371,7 +381,7 @@
|
|||
(cpu-key " ms elapsed cpu time")
|
||||
(real-key " ms elapsed real time")
|
||||
(space-key " ")
|
||||
(error-key "Error: ")
|
||||
(error-key "Error")
|
||||
(wrong-key "*** wrong result ***"))
|
||||
(let ((n-system-key (string-length system-key))
|
||||
(n-test-key (string-length test-key))
|
||||
|
|
@ -407,17 +417,18 @@
|
|||
(let ((x (substring line
|
||||
n-space-key
|
||||
(substring? real-key line))))
|
||||
(right-justify x timing-width out)
|
||||
(newline out)))
|
||||
(right-justify x timing-width out)))
|
||||
((substring=? error-key line 0 n-error-key)
|
||||
(display line out)
|
||||
(newline out)
|
||||
(display (make-string name-width #\space) out))
|
||||
;(newline out)
|
||||
;(display (make-string name-width #\space) out)
|
||||
)
|
||||
((substring=? wrong-key line 0 n-wrong-key)
|
||||
(display " " out)
|
||||
(display line out)
|
||||
(newline out)
|
||||
(display (make-string name-width #\space) out)))
|
||||
;(flush-output-port out)
|
||||
(loop (cdr lines))))))))
|
||||
|
||||
; Larceny
|
||||
|
|
|
|||
BIN
bin/ikarus
BIN
bin/ikarus
Binary file not shown.
|
|
@ -1053,6 +1053,14 @@ add_object_proc(gc_t* gc, ikp x)
|
|||
ref(x, wordsize-vector_tag) = new;
|
||||
return new;
|
||||
}
|
||||
else if(fst == flonum_tag){
|
||||
ikp new = gc_alloc_new_data(flonum_size, gen, gc) + vector_tag;
|
||||
ref(new, -vector_tag) = flonum_tag;
|
||||
flonum_data(new) = flonum_data(x);
|
||||
ref(x, -vector_tag) = forward_ptr;
|
||||
ref(x, wordsize-vector_tag) = new;
|
||||
return new;
|
||||
}
|
||||
else {
|
||||
fprintf(stderr, "unhandled vector with fst=0x%08x\n", (int)fst);
|
||||
exit(-1);
|
||||
|
|
|
|||
|
|
@ -196,9 +196,10 @@
|
|||
#define disp_bignum_data wordsize
|
||||
#define off_bignum_data (disp_bignum_data - vector_tag)
|
||||
|
||||
#define flonum_tag ((ikp)0xFF)
|
||||
#define flonum_tag ((ikp)0x6F)
|
||||
#define flonum_size 16
|
||||
#define disp_flonum_data 8
|
||||
#define off_flonum_data (disp_flonum_data - vector_tag)
|
||||
#define flonum_data(x) (*((double*)(((ikp)(x))+off_flonum_data)))
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -0,0 +1,154 @@
|
|||
|
||||
#include "ikarus.h"
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <errno.h>
|
||||
#include <math.h>
|
||||
|
||||
|
||||
ikp
|
||||
ikrt_is_flonum(ikp x){
|
||||
if(tagof(x) == vector_tag){
|
||||
if (ref(x, -vector_tag) == flonum_tag){
|
||||
return true_object;
|
||||
}
|
||||
}
|
||||
return false_object;
|
||||
}
|
||||
|
||||
ikp
|
||||
ikrt_string_to_flonum(ikp x, ikpcb* pcb){
|
||||
double v = strtod(string_data(x), NULL);
|
||||
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
||||
ref(r, -vector_tag) = (ikp)flonum_tag;
|
||||
flonum_data(r) = v;
|
||||
return r;
|
||||
}
|
||||
|
||||
ikp
|
||||
ikrt_fl_plus(ikp x, ikp y,ikpcb* pcb){
|
||||
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
||||
ref(r, -vector_tag) = (ikp)flonum_tag;
|
||||
flonum_data(r) = flonum_data(x) + flonum_data(y);
|
||||
return r;
|
||||
}
|
||||
|
||||
ikp
|
||||
ikrt_fl_minus(ikp x, ikp y,ikpcb* pcb){
|
||||
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
||||
ref(r, -vector_tag) = (ikp)flonum_tag;
|
||||
flonum_data(r) = flonum_data(x) - flonum_data(y);
|
||||
return r;
|
||||
}
|
||||
|
||||
ikp
|
||||
ikrt_fl_times(ikp x, ikp y,ikpcb* pcb){
|
||||
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
||||
ref(r, -vector_tag) = (ikp)flonum_tag;
|
||||
flonum_data(r) = flonum_data(x) * flonum_data(y);
|
||||
return r;
|
||||
}
|
||||
|
||||
ikp
|
||||
ikrt_fl_div(ikp x, ikp y,ikpcb* pcb){
|
||||
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
||||
ref(r, -vector_tag) = (ikp)flonum_tag;
|
||||
flonum_data(r) = flonum_data(x) / flonum_data(y);
|
||||
return r;
|
||||
}
|
||||
|
||||
ikp
|
||||
ikrt_fl_invert(ikp x, ikpcb* pcb){
|
||||
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
||||
ref(r, -vector_tag) = (ikp)flonum_tag;
|
||||
flonum_data(r) = 1.0 / flonum_data(x);
|
||||
return r;
|
||||
}
|
||||
|
||||
ikp
|
||||
ikrt_fl_sin(ikp x, ikpcb* pcb){
|
||||
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
||||
ref(r, -vector_tag) = (ikp)flonum_tag;
|
||||
flonum_data(r) = sin(flonum_data(x));
|
||||
return r;
|
||||
}
|
||||
|
||||
ikp
|
||||
ikrt_fx_sin(ikp x, ikpcb* pcb){
|
||||
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
||||
ref(r, -vector_tag) = (ikp)flonum_tag;
|
||||
flonum_data(r) = sin(unfix(x));
|
||||
return r;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
ikp
|
||||
ikrt_flonum_to_string(ikp x, ikpcb* pcb){
|
||||
if(tagof(x) == vector_tag){
|
||||
if(ref(x,-vector_tag) == flonum_tag){
|
||||
char buff[80];
|
||||
int n = snprintf(buff, sizeof(buff)-2, "%.12G", flonum_data(x));
|
||||
if(n >= 0){
|
||||
int i=0;
|
||||
while ((i<n) && (buff[i] != '.')){ i++; }
|
||||
if(i == n){
|
||||
buff[i] = '.';
|
||||
buff[i+1] = '0';
|
||||
n += 2;;
|
||||
}
|
||||
ikp str = ik_alloc(pcb, align(n+disp_string_data+1)) +
|
||||
string_tag;
|
||||
ref(str, -string_tag) = fix(n);
|
||||
memcpy(string_data(str), buff, n);
|
||||
return str;
|
||||
}
|
||||
}
|
||||
}
|
||||
return false_object;
|
||||
}
|
||||
|
||||
ikp
|
||||
ikrt_fixnum_to_flonum(ikp x, ikpcb* pcb){
|
||||
ikp r = ik_alloc(pcb, flonum_size) + vector_tag;
|
||||
ref(r, -vector_tag) = (ikp)flonum_tag;
|
||||
flonum_data(r) = unfix(x);
|
||||
return r;
|
||||
}
|
||||
|
||||
ikp
|
||||
ikrt_bignum_to_flonum(ikp x, ikpcb* pcb){
|
||||
fprintf(stderr, "ERR in bignum_to_flonum\n");
|
||||
exit(-1);
|
||||
}
|
||||
|
||||
ikp
|
||||
ikrt_fl_equal(ikp x, ikp y){
|
||||
if(flonum_data(x) == flonum_data(y)){
|
||||
return true_object;
|
||||
} else {
|
||||
return false_object;
|
||||
}
|
||||
}
|
||||
|
||||
ikp
|
||||
ikrt_fl_less_or_equal(ikp x, ikp y){
|
||||
if(flonum_data(x) <= flonum_data(y)){
|
||||
return true_object;
|
||||
} else {
|
||||
return false_object;
|
||||
}
|
||||
}
|
||||
|
||||
ikp
|
||||
ikrt_fl_less(ikp x, ikp y){
|
||||
if(flonum_data(x) < flonum_data(y)){
|
||||
return true_object;
|
||||
} else {
|
||||
return false_object;
|
||||
}
|
||||
}
|
||||
|
|
@ -11,6 +11,56 @@
|
|||
|
||||
#define max_digits_per_limb 10
|
||||
|
||||
static ikp
|
||||
verify_bignum(ikp x, char* caller){
|
||||
if(tagof(x) != vector_tag){
|
||||
fprintf(stderr, "Error in (%s) invalid primary tag %p\n", caller, x);
|
||||
exit(-1);
|
||||
}
|
||||
ikp fst = ref(x, -vector_tag);
|
||||
int limb_count = ((unsigned int) fst) >> bignum_length_shift;
|
||||
if(limb_count <= 0){
|
||||
fprintf(stderr,
|
||||
"Error in (%s) invalid limb count in fst=0x%08x\n",
|
||||
caller, (int)fst);
|
||||
exit(-1);
|
||||
}
|
||||
int pos;
|
||||
if((int)fst & bignum_sign_mask){
|
||||
pos = 0;
|
||||
} else {
|
||||
pos = 1;
|
||||
}
|
||||
unsigned int last_limb =
|
||||
(unsigned int) ref(x, off_bignum_data + (limb_count - 1) * wordsize);
|
||||
if(last_limb == 0){
|
||||
fprintf(stderr,
|
||||
"Error in (%s) invalid last limb = 0x%08x", caller, last_limb);
|
||||
exit(-1);
|
||||
}
|
||||
if(limb_count == 1){
|
||||
if(pos){
|
||||
if(last_limb <= most_positive_fixnum){
|
||||
fprintf(stderr,
|
||||
"Error in (%s) should be a positive fixnum: 0x%08x\n",
|
||||
caller, last_limb);
|
||||
exit(-1);
|
||||
}
|
||||
} else {
|
||||
if(last_limb <= most_negative_fixnum){
|
||||
fprintf(stderr,
|
||||
"Error in (%s) should be a negative fixnum: 0x%08x\n",
|
||||
caller, last_limb);
|
||||
exit(-1);
|
||||
}
|
||||
}
|
||||
}
|
||||
/* ok */
|
||||
return x;
|
||||
}
|
||||
|
||||
#define BN(x) verify_bignum(x,"BN")
|
||||
|
||||
ikp
|
||||
ikrt_isbignum(ikp x){
|
||||
if(tagof(x) == vector_tag){
|
||||
|
|
@ -66,7 +116,7 @@ ikrt_fxfxplus(ikp x, ikp y, ikpcb* pcb){
|
|||
(1 << bignum_sign_shift));
|
||||
ref(bn, disp_bignum_data) = (ikp)-r;
|
||||
}
|
||||
return bn+vector_tag;
|
||||
return verify_bignum(bn+vector_tag, "fxfx+");
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -90,16 +140,17 @@ ikrt_fxbnplus(ikp x, ikp y, ikpcb* pcb){
|
|||
(((limb_count + 1) << bignum_length_shift) |
|
||||
(0 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag, "fxbn+1");
|
||||
} else {
|
||||
ref(r, 0) = (ikp)
|
||||
((limb_count << bignum_length_shift) |
|
||||
(0 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag, "fxbn+2");
|
||||
}
|
||||
}
|
||||
else {
|
||||
fprintf(stderr, "this case 0x%08x\n", intx);
|
||||
/* positive fx + negative bn = smaller negative bn */
|
||||
ikp r = ik_alloc(pcb, align(disp_bignum_data+limb_count*wordsize));
|
||||
int borrow = mpn_sub_1((mp_limb_t*)(r+disp_bignum_data),
|
||||
|
|
@ -107,7 +158,7 @@ ikrt_fxbnplus(ikp x, ikp y, ikpcb* pcb){
|
|||
limb_count,
|
||||
intx);
|
||||
if(borrow){
|
||||
fprintf(stderr, "Error: BUG in borrow\n");
|
||||
fprintf(stderr, "Error: BUG in borrow1 %d\n", borrow);
|
||||
exit(-1);
|
||||
}
|
||||
int result_size =
|
||||
|
|
@ -128,7 +179,7 @@ ikrt_fxbnplus(ikp x, ikp y, ikpcb* pcb){
|
|||
((result_size << bignum_length_shift) |
|
||||
(1 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag, "fxbn+3");
|
||||
}
|
||||
}
|
||||
else {
|
||||
|
|
@ -140,7 +191,7 @@ ikrt_fxbnplus(ikp x, ikp y, ikpcb* pcb){
|
|||
limb_count,
|
||||
- intx);
|
||||
if(borrow){
|
||||
fprintf(stderr, "Error: BUG in borrow\n");
|
||||
fprintf(stderr, "Error: BUG in borrow2\n");
|
||||
exit(-1);
|
||||
}
|
||||
int result_size =
|
||||
|
|
@ -161,7 +212,7 @@ ikrt_fxbnplus(ikp x, ikp y, ikpcb* pcb){
|
|||
((result_size << bignum_length_shift) |
|
||||
(0 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag, "fxbn+4");
|
||||
} else {
|
||||
/* negative fx + negative bn = larger negative */
|
||||
ikp r = ik_alloc(pcb, align(disp_bignum_data+(limb_count+1)*wordsize));
|
||||
|
|
@ -175,13 +226,13 @@ ikrt_fxbnplus(ikp x, ikp y, ikpcb* pcb){
|
|||
(((limb_count + 1) << bignum_length_shift) |
|
||||
(1 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag, "fxbn+5");
|
||||
} else {
|
||||
ref(r, 0) = (ikp)
|
||||
((limb_count << bignum_length_shift) |
|
||||
(1 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag, "fxbn+5");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -218,13 +269,13 @@ ikrt_bnbnplus(ikp x, ikp y, ikpcb* pcb){
|
|||
(((n1+1) << bignum_length_shift) |
|
||||
xsign |
|
||||
bignum_tag);
|
||||
return res+vector_tag;
|
||||
return verify_bignum(res+vector_tag, "bnbn+1");
|
||||
} else {
|
||||
ref(res, 0) = (ikp)
|
||||
((n1 << bignum_length_shift) |
|
||||
xsign |
|
||||
bignum_tag);
|
||||
return res+vector_tag;
|
||||
return verify_bignum(res+vector_tag, "bnbn+2");
|
||||
}
|
||||
}
|
||||
else {
|
||||
|
|
@ -283,7 +334,7 @@ ikrt_bnbnplus(ikp x, ikp y, ikpcb* pcb){
|
|||
((len << bignum_length_shift) |
|
||||
result_sign |
|
||||
bignum_tag);
|
||||
return res+vector_tag;
|
||||
return verify_bignum(res+vector_tag, "bnbn+3");
|
||||
} else {
|
||||
/* negative result */
|
||||
if(len == 1){
|
||||
|
|
@ -296,7 +347,7 @@ ikrt_bnbnplus(ikp x, ikp y, ikpcb* pcb){
|
|||
((len << bignum_length_shift) |
|
||||
result_sign |
|
||||
bignum_tag);
|
||||
return res+vector_tag;
|
||||
return verify_bignum(res+vector_tag, "bnbn+4");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -316,11 +367,12 @@ ikrt_fxfxminus(ikp x, ikp y, ikpcb* pcb){
|
|||
ikp bn = ik_alloc(pcb, align(disp_bignum_data + wordsize));
|
||||
ref(bn, 0) = (ikp) (bignum_tag | (1 << bignum_length_shift));
|
||||
ref(bn, disp_bignum_data) = (ikp)r;
|
||||
return bn+vector_tag;
|
||||
return verify_bignum(bn+vector_tag,"fxfx-1");
|
||||
}
|
||||
} else {
|
||||
if(((unsigned int)r) <= most_negative_fixnum){
|
||||
return fix(r);
|
||||
ikp fxr = fix(r);
|
||||
if(unfix(fxr) == r){
|
||||
return fxr;
|
||||
} else {
|
||||
ikp bn = ik_alloc(pcb, align(disp_bignum_data + wordsize));
|
||||
ref(bn, 0) = (ikp)
|
||||
|
|
@ -328,7 +380,7 @@ ikrt_fxfxminus(ikp x, ikp y, ikpcb* pcb){
|
|||
(1 << bignum_sign_shift) |
|
||||
(1 << bignum_length_shift));
|
||||
ref(bn, disp_bignum_data) = (ikp)(-r);
|
||||
return bn+vector_tag;
|
||||
return verify_bignum(bn+vector_tag, "fxfx-2");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -355,7 +407,7 @@ ikrt_bnnegate(ikp x, ikpcb* pcb){
|
|||
(bignum_tag |
|
||||
((1 << bignum_sign_shift) - (bignum_sign_mask & (int)fst)) |
|
||||
(limb_count << bignum_length_shift));
|
||||
return bn+vector_tag;
|
||||
return verify_bignum(bn+vector_tag, "bnneg");
|
||||
}
|
||||
|
||||
ikp
|
||||
|
|
@ -378,13 +430,13 @@ ikrt_fxbnminus(ikp x, ikp y, ikpcb* pcb){
|
|||
(((limb_count + 1) << bignum_length_shift) |
|
||||
(0 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag, "fxbn-1");
|
||||
} else {
|
||||
ref(r, 0) = (ikp)
|
||||
((limb_count << bignum_length_shift) |
|
||||
(0 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag, "fxbn-2");
|
||||
}
|
||||
}
|
||||
else {
|
||||
|
|
@ -395,7 +447,7 @@ ikrt_fxbnminus(ikp x, ikp y, ikpcb* pcb){
|
|||
limb_count,
|
||||
intx);
|
||||
if(borrow){
|
||||
fprintf(stderr, "Error: BUG in borrow\n");
|
||||
fprintf(stderr, "Error: BUG in borrow3\n");
|
||||
exit(-1);
|
||||
}
|
||||
int result_size =
|
||||
|
|
@ -416,7 +468,7 @@ ikrt_fxbnminus(ikp x, ikp y, ikpcb* pcb){
|
|||
((result_size << bignum_length_shift) |
|
||||
(1 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag, "fxbn-");
|
||||
}
|
||||
}
|
||||
else {
|
||||
|
|
@ -428,7 +480,7 @@ ikrt_fxbnminus(ikp x, ikp y, ikpcb* pcb){
|
|||
limb_count,
|
||||
- intx);
|
||||
if(borrow){
|
||||
fprintf(stderr, "Error: BUG in borrow\n");
|
||||
fprintf(stderr, "Error: BUG in borrow4\n");
|
||||
exit(-1);
|
||||
}
|
||||
int result_size =
|
||||
|
|
@ -449,7 +501,7 @@ ikrt_fxbnminus(ikp x, ikp y, ikpcb* pcb){
|
|||
((result_size << bignum_length_shift) |
|
||||
(0 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag,"fxbn-");
|
||||
} else {
|
||||
/* negative fx - positive bn = larger negative */
|
||||
ikp r = ik_alloc(pcb, align(disp_bignum_data+(limb_count+1)*wordsize));
|
||||
|
|
@ -463,13 +515,13 @@ ikrt_fxbnminus(ikp x, ikp y, ikpcb* pcb){
|
|||
(((limb_count + 1) << bignum_length_shift) |
|
||||
(1 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag, "fxbn-");
|
||||
} else {
|
||||
ref(r, 0) = (ikp)
|
||||
((limb_count << bignum_length_shift) |
|
||||
(1 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag, "fxbn-");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -495,13 +547,13 @@ ikrt_bnfxminus(ikp x, ikp y, ikpcb* pcb){
|
|||
(((limb_count + 1) << bignum_length_shift) |
|
||||
(0 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag,"bnfx-");
|
||||
} else {
|
||||
ref(r, 0) = (ikp)
|
||||
((limb_count << bignum_length_shift) |
|
||||
(0 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag,"bnfx-");
|
||||
}
|
||||
}
|
||||
else {
|
||||
|
|
@ -512,7 +564,7 @@ ikrt_bnfxminus(ikp x, ikp y, ikpcb* pcb){
|
|||
limb_count,
|
||||
-inty);
|
||||
if(borrow){
|
||||
fprintf(stderr, "Error: BUG in borrow\n");
|
||||
fprintf(stderr, "Error: BUG in borrow5\n");
|
||||
exit(-1);
|
||||
}
|
||||
int result_size =
|
||||
|
|
@ -533,7 +585,7 @@ ikrt_bnfxminus(ikp x, ikp y, ikpcb* pcb){
|
|||
((result_size << bignum_length_shift) |
|
||||
(1 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag,"bnfx-");
|
||||
}
|
||||
}
|
||||
else {
|
||||
|
|
@ -545,7 +597,7 @@ ikrt_bnfxminus(ikp x, ikp y, ikpcb* pcb){
|
|||
limb_count,
|
||||
inty);
|
||||
if(borrow){
|
||||
fprintf(stderr, "Error: BUG in borrow\n");
|
||||
fprintf(stderr, "Error: BUG in borrow6\n");
|
||||
exit(-1);
|
||||
}
|
||||
int result_size =
|
||||
|
|
@ -566,7 +618,7 @@ ikrt_bnfxminus(ikp x, ikp y, ikpcb* pcb){
|
|||
((result_size << bignum_length_shift) |
|
||||
(0 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag, "bnfx-");
|
||||
} else {
|
||||
/* - positive fx + negative bn = larger negative */
|
||||
ikp r = ik_alloc(pcb, align(disp_bignum_data+(limb_count+1)*wordsize));
|
||||
|
|
@ -580,13 +632,13 @@ ikrt_bnfxminus(ikp x, ikp y, ikpcb* pcb){
|
|||
(((limb_count + 1) << bignum_length_shift) |
|
||||
(1 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag, "bnfx-");
|
||||
} else {
|
||||
ref(r, 0) = (ikp)
|
||||
((limb_count << bignum_length_shift) |
|
||||
(1 << bignum_sign_shift) |
|
||||
bignum_tag);
|
||||
return r+vector_tag;
|
||||
return verify_bignum(r+vector_tag, "bnfx-");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -623,13 +675,13 @@ ikrt_bnbnminus(ikp x, ikp y, ikpcb* pcb){
|
|||
(((n1+1) << bignum_length_shift) |
|
||||
xsign |
|
||||
bignum_tag);
|
||||
return res+vector_tag;
|
||||
return verify_bignum(res+vector_tag, "bnbn-");
|
||||
} else {
|
||||
ref(res, 0) = (ikp)
|
||||
((n1 << bignum_length_shift) |
|
||||
xsign |
|
||||
bignum_tag);
|
||||
return res+vector_tag;
|
||||
return verify_bignum(res+vector_tag, "bnbn-");
|
||||
}
|
||||
}
|
||||
else {
|
||||
|
|
@ -690,7 +742,7 @@ ikrt_bnbnminus(ikp x, ikp y, ikpcb* pcb){
|
|||
((len << bignum_length_shift) |
|
||||
result_sign |
|
||||
bignum_tag);
|
||||
return res+vector_tag;
|
||||
return verify_bignum(res+vector_tag, "bnbn-");
|
||||
} else {
|
||||
/* negative result */
|
||||
if(len == 1){
|
||||
|
|
@ -703,7 +755,7 @@ ikrt_bnbnminus(ikp x, ikp y, ikpcb* pcb){
|
|||
((len << bignum_length_shift) |
|
||||
result_sign |
|
||||
bignum_tag);
|
||||
return res+vector_tag;
|
||||
return verify_bignum(res+vector_tag, "bnbn-");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -742,7 +794,7 @@ ikrt_fxfxmult(ikp x, ikp y, ikpcb* pcb){
|
|||
(sign << bignum_sign_shift) |
|
||||
(1 << bignum_length_shift));
|
||||
ref(r, disp_bignum_data) = (ikp)lo;
|
||||
return r+vector_tag;
|
||||
return BN(r+vector_tag);
|
||||
} else {
|
||||
ikp r = ik_alloc(pcb, align(disp_bignum_data + 2*wordsize));
|
||||
ref(r, 0) = (ikp)
|
||||
|
|
@ -751,7 +803,7 @@ ikrt_fxfxmult(ikp x, ikp y, ikpcb* pcb){
|
|||
(2 << bignum_length_shift));
|
||||
ref(r, disp_bignum_data) = (ikp)lo;
|
||||
ref(r, disp_bignum_data+wordsize) = (ikp)hi;
|
||||
return r+vector_tag;
|
||||
return BN(r+vector_tag);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -777,7 +829,7 @@ normalize_bignum(int limbs, int sign, ikp r){
|
|||
(bignum_tag |
|
||||
sign |
|
||||
(limbs << bignum_length_shift));
|
||||
return r+vector_tag;
|
||||
return BN(r+vector_tag);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -926,7 +978,7 @@ ikrt_fxbnlogand(ikp x, ikp y, ikpcb* pcb){
|
|||
ref(r, disp_bignum_data+i*wordsize) =
|
||||
ref(y, disp_bignum_data-vector_tag+i*wordsize);
|
||||
}
|
||||
return r+vector_tag;
|
||||
return BN(r+vector_tag);
|
||||
} else {
|
||||
/* y is positive */
|
||||
int len = (((unsigned int) fst) >> bignum_length_shift);
|
||||
|
|
@ -939,7 +991,7 @@ ikrt_fxbnlogand(ikp x, ikp y, ikpcb* pcb){
|
|||
ref(r, disp_bignum_data+i*wordsize) =
|
||||
ref(y, disp_bignum_data-vector_tag+i*wordsize);
|
||||
}
|
||||
return r+vector_tag;
|
||||
return BN(r+vector_tag);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
|
@ -1469,6 +1469,29 @@ reference-implementation:
|
|||
(f a)
|
||||
(error who "list was altered"))]
|
||||
[else (error who "list was altered")])))
|
||||
(define andmap2
|
||||
(lambda (f a1 a2 d1 d2 n)
|
||||
(cond
|
||||
[(pair? d1)
|
||||
(cond
|
||||
[(pair? d2)
|
||||
(if ($fxzero? n)
|
||||
(error who "list was altered")
|
||||
(and
|
||||
(f a1 a2)
|
||||
(andmap2 f
|
||||
($car d1) ($car d2)
|
||||
($cdr d1) ($cdr d2)
|
||||
($fxsub1 n))))]
|
||||
[else (error who "length mismatch")])]
|
||||
[(null? d1)
|
||||
(cond
|
||||
[(null? d2)
|
||||
(if ($fxzero? n)
|
||||
(f a1 a2)
|
||||
(error who "list was altered"))]
|
||||
[else (error who "length mismatch")])]
|
||||
[else (error who "list was altered")])))
|
||||
(primitive-set! 'andmap
|
||||
(case-lambda
|
||||
[(f ls)
|
||||
|
|
@ -1480,7 +1503,23 @@ reference-implementation:
|
|||
(andmap1 f ($car ls) d (len d d 0)))]
|
||||
[(null? ls) #t]
|
||||
[else (error who "improper list")])]
|
||||
[_ (error who "vararg not supported yet")])))
|
||||
[(f ls ls2)
|
||||
(unless (procedure? f)
|
||||
(error who "~s is not a procedure" f))
|
||||
(cond
|
||||
[(pair? ls)
|
||||
(if (pair? ls2)
|
||||
(let ([d ($cdr ls)])
|
||||
(andmap2 f
|
||||
($car ls) ($car ls2) d ($cdr ls2) (len d d 0)))
|
||||
(error who "length mismatch"))]
|
||||
[(null? ls)
|
||||
(if (null? ls2)
|
||||
#t
|
||||
(error who "length mismatch"))]
|
||||
[else (error who "not a list")])]
|
||||
[(f . ls*) (error who "vararg not supported yet in ~s"
|
||||
(length ls*))])))
|
||||
|
||||
|
||||
(let ()
|
||||
|
|
|
|||
|
|
@ -226,6 +226,36 @@
|
|||
[(null? e*) ac]
|
||||
[else (f (binary* ac (car e*)) (cdr e*))]))]))
|
||||
|
||||
(define binary/
|
||||
(lambda (x y)
|
||||
(cond
|
||||
[(flonum? x)
|
||||
(cond
|
||||
[(flonum? y)
|
||||
(foreign-call "ikrt_fl_div" x y)]
|
||||
[(fixnum? y)
|
||||
(foreign-call "ikrt_fl_div" x (fixnum->flonum y))]
|
||||
[else (error '/ "unspported ~s ~s" x y)])]
|
||||
[(fixnum? x)
|
||||
(cond
|
||||
[(flonum? y)
|
||||
(foreign-call "ikrt_fl_div" (fixnum->flonum x) y)]
|
||||
[else (error '/ "unsupported ~s ~s" x y)])]
|
||||
[else (error '/ "unsupported ~s ~s" x y)])))
|
||||
|
||||
(define /
|
||||
(case-lambda
|
||||
[(x y) (binary/ x y)]
|
||||
[(x)
|
||||
(cond
|
||||
[(flonum? x) (foreign-call "ikrt_fl_invert" x)]
|
||||
[else (error '/ "unspported argument ~s" x)])]
|
||||
[(x y z . rest)
|
||||
(let f ([a (binary/ x y)] [b z] [ls rest])
|
||||
(cond
|
||||
[(null? rest) (binary/ a b)]
|
||||
[else (f (binary/ a b) (car ls) (cdr ls))]))]))
|
||||
|
||||
(define expt
|
||||
(lambda (n m)
|
||||
(cond
|
||||
|
|
@ -377,9 +407,19 @@
|
|||
[(flonum? x) (foreign-call "ikrt_flonum_to_string" x)]
|
||||
[else (error 'number->string "~s is not a number" x)])))
|
||||
|
||||
(define modulo
|
||||
(lambda (n m)
|
||||
(cond
|
||||
[(fixnum? n)
|
||||
(cond
|
||||
[(fixnum? m) ($fxmodulo n m)]
|
||||
[else (error 'modulo "unsupported ~s" m)])]
|
||||
[else (error 'modulo "unsupported ~s" n)])))
|
||||
|
||||
(define-syntax mk<
|
||||
(syntax-rules ()
|
||||
[(_ name fxfx< fxbn< bnfx< bnbn<)
|
||||
[(_ name fxfx< fxbn< bnfx< bnbn<
|
||||
fxfl< flfx< bnfl< flbn< flfl<)
|
||||
(let ()
|
||||
(define err
|
||||
(lambda (x) (error 'name "~s is not a number" x)))
|
||||
|
|
@ -398,6 +438,12 @@
|
|||
(if (fxbn< x y)
|
||||
(bnloopt y (car ls) (cdr ls))
|
||||
(loopf (car ls) (cdr ls))))]
|
||||
[(flonum? y)
|
||||
(if (null? ls)
|
||||
(fxfl< x y)
|
||||
(if (fxfl< x y)
|
||||
(flloopt y (car ls) (cdr ls))
|
||||
(loopf (car ls) (cdr ls))))]
|
||||
[else (err y)])))
|
||||
(define bnloopt
|
||||
(lambda (x y ls)
|
||||
|
|
@ -414,6 +460,34 @@
|
|||
(if (bnbn< x y)
|
||||
(bnloopt y (car ls) (cdr ls))
|
||||
(loopf (car ls) (cdr ls))))]
|
||||
[(flonum? y)
|
||||
(if (null? ls)
|
||||
(bnfl< x y)
|
||||
(if (bnfl< x y)
|
||||
(flloopt y (car ls) (cdr ls))
|
||||
(loopf (car ls) (cdr ls))))]
|
||||
[else (err y)])))
|
||||
(define flloopt
|
||||
(lambda (x y ls)
|
||||
(cond
|
||||
[(fixnum? y)
|
||||
(if (null? ls)
|
||||
(flfx< x y)
|
||||
(if (flfx< x y)
|
||||
(fxloopt y (car ls) (cdr ls))
|
||||
(loopf (car ls) (cdr ls))))]
|
||||
[(bignum? y)
|
||||
(if (null? ls)
|
||||
(flbn< x y)
|
||||
(if (flbn< x y)
|
||||
(bnloopt y (car ls) (cdr ls))
|
||||
(loopf (car ls) (cdr ls))))]
|
||||
[(flonum? y)
|
||||
(if (null? ls)
|
||||
(flfl< x y)
|
||||
(if (flfl< x y)
|
||||
(flloopt y (car ls) (cdr ls))
|
||||
(loopf (car ls) (cdr ls))))]
|
||||
[else (err y)])))
|
||||
(define loopf
|
||||
(lambda (x ls)
|
||||
|
|
@ -428,11 +502,19 @@
|
|||
(cond
|
||||
[(fixnum? y) (fxfx< x y)]
|
||||
[(bignum? y) (fxbn< x y)]
|
||||
[(flonum? y) (fxfl< x y)]
|
||||
[else (err y)])]
|
||||
[(bignum? x)
|
||||
(cond
|
||||
[(fixnum? y) (bnfx< x y)]
|
||||
[(bignum? y) (bnbn< x y)]
|
||||
[(flonum? y) (bnfl< x y)]
|
||||
[else (err y)])]
|
||||
[(flonum? x)
|
||||
(cond
|
||||
[(fixnum? y) (flfx< x y)]
|
||||
[(bignum? y) (flbn< x y)]
|
||||
[(flonum? y) (flfl< x y)]
|
||||
[else (err y)])]
|
||||
[else (err x)])]
|
||||
[(x y z)
|
||||
|
|
@ -444,12 +526,30 @@
|
|||
[(fixnum? z) (and (fxfx< x y) (fxfx< y z))]
|
||||
[(bignum? z)
|
||||
(and (fxfx< x y) (fxbn< y z))]
|
||||
[(flonum? z)
|
||||
(and (fxfx< x y) (fxfl< y z))]
|
||||
[else (err z)])]
|
||||
[(bignum? y)
|
||||
(cond
|
||||
[(fixnum? z) #f]
|
||||
[(bignum? z)
|
||||
(and (fxbn< x y) (bnbn< y z))]
|
||||
[(flonum? z)
|
||||
(and (fxbn< x y) (bnfl< y z))]
|
||||
[else (err z)])]
|
||||
[(flonum? y)
|
||||
(cond
|
||||
[(fixnum? z)
|
||||
(and (fxfx< x z)
|
||||
(fxfl< x y)
|
||||
(flfx< y z))]
|
||||
[(bignum? z)
|
||||
(and (fxbn< x z)
|
||||
(fxfl< x y)
|
||||
(flbn< y z))]
|
||||
[(flonum? z)
|
||||
(and (flfl< y z)
|
||||
(fxfl< x y))]
|
||||
[else (err z)])]
|
||||
[else (err y)])]
|
||||
[(bignum? x)
|
||||
|
|
@ -459,11 +559,53 @@
|
|||
[(fixnum? z) (and (fxfx< y z) (bnfx< x y))]
|
||||
[(bignum? z)
|
||||
(and (bnfx< x y) (bnfx< y z))]
|
||||
[(flonum? z)
|
||||
(and (bnfx< x y) (fxfl< y z))]
|
||||
[else (err z)])]
|
||||
[(bignum? y)
|
||||
(cond
|
||||
[(fixnum? z) (and (bnfx< y z) (bnbn< x y))]
|
||||
[(bignum? z) (and (bnbn< x y) (bnbn< y z))]
|
||||
[(flonum? z) (and (bnfl< y z) (bnbn< x y))]
|
||||
[else (err z)])]
|
||||
[(flonum? y)
|
||||
(cond
|
||||
[(fixnum? z)
|
||||
(and (flfx< y z) (bnfl< x y))]
|
||||
[(bignum? z)
|
||||
(and (bnfl< x y) (flbn< y z))]
|
||||
[(flonum? z)
|
||||
(and (flfl< y z) (bnfl< x y))]
|
||||
[else (err z)])]
|
||||
[else (err y)])]
|
||||
[(flonum? x)
|
||||
(cond
|
||||
[(fixnum? y)
|
||||
(cond
|
||||
[(fixnum? z)
|
||||
(and (fxfx< y z) (flfx< x y))]
|
||||
[(bignum? z)
|
||||
(and (flfx< x y) (fxbn< y z))]
|
||||
[(flonum? z)
|
||||
(and (flfx< x y) (fxfl< y z))]
|
||||
[else (err z)])]
|
||||
[(bignum? y)
|
||||
(cond
|
||||
[(fixnum? z)
|
||||
(and (bnfx< y z) (flbn< x y))]
|
||||
[(bignum? z)
|
||||
(and (bnbn< y z) (flbn< x y))]
|
||||
[(flonum? z)
|
||||
(and (flbn< x y) (bnfl< y z))]
|
||||
[else (err z)])]
|
||||
[(flonum? y)
|
||||
(cond
|
||||
[(fixnum? z)
|
||||
(and (flfx< y z) (flfl< x y))]
|
||||
[(bignum? z)
|
||||
(and (flfl< x y) (flbn< y z))]
|
||||
[(flonum? z)
|
||||
(and (flfl< x y) (flfl< y z))]
|
||||
[else (err z)])]
|
||||
[else (err y)])]
|
||||
[else (err x)])]
|
||||
|
|
@ -472,6 +614,7 @@
|
|||
(cond
|
||||
[(fixnum? x) (fxloopt x y ls)]
|
||||
[(bignum? x) (bnloopt x y ls)]
|
||||
[(flonum? x) (flloopt x y ls)]
|
||||
[else (err x)])]))]))
|
||||
|
||||
(define-syntax false (syntax-rules () [(_ x y) #f]))
|
||||
|
|
@ -489,17 +632,53 @@
|
|||
(define-syntax fxbn> (syntax-rules () [(_ x y) (not (positive-bignum? y))]))
|
||||
(define-syntax bnfx> (syntax-rules () [(_ x y) (positive-bignum? x)]))
|
||||
|
||||
(define-syntax flcmp
|
||||
(syntax-rules ()
|
||||
[(_ flfl? flfx? fxfl? flbn? bnfl? fl?)
|
||||
(begin
|
||||
(define-syntax flfl?
|
||||
(syntax-rules () [(_ x y) (fl? x y)]))
|
||||
(define-syntax flfx?
|
||||
(syntax-rules () [(_ x y) (fl? x (fixnum->flonum y))]))
|
||||
(define-syntax flbn?
|
||||
(syntax-rules () [(_ x y) (fl? x (bignum->flonum y))]))
|
||||
(define-syntax fxfl?
|
||||
(syntax-rules () [(_ x y) (fl? (fixnum->flonum x) y)]))
|
||||
(define-syntax bnfl?
|
||||
(syntax-rules () [(_ x y) (fl? (bignum->flonum x) y)])))]))
|
||||
|
||||
(define-syntax $fl=
|
||||
(syntax-rules () [(_ x y) (foreign-call "ikrt_fl_equal" x y)]))
|
||||
(define-syntax $fl<
|
||||
(syntax-rules () [(_ x y) (foreign-call "ikrt_fl_less" x y)]))
|
||||
(define-syntax $fl<=
|
||||
(syntax-rules () [(_ x y) (foreign-call "ikrt_fl_less_or_equal" x y)]))
|
||||
(define-syntax $fl>
|
||||
(syntax-rules () [(_ x y) (foreign-call "ikrt_fl_less" y x)]))
|
||||
(define-syntax $fl>=
|
||||
(syntax-rules () [(_ x y) (foreign-call "ikrt_fl_less_or_equal" y x)]))
|
||||
|
||||
(flcmp flfl= flfx= fxfl= flbn= bnfl= $fl=)
|
||||
(flcmp flfl< flfx< fxfl< flbn< bnfl< $fl<)
|
||||
(flcmp flfl> flfx> fxfl> flbn> bnfl> $fl>)
|
||||
(flcmp flfl<= flfx<= fxfl<= flbn<= bnfl<= $fl<=)
|
||||
(flcmp flfl>= flfx>= fxfl>= flbn>= bnfl>= $fl>=)
|
||||
|
||||
|
||||
(primitive-set! '+ +)
|
||||
(primitive-set! '- -)
|
||||
(primitive-set! '* *)
|
||||
(primitive-set! '= (mk< = #%$fx= false false bnbn=))
|
||||
(primitive-set! '< (mk< < #%$fx< fxbn< bnfx< bnbn<))
|
||||
(primitive-set! '> (mk< > #%$fx> fxbn> bnfx> bnbn>))
|
||||
(primitive-set! '<= (mk< <= #%$fx<= fxbn< bnfx< bnbn<=))
|
||||
(primitive-set! '>= (mk< >= #%$fx>= fxbn> bnfx> bnbn>=))
|
||||
(primitive-set! '/ /)
|
||||
(primitive-set! '= (mk< = #%$fx= false false bnbn=
|
||||
fxfl= flfx= bnfl= flbn= flfl=))
|
||||
(primitive-set! '< (mk< < #%$fx< fxbn< bnfx< bnbn<
|
||||
fxfl< flfx< bnfl< flbn< flfl<))
|
||||
(primitive-set! '> (mk< > #%$fx> fxbn> bnfx> bnbn>
|
||||
fxfl> flfx> bnfl> flbn> flfl>))
|
||||
(primitive-set! '<= (mk< <= #%$fx<= fxbn< bnfx< bnbn<=
|
||||
fxfl<= flfx<= bnfl<= flbn<= flfl<=))
|
||||
(primitive-set! '>= (mk< >= #%$fx>= fxbn> bnfx> bnbn>=
|
||||
fxfl>= flfx>= bnfl>= flbn>= flfl>=))
|
||||
(primitive-set! 'logand logand)
|
||||
(primitive-set! 'number? number?)
|
||||
(primitive-set! 'number->string number->string)
|
||||
|
|
@ -605,6 +784,13 @@
|
|||
[(bignum? x) (not (positive-bignum? x))]
|
||||
[else (error 'negative? "~s is not a number" x)])))
|
||||
|
||||
(primitive-set! 'sin
|
||||
(lambda (x)
|
||||
(cond
|
||||
[(flonum? x) (foreign-call "ikrt_fl_sin" x)]
|
||||
[(fixnum? x) (foreign-call "ikrt_fx_sin" x)]
|
||||
[else (error 'sin "unsupported ~s" x)])))
|
||||
|
||||
(primitive-set! 'even? even?)
|
||||
(primitive-set! 'odd? odd?)
|
||||
(primitive-set! 'max max)
|
||||
|
|
@ -616,4 +802,6 @@
|
|||
(primitive-set! 'inexact? inexact?)
|
||||
(primitive-set! 'integer? integer?)
|
||||
(primitive-set! 'exact->inexact exact->inexact)
|
||||
(primitive-set! 'modulo modulo)
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -11,6 +11,30 @@
|
|||
(foreign-call "ikrt_stats_now" t))
|
||||
|
||||
(define (print-stats message bytes t1 t0)
|
||||
(define (print-time msg msecs)
|
||||
(printf " ~a ms elapsed ~a time\n" msecs msg))
|
||||
(define (msecs s1 s0 u1 u0)
|
||||
(+ (* (- s1 s0) 1000) (quotient (- u1 u0) 1000)))
|
||||
(if message
|
||||
(printf "running stats for ~a:\n" message)
|
||||
(printf "running stats:\n"))
|
||||
(let ([collections
|
||||
(fx- (stats-collection-id t1) (stats-collection-id t0))])
|
||||
(case collections
|
||||
[(0) (display " no collections\n")]
|
||||
[(1) (display " 1 collection\n")]
|
||||
[else (printf " ~a collections\n" collections)]))
|
||||
(print-time "cpu"
|
||||
(+ (msecs (stats-user-secs t1) (stats-user-secs t0)
|
||||
(stats-user-usecs t1) (stats-user-usecs t0))
|
||||
(msecs (stats-sys-secs t1) (stats-sys-secs t0)
|
||||
(stats-sys-usecs t1) (stats-sys-usecs t0))))
|
||||
(print-time "real"
|
||||
(msecs (stats-real-secs t1) (stats-real-secs t0)
|
||||
(stats-real-usecs t1) (stats-real-usecs t0)))
|
||||
(printf " ~a bytes allocated\n" bytes))
|
||||
|
||||
(define (print-stats-old message bytes t1 t0)
|
||||
(define (print-time msg secs usecs)
|
||||
(if (fx< usecs 0)
|
||||
(print-time msg (fx- secs 1) (fx+ usecs 1000000))
|
||||
|
|
|
|||
|
|
@ -80,8 +80,8 @@
|
|||
open-output-file open-input-file open-output-string
|
||||
get-output-string with-output-to-file call-with-output-file
|
||||
with-input-from-file call-with-input-file date-string
|
||||
file-exists? delete-file + - add1 sub1 * expt
|
||||
quotient+remainder quotient remainder number? positive?
|
||||
file-exists? delete-file + - add1 sub1 * / expt
|
||||
quotient+remainder quotient remainder modulo number? positive?
|
||||
negative? zero? number->string logand = < > <= >=
|
||||
make-guardian weak-cons collect
|
||||
interrupt-handler
|
||||
|
|
@ -94,6 +94,7 @@
|
|||
string->number exact->inexact
|
||||
|
||||
flonum? flonum->string string->flonum
|
||||
sin
|
||||
))
|
||||
|
||||
(define system-primitives
|
||||
|
|
|
|||
Loading…
Reference in New Issue