Hi gambit users
I am trying to verify that a program written in Gambit-C scheme is as fast as equivalent C program.
I tried to make a scheme version of the following C++ program which is;
*#include <iostream>* *#include <cmath>* *#include <cstdio>* *#include <ctime>* *#include <cstdlib>* *#include <iomanip> *
*using namespace std;*
*double f(double x);*
*int main(int argc, char* argv[]) {* * clock_t start;* * start = clock();* * double duration;* * double sum = 0;* * long n = atoi(argv[1]);* * double x;* * for(long i = 1; i <= n ;i++) {* * x = (i - 0.5) / n;* * sum += 4.0/(1.0+x*x);* * }* * sum /= n;* * cout << setprecision(17) << sum << endl << endl;*
* duration = ( clock() - start ) / (double) CLOCKS_PER_SEC;* * cout << duration <<'\n';* * return 0;* *}*
*double f(double x) {* * return 4.0/(1.0 + x*x);* *}*
and my best so far is *#!/usr/bin/env gsi-script* *(declare* * (not safe)* * (mostly-flonum))* *(define (main arg)* * (let ((k (string->number arg)))* * (pretty-print (time (cpi (exact->inexact k))))))* *(define (cpi n)* * (letrec ((rec (lambda (i sum)* * (let* ((x (fl/ (fl- i 0.5) n))* * (summand (fl/ 4.0 (fl+ 1.0 (fl* x x)))))* * (if (fl> i n)* * (fl/ sum n)* * (rec (fl+ i 1.0) (fl+ sum summand)))))))* * (rec 0.0 0.0)))*
and the result is poor: 0.043s vs 0.145s *server@HP-Proliant-MicroServer:~/speedtest$ ls* *pi.cpp pi.scm* *server@HP-Proliant-MicroServer:~/speedtest$ g++ -o pi-cpp pi.cpp* *server@HP-Proliant-MicroServer:~/speedtest$ gsc -exe -o pi-scm pi.scm* *server@HP-Proliant-MicroServer:~/speedtest$ time ./pi-cpp 1000000* *3.1415926535897643*
*0.038903*
*real 0m0.043s* *user 0m0.042s* *sys 0m0.004s* *server@HP-Proliant-MicroServer:~/speedtest$ time ./pi-scm 1000000* *(time (cpi (exact->inexact k)))* * 128 ms real time* * 128 ms cpu time (127 user, 2 system)* * 182 collections accounting for 67 ms real time (72 user, 1 system)* * 224000448 bytes allocated* * 341 minor faults* * no major faults* *3.1415966535897644*
*real 0m0.145s* *user 0m0.136s* *sys 0m0.009s* *server@HP-Proliant-MicroServer:~/speedtest$ *
So.. I guess my scheme version is not equivalent to the original C++ program, but I'm having trouble figuring out why
any help will be appreciated
any comment, any suggestion..
Afficher les réponses par date
Long answer:
First we try it as is:
#!/usr/bin/env gsi-script (declare (not safe) (mostly-flonum))
(define (main arg) (let ((k (string->number arg))) (pretty-print (time (cpi (exact->inexact k))))))
(define (cpi n) (letrec ((rec (lambda (i sum) (let* ((x (fl/ (fl- i 0.5) n)) (summand (fl/ 4.0 (fl+ 1.0 (fl* x x))))) (if (fl> i n) (fl/ sum n) (rec (fl+ i 1.0) (fl+ sum summand))))))) (rec 0.0 0.0)))
[Media-Mac-mini-3:~] lucier% gsc -exe pi.scm gcc: warning: couldn't understand kern.osversion '14.3.0 gcc: warning: couldn't understand kern.osversion '14.3.0 gcc: warning: couldn't understand kern.osversion '14.3.0 [Media-Mac-mini-3:~] lucier% time ./pi 1000000 (time (cpi (exact->inexact k))) 60 ms real time 59 ms cpu time (56 user, 3 system) 104 collections accounting for 21 ms real time (20 user, 0 system) 224000448 bytes allocated 567 minor faults no major faults 3.1415966535897644 0.060u 0.009s 0:00.07 85.7% 0+0k 0+0io 0pf+0w
Then we look at the code expansion:
[Media-Mac-mini-3:~] lucier% gsc -exe -expansion pi.scm Expansion:
(define main (lambda (arg) (let ((k (string->number arg))) (pretty-print (##time (lambda () (cpi (if (and ('#<procedure #2 ##eq?> exact->inexact '#<procedure #3 exact->inexact>) ('#<procedure #4 ##flonum?> k)) k (exact->inexact k)))) '(cpi (exact->inexact k)))))))
(define cpi (lambda (n) (letrec ((rec (lambda (n i sum) (let ((x (let ((temp.3 (if ('#<procedure #2 ##eq?> fl- '#<procedure #5 fl->) ('#<procedure #6 ##fl-> i .5) (fl- i .5)))) (if ('#<procedure #2 ##eq?> fl/ '#<procedure #7 fl/>) ('#<procedure #8 ##fl/> temp.3 n) (fl/ temp.3 n))))) (let ((summand (let ((temp.10 (let ((temp.8 (if ('#<procedure #2 ##eq?> fl* '#<procedure #9 fl*>) ('#<procedure #10 ##fl*> x x) (fl* x x)))) (if ('#<procedure #2 ##eq?> fl+ '#<procedure #11 fl+>) ('#<procedure #12 ##fl+> 1. temp.8) (fl+ 1. temp.8))))) (if ('#<procedure #2 ##eq?> fl/ '#<procedure #7 fl/>) ('#<procedure #8 ##fl/> 4. temp.10) (fl/ 4. temp.10))))) (if (if ('#<procedure #2 ##eq?> fl> '#<procedure #13 fl>>) ('#<procedure #14 ##fl>> i n) (fl> i n)) (if ('#<procedure #2 ##eq?> fl/ '#<procedure #7 fl/>) ('#<procedure #8 ##fl/> sum n) (fl/ sum n)) (rec n (if ('#<procedure #2 ##eq?> fl+ '#<procedure #11 fl+>) ('#<procedure #12 ##fl+> i 1.) (fl+ i 1.)) (if ('#<procedure #2 ##eq?> fl+ '#<procedure #11 fl+>) ('#<procedure #12 ##fl+> sum summand) (fl+ sum summand))))))))) (rec n 0. 0.))))
So you see that the code keeps checking that the flonum procedures fl+, etc., are really fl+ before inlining them.
So we declare standard-bindings and extended-bindings to tell the compiler that the procedures are what they say (it would be good to declare block, too, to say that we don’t redefine user procedures, but that’s not needed because we call cpi only once):
#!/usr/bin/env gsi-script (declare (standard-bindings) (extended-bindings) (not safe) (mostly-flonum))
(define (main arg) (let ((k (string->number arg))) (pretty-print (time (cpi (exact->inexact k))))))
(define (cpi n) (letrec ((rec (lambda (i sum) (let* ((x (fl/ (fl- i 0.5) n)) (summand (fl/ 4.0 (fl+ 1.0 (fl* x x))))) (if (fl> i n) (fl/ sum n) (rec (fl+ i 1.0) (fl+ sum summand))))))) (rec 0.0 0.0)))
[Media-Mac-mini-3:~] lucier% gsc -exe -expansion pi.scm Expansion:
(define main (lambda (arg) (let ((k ('#<procedure #2 string->number> arg))) (pretty-print (##time (lambda () (cpi (if ('#<procedure #3 ##flonum?> k) k ('#<procedure #4 exact->inexact> k)))) '(cpi (exact->inexact k)))))))
(define cpi (lambda (n) (letrec ((rec (lambda (n i sum) (let ((x ('#<procedure #5 ##fl/> ('#<procedure #6 ##fl-> i .5) n))) (let ((summand ('#<procedure #5 ##fl/> 4. ('#<procedure #7 ##fl+> 1. ('#<procedure #8 ##fl*> x x))))) (if ('#<procedure #9 ##fl>> i n) ('#<procedure #5 ##fl/> sum n) (rec n ('#<procedure #7 ##fl+> i 1.) ('#<procedure #7 ##fl+> sum summand)))))))) (rec n 0. 0.))))
That's better:
[Media-Mac-mini-3:~] lucier% time ./pi 1000000 (time (cpi (exact->inexact k))) 28 ms real time 27 ms cpu time (25 user, 2 system) 44 collections accounting for 7 ms real time (7 user, 0 system) 96000192 bytes allocated 563 minor faults 4 major faults 3.1415966535897644 0.030u 0.012s 0:00.29 13.7% 0+0k 0+0io 753pf+0w
But you notice that 96 bytes are allocated for each value of i. That's a lot. So you look at the C code generated:
[Media-Mac-mini-3:~] lucier% gsc -exe -keep-c pi.scm [Media-Mac-mini-3:~] lucier% vi pi.c
and you say "Holy shit, the Gambit compiler sure boxes flonums a lot (F64BOX)" and "what are all those CHECK_HEAPS for?".
Well, the CHECK_HEAPS are because the F64BOXes are using up the heap.
And the F64BOXes are using up the heap because the Gambit compiler does not keep flonums unboxed across jumps.
So if you want to distort the code to work around limitations of the Gambit compiler, you can keep an explicit f64vector to hold the partial sums.
But first you notice there's a bug in the program, and it should start with i=1.
And then you remember that fixnums are never boxed.
So you screw up your code as follows:
#!/usr/bin/env gsi-script (declare (standard-bindings) (extended-bindings) (not safe) (mostly-flonum))
(define (main arg) (let ((k (string->number arg))) (pretty-print (time (cpi k)))))
(define (cpi n) (letrec ((rec (lambda (i sum) (let* ((x (fl/ (fl- (fixnum->flonum i) 0.5) (fixnum->flonum n))) (summand (fl/ 4.0 (fl+ 1.0 (fl* x x))))) (f64vector-set! sum 0 (fl+ (f64vector-ref sum 0) summand)) (if (fx> i n) (fl/ (f64vector-ref sum 0) (fixnum->flonum n)) (rec (fx+ i 1) sum)))))) (rec 1 (f64vector 0.0))))
and you get:
[Media-Mac-mini-3:~] lucier% time ./pi 1000000 (time (cpi k)) 18 ms real time 18 ms cpu time (17 user, 0 system) no collections 64 bytes allocated no minor faults 2 major faults 3.1415946535887644 0.021u 0.008s 0:00.07 28.5% 0+0k 0+0io 753pf+0w
And so now there is no allocation each run through the loop.
And so you decide that you don't need to interrupt the loop, either for checking the heap or checking for ^C (CNTL-C), so you disable interrupts; you don't have any generic math operations so you don't need to declare mostly-flonum:
#!/usr/bin/env gsi-script (declare (standard-bindings) (extended-bindings) (not interrupts-enabled) (not safe))
(define (main arg) (let ((k (string->number arg))) (pretty-print (time (cpi k)))))
(define (cpi n) (letrec ((rec (lambda (i sum) (let* ((x (fl/ (fl- (fixnum->flonum i) 0.5) (fixnum->flonum n))) (summand (fl/ 4.0 (fl+ 1.0 (fl* x x))))) (f64vector-set! sum 0 (fl+ (f64vector-ref sum 0) summand)) (if (fx> i n) (fl/ (f64vector-ref sum 0) (fixnum->flonum n)) (rec (fx+ i 1) sum)))))) (rec 1 (f64vector 0.0))))
and get
[Media-Mac-mini-3:~] lucier% time ./pi 1000000 (time (cpi k)) 18 ms real time 17 ms cpu time (17 user, 0 system) no collections 64 bytes allocated no minor faults no major faults 3.1415946535887644 0.021u 0.009s 0:00.09 22.2% 0+0k 0+0io 753pf+0w
So that last bit didn't help too much.
On my machine I get
[Media-Mac-mini-3:~] lucier% g++ -Wall -W -Ofast pi.cc pi.cc:12:14: warning: unused parameter 'argc' [-Wunused-parameter] int main(int argc, char* argv[]) { ^ 1 warning generated. [Media-Mac-mini-3:~] lucier% time ./a.out 1000000 3.1415926535899388
0.018200999999999998 0.018u 0.001s 0:00.02 50.0% 0+0k 0+0io 0pf+0w
Pretty close.
On Apr 10, 2015, at 6:12 PM, Bradley Lucier lucier@math.purdue.edu wrote:
Long answer:
[Media-Mac-mini-3:~] lucier% time ./pi 1000000 (time (cpi k)) 18 ms real time 17 ms cpu time (17 user, 0 system) no collections 64 bytes allocated no minor faults no major faults 3.1415946535887644 0.021u 0.009s 0:00.09 22.2% 0+0k 0+0io 753pf+0w
So that last bit didn't help too much.
On my machine I get
[Media-Mac-mini-3:~] lucier% g++ -Wall -W -Ofast pi.cc pi.cc:12:14: warning: unused parameter 'argc' [-Wunused-parameter] int main(int argc, char* argv[]) { ^ 1 warning generated. [Media-Mac-mini-3:~] lucier% time ./a.out 1000000 3.1415926535899388
0.018200999999999998 0.018u 0.001s 0:00.02 50.0% 0+0k 0+0io 0pf+0w
Pretty close.
Sorry, I didn’t use the same compiler for Scheme and C++:
[Media-Mac-mini-3:~] lucier% gsi -v v4.7.4 20150228031125 x86_64-apple-darwin14.1.0 "./configure 'CC=/pkgs/gcc-4.9.1/bin/gcc' '--enable-single-host' '--enable-multiple-versions'" [Media-Mac-mini-3:~] lucier% /pkgs/gcc-4.9.1/bin/g++ -Wall -W -Ofast pi.cc g++: warning: couldn't understand kern.osversion '14.3.0 pi.cc:12:14: warning: unused parameter 'argc' [-Wunused-parameter] int main(int argc, char* argv[]) { ^ [Media-Mac-mini-3:~] lucier% time ./a.out 1000000 3.1415926535897647
0.0090840000000000001 0.010u 0.002s 0:00.36 2.7% 0+0k 0+0io 57pf+0w
So the C++ program is still about twice as fast (if you can believe timings that small).
Brad