[Openmcl-devel] Wrong floating-point result.

[Waldek Hebisch]

When using Closure CL (Clozure Common Lisp Version 1.5-r13651
(LinuxX8664)!) after compiling and loading the attached file
I get:

? (|ACPLTTS;newtonApprox1;Sup2Df;1| pol 1.6543999999999996d0 vv)
0.6543999999999996D0

which is wrong.  Using other Lisp, like sbcl I get the correct
result, that is 1.4853058451606995d0.

I wonder if this is related to the recently fixed stack-return
bug.

-- 
                              Waldek Hebisch
hebisch at math.uni.wroc.pl 
-------------- next part --------------

(defmacro SPADCALL (&rest L)
  (let ((args (butlast l))
        (fn (car (last l)))
        (gi (gensym)))
     ;; (values t) indicates a single return value
    `(let ((,gi ,fn))
       (the (values t)
         (funcall
          (the #-(or :genera :lispworks)
                   (function ,(make-list (length l) :initial-element t) t)
               #+(or :genera :lispworks)function
            (car ,gi))
          , at args
          (cdr ,gi))))))

(defmacro qrefelt (vec ind)
 `(svref ,vec ,ind))

(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 DEF-DF-UNOP (name op)
    `(defmacro ,name (x) `(the double-float (,',op (the double-float ,x)))))

(DEF-DF-UNOP MINUS-DF -)

(defvar vv)
(setf vv (make-array '(5)))

(defun d1(x $)
   (cond
      ((null x) nil)
      ((consp x)
          (let* ((x0 (car x)) (r (cdr x))(i (car x0)) (v (cdr x0)))
              (cond
                   ((eql i 0) nil)
                   (t (cons (cons (- i 1) (* i v)) (d1 r $))))))
   )
)

(defun d2(x y z $) 
    (* (* 1.0d0 x) (expt (* 1.0d0 z) y)))
;; (defun f3(x $) 1.2193579171839963d0)
(defun f3(x $) x)
;;; (defun f4(x y $) -7.211118079999995d0)
(defun f4(x y $)
   (cond
      ((null x) 0.0d0)
      ((consp x)
          (let* ((x0 (car x)) (r (cdr x))(i (car x0)) (v (cdr x0)))
              (cond
                   ((eql i 0) v)
                   (t (+ (* (expt y i) v) (f4 r y $))))))
   )
)

(setf (aref vv 1) (list (function d1)))
(setf (aref vv 2) (list (function d2)))
(setf (aref vv 3) (list (function f3)))
(setf (aref vv 4) (list (function f4)))

(DEFUN |ACPLTTS;newtonApprox1;Sup2Df;1| (|f| |a0| $)
  (let (|newApprox| |fa| |Df|)
    (progn
      (setf |Df| (SPADCALL |f| (QREFELT $ 1)))
      (setf |fa|
            (MINUS-DF
             (SPADCALL (SPADCALL 12193579171839963 -16 10 (QREFELT $ 2))
                       (QREFELT $ 3))))
      (setf |newApprox|
            (SUB-DF |a0| (DIV-DF |fa| (SPADCALL |Df| |a0| (QREFELT $ 4)))))
      (values |newApprox|))))

(setf pol '((3 . -1d0) (1 . 1d0) (0 . 1.6543999999999996d0)))

;;; (|ACPLTTS;newtonApprox1;Sup2Df;1| pol 1.6543999999999996d0 vv)