<html><head></head><body><div class="ydpde0f8651yahoo-style-wrap" style="font-family:Helvetica Neue, Helvetica, Arial, sans-serif;font-size:13px;"><div></div>
<div dir="ltr" data-setdir="false"><div><div dir="ltr">Yes, that's been my experience as well. Part of the
reason for the question was to try to gain insights from anyone that
might have done something similar and to understand why the code for CCL
was written as it is. There's some reason why Gary B et. al. did things
the way they did, and knowing that will help in my coding efforts.<br clear="none"></div><div><br clear="none"><br></div></div><div><br></div></div><div><br></div>
</div><div id="yahoo_quoted_3041486737" class="yahoo_quoted">
<div style="font-family:'Helvetica Neue', Helvetica, Arial, sans-serif;font-size:13px;color:#26282a;">
<div>
On Friday, June 19, 2020, 5:01:20 AM GMT+8, Ron Garret <ron@flownet.com> wrote:
</div>
<div><br></div>
<div><br></div>
<div><div id="yiv1746609403"><div>The best way to answer performance questions is just to run some benchmarks.<div><br clear="none"><div><div class="yiv1746609403yqt1136114722" id="yiv1746609403yqt44587"><div>On Jun 18, 2020, at 1:58 AM, Steven Nunez <<a rel="nofollow" shape="rect" ymailto="mailto:steve_nunez@yahoo.com" target="_blank" href="mailto:steve_nunez@yahoo.com">steve_nunez@yahoo.com</a>> wrote:</div><br class="yiv1746609403Apple-interchange-newline" clear="none"><blockquote type="cite"><div><div class="yiv1746609403yahoo-style-wrap" style="font-family:Helvetica Neue, Helvetica, Arial, sans-serif;font-size:13px;"><div dir="ltr">Greetings all,</div><div dir="ltr"><br clear="none"></div><div dir="ltr">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 <font face="lucida console, sans-serif">atanh</font>, 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.</div><div dir="ltr"><br clear="none"></div><div dir="ltr">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.</div><div dir="ltr"><br clear="none"></div><div dir="ltr"><div><font face="lucida console, sans-serif"> (ff:def-foreign-call (%erf "erf") ((x :double))<br clear="none"> :returning :double)<br clear="none"> (ff:def-foreign-call (%erff "erff") ((x :float))<br clear="none"> :returning :float)<br clear="none"> (defun erf (x)<br clear="none"> "Returns the error function value for x"<br clear="none"> (cond ((typep x 'double-float) (%erf x))<br clear="none"> ((typep x 'single-float) (%erff x))))</font></div><div><br clear="none"></div></div><div dir="ltr"><br clear="none"></div><div dir="ltr">Whereas in the CCL code there's <font face="lucida console, sans-serif">%setf-double-float</font>, and <font face="lucida console, sans-serif">target::with-stack-double-floats</font>, 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.<br clear="none"></div><div dir="ltr"><br clear="none"></div><div dir="ltr">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.<br clear="none"></div><div dir="ltr"><br clear="none"></div><div dir="ltr"><font face="lucida console, sans-serif"><br clear="none"></font></div><div dir="ltr"><div><font face="lucida console, sans-serif">#+windows-target<br clear="none">(progn<br clear="none">(defun %double-float-atanh! (n result)<br clear="none"> (declare (double-float n result))<br clear="none"> (with-stack-double-floats ((temp))<br clear="none"> (%setf-double-float TEMP (external-call "atanh" :double n :double))<br clear="none"> (%df-check-exception-1 'atanh n (%ffi-exception-status))<br clear="none"> (%setf-double-float result TEMP)))<br clear="none"><br clear="none">#+32-bit-target<br clear="none">(defun %single-float-atanh! (n result)<br clear="none"> (declare (single-float n result)) <br clear="none"> (target::with-stack-short-floats ((temp))<br clear="none"> #+arm-target (%set-fpscr-status 0)<br clear="none"> (%setf-short-float TEMP (external-call "atanhf" :float n :float))<br clear="none"> (%sf-check-exception-1 'atanh n (%ffi-exception-status))<br clear="none"> (%setf-short-float result TEMP)))<br clear="none"><br clear="none">#+64-bit-target<br clear="none">(defun %single-float-atanh (n)<br clear="none"> (declare (single-float n)) <br clear="none"> (let* ((result (external-call "atanhf" :float n :float)))<br clear="none"> (%sf-check-exception-1 'atanh n (%ffi-exception-status))<br clear="none"></font><div><font face="lucida console, sans-serif"> result))</font><font face="lucida console, sans-serif">)</font></div><div><font face="lucida console, sans-serif"><br clear="none"></font></div><div dir="ltr"><div><font face="lucida console, sans-serif">(defun atan (y &optional (x nil x-p))<br clear="none"> "Return the arc tangent of Y if X is omitted or Y/X if X is supplied."<br clear="none"> (cond (x-p<br clear="none"> (cond ((or (typep x 'double-float)<br clear="none"> (typep y 'double-float))<br clear="none"> (with-stack-double-floats ((dy y)<br clear="none"> (dx x))<br clear="none"> (%df-atan2 dy dx)))<br clear="none"> (t<br clear="none"> (when (and (rationalp x) (rationalp y))<br clear="none"> ;; rescale arguments so that the maximum absolute value is 1<br clear="none"> (let ((x1 (abs x)) (y1 (abs y)))<br clear="none"> (cond ((> y1 x1)<br clear="none"> (setf x (/ x y1))<br clear="none"> (setf y (signum y)))<br clear="none"> ((not (zerop x))<br clear="none"> (setf y (/ y x1))<br clear="none"> (setf x (signum x))))))<br clear="none"> #+32-bit-target<br clear="none"> (target::with-stack-short-floats ((sy y)<br clear="none"> (sx x))<br clear="none"> (%sf-atan2! sy sx))<br clear="none"> #+64-bit-target<br clear="none"> (%sf-atan2 (%short-float y) (%short-float x)))))<br clear="none"> ((typep y 'double-float)<br clear="none"> (%double-float-atan! y (%make-dfloat)))<br clear="none"> ((typep y 'single-float)<br clear="none"> #+32-bit-target<br clear="none"> (%single-float-atan! y (%make-sfloat))<br clear="none"> #+64-bit-target<br clear="none"> (%single-float-atan y))<br clear="none"> ((typep y 'rational)<br clear="none"> (cond ((<= (abs y) most-positive-short-float)<br clear="none"> #+32-bit-target<br clear="none"> (target::with-stack-short-floats ((sy y))<br clear="none"> (%single-float-atan! sy (%make-sfloat)))<br clear="none"> #+64-bit-target<br clear="none"> (%single-float-atan (%short-float y)))<br clear="none"> ((minusp y)<br clear="none"> #.(- single-float-half-pi))<br clear="none"> (t<br clear="none"> single-float-half-pi)))<br clear="none"> (t<br clear="none"> (let ((r (realpart y))<br clear="none"> (i (imagpart y)))<br clear="none"> (if (zerop i)<br clear="none"> (complex (atan r) i)<br clear="none"> (i* (%complex-atanh (complex (- i) r)) -1))))))</font></div><div><br clear="none"></div></div></div><div><br clear="none"></div></div></div></div>_______________________________________________<br clear="none">Openmcl-devel mailing list<br clear="none"><a rel="nofollow" shape="rect" ymailto="mailto:Openmcl-devel@clozure.com" target="_blank" href="mailto:Openmcl-devel@clozure.com">Openmcl-devel@clozure.com</a><br clear="none">https://lists.clozure.com/mailman/listinfo/openmcl-devel<br clear="none"></blockquote></div></div><br clear="none"></div></div></div></div>
</div>
</div></body></html>