<html><head></head><body><div class="yahoo-style-wrap" style="font-family:Helvetica Neue, Helvetica, Arial, sans-serif;font-size:13px;"><div dir="ltr" data-setdir="false">Greetings all,</div><div dir="ltr" data-setdir="false"><br></div><div dir="ltr" data-setdir="false">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" data-setdir="false"><br></div><div dir="ltr" data-setdir="false">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" data-setdir="false"><br></div><div dir="ltr" data-setdir="false"><div><font face=""lucida console", sans-serif"> (ff:def-foreign-call (%erf "erf") ((x :double))<br> :returning :double)<br> (ff:def-foreign-call (%erff "erff") ((x :float))<br> :returning :float)<br> (defun erf (x)<br> "Returns the error function value for x"<br> (cond ((typep x 'double-float) (%erf x))<br> ((typep x 'single-float) (%erff x))))</font></div><div><br></div></div><div dir="ltr" data-setdir="false"><br></div><div dir="ltr" data-setdir="false">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></div><div dir="ltr" data-setdir="false"><br></div><div dir="ltr" data-setdir="false">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></div><div dir="ltr" data-setdir="false"><br></div><div dir="ltr" data-setdir="false"><font face=""lucida console", sans-serif"><br></font></div><div dir="ltr" data-setdir="false"><div><font face=""lucida console", sans-serif">#+windows-target<br>(progn<br>(defun %double-float-atanh! (n result)<br> (declare (double-float n result))<br> (with-stack-double-floats ((temp))<br> (%setf-double-float TEMP (external-call "atanh" :double n :double))<br> (%df-check-exception-1 'atanh n (%ffi-exception-status))<br> (%setf-double-float result TEMP)))<br><br>#+32-bit-target<br>(defun %single-float-atanh! (n result)<br> (declare (single-float n result)) <br> (target::with-stack-short-floats ((temp))<br> #+arm-target (%set-fpscr-status 0)<br> (%setf-short-float TEMP (external-call "atanhf" :float n :float))<br> (%sf-check-exception-1 'atanh n (%ffi-exception-status))<br> (%setf-short-float result TEMP)))<br><br>#+64-bit-target<br>(defun %single-float-atanh (n)<br> (declare (single-float n)) <br> (let* ((result (external-call "atanhf" :float n :float)))<br> (%sf-check-exception-1 'atanh n (%ffi-exception-status))<br></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></font></div><div dir="ltr" data-setdir="false"><div><font face=""lucida console", sans-serif">(defun atan (y &optional (x nil x-p))<br> "Return the arc tangent of Y if X is omitted or Y/X if X is supplied."<br> (cond (x-p<br> (cond ((or (typep x 'double-float)<br> (typep y 'double-float))<br> (with-stack-double-floats ((dy y)<br> (dx x))<br> (%df-atan2 dy dx)))<br> (t<br> (when (and (rationalp x) (rationalp y))<br> ;; rescale arguments so that the maximum absolute value is 1<br> (let ((x1 (abs x)) (y1 (abs y)))<br> (cond ((> y1 x1)<br> (setf x (/ x y1))<br> (setf y (signum y)))<br> ((not (zerop x))<br> (setf y (/ y x1))<br> (setf x (signum x))))))<br> #+32-bit-target<br> (target::with-stack-short-floats ((sy y)<br> (sx x))<br> (%sf-atan2! sy sx))<br> #+64-bit-target<br> (%sf-atan2 (%short-float y) (%short-float x)))))<br> ((typep y 'double-float)<br> (%double-float-atan! y (%make-dfloat)))<br> ((typep y 'single-float)<br> #+32-bit-target<br> (%single-float-atan! y (%make-sfloat))<br> #+64-bit-target<br> (%single-float-atan y))<br> ((typep y 'rational)<br> (cond ((<= (abs y) most-positive-short-float)<br> #+32-bit-target<br> (target::with-stack-short-floats ((sy y))<br> (%single-float-atan! sy (%make-sfloat)))<br> #+64-bit-target<br> (%single-float-atan (%short-float y)))<br> ((minusp y)<br> #.(- single-float-half-pi))<br> (t<br> single-float-half-pi)))<br> (t<br> (let ((r (realpart y))<br> (i (imagpart y)))<br> (if (zerop i)<br> (complex (atan r) i)<br> (i* (%complex-atanh (complex (- i) r)) -1))))))</font></div><div><br></div></div></div><div><br></div></div></div></body></html>