[Ecls-list] Inline floating point operations.

[Waldek Hebisch]

The attached file contains code for Carlson symmetic elliptic RF
function.  Using sbcl it generates quite efficient machine
code, in particular main loop operates on machine registers
and contains directly machine floating point operations.

Compiling the same code using ecl I get C output which
performs almost all operations by calls to library
functions.  Note: before compilation I issued

(proclaim '(optimize (safety 0) (speed 3)))

to activate possible optimizations.  ecl seem to include
in 'sysfun.lsp' definitions of inline operations, but
for some reason they are not used.  Why?  Is there
someting which can be done at Lisp source level to
activate aproprivate optimizations?  Note that all
relevant variables are initialized to double-float
values and declared double-float, all operations
use 'the' forms to tell compiler that arguments
are double floats (and non-negative in case of sqrt).
Simlarey 'the' forms specifay that values are double
floats.  AFAICS simple compiler which just obeys
declarations can map lisp variables to C double
variables.  In general such simple compiler may be
forced to insert convertions from C double to general
Lisp values.  But since all operations accept double
float arguments and produce double float results
it is easy to skip convertions and expand 
operations inline...
-- 
                              Waldek Hebisch
hebisch at math.uni.wroc.pl 
-------------- next part --------------
(defmacro LETT (var val &rest L) `(SETF ,var ,val))

(defmacro DEF_DF_BINOP (name op)
   `(defmacro ,name (x y) `(the double-float (,',op (the double-float ,x)
                                                    (the double-float ,y)))))

(DEF_DF_BINOP |add_DF| +)
(DEF_DF_BINOP |mul_DF| *)
(DEF_DF_BINOP |max_DF| MAX)
;;; (DEF_DF_BINOP |min_DF| MIN)
(DEF_DF_BINOP |sub_DF| -)
(DEF_DF_BINOP |div_DF| /)

(defmacro |less_DF| (x y) `(< (the double-float ,x)
                                             (the double-float ,y)))
(defmacro |qsqrt_DF| (x) `(the double-float (SQRT
                                 (the (double-float 0.0d0 *) ,x))))

(defconstant c17 (/ 1.0d0 3))
(defconstant c18 (/ 1.0d0 4))
(defconstant c21 (/ 1.0d0 7))
(defconstant c27 (/ 1.0d0 24))
(defconstant c28 (/ 1.0d0 10))
(defconstant c30 (/ 1.0d0 14)) 
(defconstant c31 (FLOAT 427 1.0d0))

(DEFUN |ELIPIDF;ellipticRF;4Df;3| (|x0| |y0| |z0|)
  (let ((Q 0.0d0) (|mu| 0.0d0) (|lambda| 0.0d0) (|znroot| 0.0d0)
         (|ynroot| 0.0d0) (|xnroot| 0.0d0) (|s| 0.0d0)
         (|e3| 0.0d0) (|e2| 0.0d0) (|zndev| 0.0d0) (|yndev| 0.0d0)
         (|xndev| 0.0d0) (|muinv| 0.0d0) (|zadev| 0.0d0)
         (|yadev| 0.0d0) (|xadev| 0.0d0)
         (|x| |x0|) (|y| |y0|) (|z| |z0|))
    (declare (type double-float Q |mu| |lambda| |znroot| |ynroot| |xnroot|
              |s| |e3| |e2| |zndev| |yndev| |xndev| |muinv|
              |zadev| |yadev| |xadev| |x| |y| |z|))
        (LETT |mu| (|mul_DF| c17 (|add_DF| (|add_DF| |x| |y|) |z|))
              . #2=(|ELIPIDF;ellipticRF;4Df;3|))
        (LETT |xadev| (FLOAT-SIGN 1.0d0 (|sub_DF| |mu| |x|)) . #2#)
        (LETT |yadev| (FLOAT-SIGN 1.0d0 (|sub_DF| |mu| |y|)) . #2#)
        (LETT |zadev| (FLOAT-SIGN 1.0d0 (|sub_DF| |mu| |z|)) . #2#)
        (LETT Q
              (|mul_DF| c31
                        (|max_DF| |xadev| (|max_DF| |yadev| |zadev|)))
              . #2#)
        (tagbody G190 NIL
             (COND
                 ((|less_DF| Q (FLOAT-SIGN 1.0d0 |mu|))
                       (LETT |muinv| (|div_DF| 1.0d0 |mu|) . #2#)
                       (LETT |xndev| (|mul_DF| (|sub_DF| |mu| |x|) |muinv|)
                             . #2#)
                       (LETT |yndev| (|mul_DF| (|sub_DF| |mu| |y|) |muinv|)
                             . #2#)
                       (LETT |zndev| (|mul_DF| (|sub_DF| |mu| |z|) |muinv|)
                             . #2#)
                       (LETT |e2|
                             (|sub_DF| (|mul_DF| |xndev| |yndev|)
                                       (|mul_DF| |zndev| |zndev|))
                             . #2#)
                       (LETT |e3| (|mul_DF| (|mul_DF| |xndev| |yndev|) |zndev|)
                             . #2#)
                       (LETT |s|
                             (|add_DF|
                              (|add_DF| 1.0d0
                                        (|mul_DF|
                                         (|sub_DF|
                                          (|sub_DF|
                                           (|mul_DF| c27 |e2|)
                                           c28)
                                          (|mul_DF| c21 |e3|))
                                         |e2|))
                              (|mul_DF| c30 |e3|))
                             . #2#)
                       (return-from |ELIPIDF;ellipticRF;4Df;3|
                         (|mul_DF| |s| (|qsqrt_DF| |muinv|)))
                    )
                 ('T
                       (LETT |xnroot| (|qsqrt_DF| |x|) . #2#)
                       (LETT |ynroot| (|qsqrt_DF| |y|) . #2#)
                       (LETT |znroot| (|qsqrt_DF| |z|) . #2#)
                       (LETT |lambda|
                             (|add_DF|
                              (|mul_DF| |xnroot| (|add_DF| |ynroot| |znroot|))
                              (|mul_DF| |ynroot| |znroot|))
                             . #2#)
                       (LETT |x|
                             (|mul_DF| c18 (|add_DF| |x| |lambda|))
                             . #2#)
                       (LETT |y|
                             (|mul_DF| c18 (|add_DF| |y| |lambda|))
                             . #2#)
                       (LETT |z|
                             (|mul_DF| c18 (|add_DF| |z| |lambda|))
                             . #2#)
                       (LETT |mu|
                             (|mul_DF| c18 (|add_DF| |mu| |lambda|))
                             . #2#)
                       (LETT Q (|mul_DF| c18 Q) . #2#)
                       (GO G190))))
              ))