[Openmcl-devel] Exposing math functions
Ron Garret
ron at flownet.com
Thu Jun 18 14:01:18 PDT 2020
The best way to answer performance questions is just to run some benchmarks.
On Jun 18, 2020, at 1:58 AM, Steven Nunez <steve_nunez at yahoo.com> wrote:
> Greetings all,
>
> I've got need of a few functions that are in the standard C library, but not in common lisp. Since the functions are there, but not available, I set about wrapping them. Looking at the code for atanh, I was surprised that CCL's wrapping is so complicated. Now I get that the code, pasted below, has to cater for complex numbers, multiple architectures and the like, so I can likely simplify it for my use case in one architecture and the real domain.
>
> So, my question is: is this best practice for getting good performance for a wrapper? In Allegro, where I don't have access to the code, things are much simpler, using their FFI, e.g.
>
> (ff:def-foreign-call (%erf "erf") ((x :double))
> :returning :double)
> (ff:def-foreign-call (%erff "erff") ((x :float))
> :returning :float)
> (defun erf (x)
> "Returns the error function value for x"
> (cond ((typep x 'double-float) (%erf x))
> ((typep x 'single-float) (%erff x))))
>
>
> Whereas in the CCL code there's %setf-double-float, and target::with-stack-double-floats, all of which seem undocumented, but look like they're doing some magic to keep things fast and/or efficient. These functions are already in the database, so it's tempting to use the #_ macro to access them, but then I wonder why the CCL guys didn't do this.
>
> Anyone got any ideas here? I guess I'm wondering as well whether or not I'll get any performance benefit from following the CCL pattern over a simpler approach.
>
>
> #+windows-target
> (progn
> (defun %double-float-atanh! (n result)
> (declare (double-float n result))
> (with-stack-double-floats ((temp))
> (%setf-double-float TEMP (external-call "atanh" :double n :double))
> (%df-check-exception-1 'atanh n (%ffi-exception-status))
> (%setf-double-float result TEMP)))
>
> #+32-bit-target
> (defun %single-float-atanh! (n result)
> (declare (single-float n result))
> (target::with-stack-short-floats ((temp))
> #+arm-target (%set-fpscr-status 0)
> (%setf-short-float TEMP (external-call "atanhf" :float n :float))
> (%sf-check-exception-1 'atanh n (%ffi-exception-status))
> (%setf-short-float result TEMP)))
>
> #+64-bit-target
> (defun %single-float-atanh (n)
> (declare (single-float n))
> (let* ((result (external-call "atanhf" :float n :float)))
> (%sf-check-exception-1 'atanh n (%ffi-exception-status))
> result)))
>
> (defun atan (y &optional (x nil x-p))
> "Return the arc tangent of Y if X is omitted or Y/X if X is supplied."
> (cond (x-p
> (cond ((or (typep x 'double-float)
> (typep y 'double-float))
> (with-stack-double-floats ((dy y)
> (dx x))
> (%df-atan2 dy dx)))
> (t
> (when (and (rationalp x) (rationalp y))
> ;; rescale arguments so that the maximum absolute value is 1
> (let ((x1 (abs x)) (y1 (abs y)))
> (cond ((> y1 x1)
> (setf x (/ x y1))
> (setf y (signum y)))
> ((not (zerop x))
> (setf y (/ y x1))
> (setf x (signum x))))))
> #+32-bit-target
> (target::with-stack-short-floats ((sy y)
> (sx x))
> (%sf-atan2! sy sx))
> #+64-bit-target
> (%sf-atan2 (%short-float y) (%short-float x)))))
> ((typep y 'double-float)
> (%double-float-atan! y (%make-dfloat)))
> ((typep y 'single-float)
> #+32-bit-target
> (%single-float-atan! y (%make-sfloat))
> #+64-bit-target
> (%single-float-atan y))
> ((typep y 'rational)
> (cond ((<= (abs y) most-positive-short-float)
> #+32-bit-target
> (target::with-stack-short-floats ((sy y))
> (%single-float-atan! sy (%make-sfloat)))
> #+64-bit-target
> (%single-float-atan (%short-float y)))
> ((minusp y)
> #.(- single-float-half-pi))
> (t
> single-float-half-pi)))
> (t
> (let ((r (realpart y))
> (i (imagpart y)))
> (if (zerop i)
> (complex (atan r) i)
> (i* (%complex-atanh (complex (- i) r)) -1))))))
>
>
> _______________________________________________
> Openmcl-devel mailing list
> Openmcl-devel at clozure.com
> https://lists.clozure.com/mailman/listinfo/openmcl-devel
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://lists.clozure.com/pipermail/openmcl-devel/attachments/20200618/93672b1c/attachment.htm>
More information about the Openmcl-devel
mailing list