Fwd: [Openmcl-devel] Help on using FPC-compiler
Randall Beer
beer at eecs.cwru.edu
Wed Dec 8 15:22:41 PST 2004
Begin forwarded message:
> From: Randall Beer <beer at eecs.cwru.edu>
> Date: December 8, 2004 12:24:46 PM EST
> To: Diedrich Wolter <dwolter at informatik.uni-bremen.de>
> Subject: Re: [Openmcl-devel] Help on using FPC-compiler
>
> A clue that something has gone badly wrong is that after the call to
> LIN-SOLVE-FPC, 0.0D0 evaluates to -5.370073764483212D0!
>
> A fix for the problem is to redefine WITH-TEMP-DOUBLE-FLOATS as below.
> Before I release a new version, could people who are using FPC-PPC try
> this fix and make sure that nothing else is broken by it?
>
> For those who care, the problem was that the default value of
> temporary variables in WITH-TEMP-DOUBLE-FLOATS is 0.0D0. Since these
> temporary variables are declared to be DOUBLE-FLOATs with
> DYNAMIC-EXTENT, I was assuming that I was getting fresh storage on the
> stack for each double, when in fact I was getting fresh storage on the
> stack for each pointer to the SAME double (0.0d0, which OpenMCL seems
> to store uniquely unless it is explicitly copied). Thus, any
> SET-DOUBLE! done on any of these temps was actually modifying the
> value of 0.0D0.
>
> The fix below is less than ideal, since it involves making a copy of
> every initial value of every temporary float each time
> WITH-TEMP-DOUBLE-FLOATS is called.
>
> Gary: Is there a better way to do this, e.g. by using STACK-BLOCK?
>
> Randy
>
> =====================
>
> (defmacro with-temp-double-floats (fforms &body body)
> (let ((letvars nil)
> (letforms nil))
> (loop for f in fforms
> if (symbolp f)
> do (progn (push f letvars) (push `(,f (%copy-float 0.0D0))
> letforms))
> else
> do (progn
> (push (first f) letvars)
> (push `(,(first f) (%copy-float (coerce ,(second f)
> 'double-float)))
> letforms)))
> `(let ,(nreverse letforms)
> (declare (dynamic-extent ,@(reverse letvars))
> (double-float ,@(reverse letvars)))
> , at body)))
>
>
>
> On Dec 8, 2004, at 8:13 AM, Diedrich Wolter wrote:
>
>> Hi all,
>>
>> to speed up my floating point calculation I'm using Randall Beer's
>> excellent FPC compiler
>> (see http://vorlon.cwru.edu/~beer/). My code works fine in MCL, but
>> the results are
>> screwed up using OpenMCL (0.14-031220). An example is attached.
>>
>> Has anybody had a similar experience? Any pointers appreciated!
>>
>> Best wishes,
>> Diedrich
>>
>>
>> ;; Standard Lisp to verify the results
>>
>> (defun lin-solve (m11 m12 m21 m22 lx ly)
>> "Solves the equation M * x = l, M being a 2*2 matrix. The solution
>> x1 and x2 is
>> returned as multiple values."
>> (declare (type double-float m11 m12 m21 m22 lx ly)
>> (optimize (speed 3) (safety 0)))
>> (let ((det (- (* m11 m22) (* m12 m21))))
>> (declare (type double-float det)
>> (dynamic-extent det))
>> (if (< (abs det) +eps+)
>> nil
>> (let ((det1 (/ 1.0d0 det)))
>> (declare (type double-float det1)
>> (dynamic-extent det))
>> (values (+ (* m22 det1 lx) (* (- m12) det1 ly))
>> (+ (* (- m21) det1 lx) (* m11 det1 ly)))))))
>>
>>
>> ;; FPC version which *should* give the same results, just way faster
>>
>> (defun lin-solve-fpc (m11 m12 m21 m22 lx ly)
>> "Solves the equation M * x = l, M being a 2*2 matrix. The solution
>> x and y is
>> returned as multiple values."
>> (declare (type double-float m11 m12 m21 m22 lx ly +eps+)
>> (optimize (speed 3) (safety 0) (debug 0)))
>> (ccl:with-temp-double-floats (det)
>> (ccl::%set-double! det (- (* m11 m22) (* m12 m21)))
>> (if (< (abs det) (the double-float +eps+))
>> nil
>> (ccl:with-temp-double-floats (x y)
>> (ccl::%set-double! det (/ 1.0d0 det))
>> (ccl:%set-double! x (+ (* m22 det lx) (* (- m12) det ly)))
>> (ccl:%set-double! y (+ (* (- m21) det lx) (* m11 det ly)))
>> (values (ccl:%copy-float x)
>> (ccl:%copy-float y))))))
>>
>> ;; Test function: should infinitely loop (and does that using MCL)
>> ;; In OpenMCL differing results are printed out (see below)
>>
>> (defun fpctest ()
>> (declare (optimize (speed 0) (safety 3) (debug 3)))
>> ;; (rnum) generates a random double-float
>> (flet ((rnum ()
>> (coerce (* 1e-4 (random 100000)) 'double-float)))
>> (let ((i 0))
>> (loop
>> (let ((m11 (rnum))
>> (m12 (rnum))
>> (m21 (rnum))
>> (m22 (rnum))
>> (lx (rnum))
>> (ly (rnum)))
>> (multiple-value-bind (fpc-1 fpc-2) (lin-solve-fpc m11 m12
>> m21 m22 lx ly)
>> (multiple-value-bind (std-1 std-2) (lin-solve m11 m12 m21
>> m22 lx ly)
>> ;; Check, if results differ
>> (when (or (and fpc-2 (not std-2))
>> (and std-2 (not fpc-2))
>> (and fpc-1 (not std-1))
>> (and std-1 (not fpc-1))
>> (not (zero? (- fpc-1 std-1)))
>> (not (zero? (- fpc-2 std-2))))
>> (format t
>> "~%~%m11 = ~a, m12 = ~a, m21 = ~a, m22 = ~a,
>> lx = ~a, ly = ~a~%-> fpc-1 = ~a, fpc-2 = ~a,~%-> std-1 = ~a, std-2 =
>> ~a"
>> m11 m12 m21 m22 lx ly fpc-1 fpc-2 std-1
>> std-2)))))
>> (incf i)
>> (when (= 0 (mod i 100000))
>> (print i))))))
>>
>> ;; Exemplary output:
>> ;; m11 = 4.119199752807617D0, m12 = 1.4930999279022217D0, m21 =
>> 2.8643999099731445D0,
>> ;; m22 = 9.78849983215332D0, lx = 6.079599857330322D0, ly =
>> 3.3651998043060303D0
>> ;; -> fpc-1 = -5.370073764483212D0, fpc-2 = -5.370073764483212D0,
>> ;; -> std-1 = 1.511642908277411D0, std-2 = -0.09855953645790666D0
>> ;;
>> ;; Observation: The FPC version always returns two identical values
>>
>> _______________________________________________
>> Openmcl-devel mailing list
>> Openmcl-devel at clozure.com
>> http://clozure.com/mailman/listinfo/openmcl-devel
>>
>
More information about the Openmcl-devel
mailing list