[gambit-list] a simple question for optimization

Bradley Lucier lucier at math.purdue.edu
Fri Apr 10 18:12:55 EDT 2015


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.


More information about the Gambit-list mailing list