<html><head><meta http-equiv="Content-Type" content="text/html charset=windows-1252"></head><body style="word-wrap: break-word; -webkit-nbsp-mode: space; -webkit-line-break: after-white-space;">I’m happy to hear that Clozure is still active.  If there’s any interest in engaging them to write up some documentation about the design rationale behind CCL I’d be more than happy to chip in a substantial portion of the cost.<div><br></div><div>rg</div><div><br><div><div>On Jun 18, 2020, at 5:32 PM, martin <<a href="mailto:brooks.martin@sympatico.ca">brooks.martin@sympatico.ca</a>> wrote:</div><br class="Apple-interchange-newline"><blockquote type="cite"><meta http-equiv="Content-Type" content="text/html; charset=us-ascii"><div style="word-wrap: break-word; -webkit-nbsp-mode: space; line-break: after-white-space;" class="">Hello CCL fans, I will relate a somewhat parallel story.<div class="">My application requires exact arithmetic, i.e. bignum rationals.</div><div class="">CCL 11 conses like crazy for bignum rationals, whereas CCL 12 has a specialized implementation.</div><div class="">This happened because I engaged Clozure Associates to solve my bignum rational problem, which they totally did.</div><div class="">Prior to engaging CA I raided the CCL code to use the low-level allocation and arithmetic %functions, as in the examples below.</div><div class=""><br class=""></div><div class="">Martin</div><div class=""><br class=""></div><div class=""><div class=""><div><br class=""><blockquote type="cite" class=""><div class="">On Jun 18, 2020, at 7:56 PM, Steven Nunez <<a href="mailto:steve_nunez@yahoo.com" class="">steve_nunez@yahoo.com</a>> wrote:</div><br class="Apple-interchange-newline"><div class=""><div class=""><div class="ydpde0f8651yahoo-style-wrap" style="font-family:Helvetica Neue, Helvetica, Arial, sans-serif;font-size:13px;"><div class=""></div>
        <div dir="ltr" data-setdir="false" class=""><div class=""><div dir="ltr" class="">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" class=""></div><div class=""><br clear="none" class=""><br class=""></div></div><div class=""><br class=""></div></div><div class=""><br class=""></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;" class="">
                
                <div class="">
                    On Friday, June 19, 2020, 5:01:20 AM GMT+8, Ron Garret <<a href="mailto:ron@flownet.com" class="">ron@flownet.com</a>> wrote:
                </div>
                <div class=""><br class=""></div>
                <div class=""><br class=""></div>
                <div class=""><div id="yiv1746609403" class=""><div class="">The best way to answer performance questions is just to run some benchmarks.<div class=""><br clear="none" class=""><div class=""><div class="yiv1746609403yqt1136114722" id="yiv1746609403yqt44587"><div class="">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" class="">steve_nunez@yahoo.com</a>> wrote:</div><br class="yiv1746609403Apple-interchange-newline" clear="none"><blockquote type="cite" class=""><div class=""><div class="yiv1746609403yahoo-style-wrap" style="font-family:Helvetica Neue, Helvetica, Arial, sans-serif;font-size:13px;"><div dir="ltr" class="">Greetings all,</div><div dir="ltr" class=""><br clear="none" class=""></div><div dir="ltr" class="">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" class="">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" class=""><br clear="none" class=""></div><div dir="ltr" class="">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" class=""><br clear="none" class=""></div><div dir="ltr" class=""><div class=""><font face="lucida console, sans-serif" class="">  (ff:def-foreign-call (%erf "erf") ((x :double))<br clear="none" class="">    :returning :double)<br clear="none" class="">  (ff:def-foreign-call (%erff "erff") ((x :float))<br clear="none" class="">    :returning :float)<br clear="none" class="">  (defun erf (x)<br clear="none" class="">    "Returns the error function value for x"<br clear="none" class="">    (cond ((typep x 'double-float) (%erf x))<br clear="none" class="">      ((typep x 'single-float) (%erff x))))</font></div><div class=""><br clear="none" class=""></div></div><div dir="ltr" class=""><br clear="none" class=""></div><div dir="ltr" class="">Whereas in the CCL code there's <font face="lucida console, sans-serif" class="">%setf-double-float</font>, and <font face="lucida console, sans-serif" class="">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" class=""></div><div dir="ltr" class=""><br clear="none" class=""></div><div dir="ltr" class="">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" class=""></div><div dir="ltr" class=""><br clear="none" class=""></div><div dir="ltr" class=""><font face="lucida console, sans-serif" class=""><br clear="none" class=""></font></div><div dir="ltr" class=""><div class=""><font face="lucida console, sans-serif" class="">#+windows-target<br clear="none" class="">(progn<br clear="none" class="">(defun %double-float-atanh! (n result)<br clear="none" class="">  (declare (double-float n result))<br clear="none" class="">  (with-stack-double-floats ((temp))<br clear="none" class="">    (%setf-double-float TEMP (external-call "atanh" :double n :double))<br clear="none" class="">    (%df-check-exception-1 'atanh n (%ffi-exception-status))<br clear="none" class="">    (%setf-double-float result TEMP)))<br clear="none" class=""><br clear="none" class="">#+32-bit-target<br clear="none" class="">(defun %single-float-atanh! (n result)<br clear="none" class="">  (declare (single-float n result)) <br clear="none" class="">  (target::with-stack-short-floats ((temp))<br clear="none" class="">    #+arm-target (%set-fpscr-status 0)<br clear="none" class="">    (%setf-short-float TEMP (external-call "atanhf" :float n :float))<br clear="none" class="">    (%sf-check-exception-1 'atanh n (%ffi-exception-status))<br clear="none" class="">    (%setf-short-float result TEMP)))<br clear="none" class=""><br clear="none" class="">#+64-bit-target<br clear="none" class="">(defun %single-float-atanh (n)<br clear="none" class="">  (declare (single-float n)) <br clear="none" class="">  (let* ((result (external-call "atanhf" :float n :float)))<br clear="none" class="">    (%sf-check-exception-1 'atanh n (%ffi-exception-status))<br clear="none" class=""></font><div class=""><font face="lucida console, sans-serif" class="">    result))</font><font face="lucida console, sans-serif" class="">)</font></div><div class=""><font face="lucida console, sans-serif" class=""><br clear="none" class=""></font></div><div dir="ltr" class=""><div class=""><font face="lucida console, sans-serif" class="">(defun atan (y &optional (x nil x-p))<br clear="none" class="">  "Return the arc tangent of Y if X is omitted or Y/X if X is supplied."<br clear="none" class="">  (cond (x-p<br clear="none" class="">         (cond ((or (typep x 'double-float)<br clear="none" class="">                    (typep y 'double-float))<br clear="none" class="">                (with-stack-double-floats ((dy y)<br clear="none" class="">                                           (dx x))<br clear="none" class="">                  (%df-atan2 dy dx)))<br clear="none" class="">               (t<br clear="none" class="">                (when (and (rationalp x) (rationalp y))<br clear="none" class="">                  ;; rescale arguments so that the maximum absolute value is 1<br clear="none" class="">                  (let ((x1 (abs x)) (y1 (abs y)))<br clear="none" class="">                    (cond ((> y1 x1)<br clear="none" class="">                           (setf x (/ x y1))<br clear="none" class="">                           (setf y (signum y)))<br clear="none" class="">                          ((not (zerop x))<br clear="none" class="">                           (setf y (/ y x1))<br clear="none" class="">                           (setf x (signum x))))))<br clear="none" class="">                #+32-bit-target<br clear="none" class="">                (target::with-stack-short-floats ((sy y)<br clear="none" class="">                                                  (sx x))<br clear="none" class="">                  (%sf-atan2! sy sx))<br clear="none" class="">                #+64-bit-target<br clear="none" class="">                (%sf-atan2 (%short-float y) (%short-float x)))))<br clear="none" class="">        ((typep y 'double-float)<br clear="none" class="">         (%double-float-atan! y (%make-dfloat)))<br clear="none" class="">        ((typep y 'single-float)<br clear="none" class="">         #+32-bit-target<br clear="none" class="">         (%single-float-atan! y (%make-sfloat))<br clear="none" class="">         #+64-bit-target<br clear="none" class="">         (%single-float-atan y))<br clear="none" class="">        ((typep y 'rational)<br clear="none" class="">         (cond ((<= (abs y) most-positive-short-float)<br clear="none" class="">                #+32-bit-target<br clear="none" class="">                (target::with-stack-short-floats ((sy y))<br clear="none" class="">                  (%single-float-atan! sy (%make-sfloat)))<br clear="none" class="">                #+64-bit-target<br clear="none" class="">                (%single-float-atan (%short-float y)))<br clear="none" class="">               ((minusp y)<br clear="none" class="">                #.(- single-float-half-pi))<br clear="none" class="">               (t<br clear="none" class="">                single-float-half-pi)))<br clear="none" class="">        (t<br clear="none" class="">         (let ((r (realpart y))<br clear="none" class="">               (i (imagpart y)))<br clear="none" class="">           (if (zerop i)<br clear="none" class="">             (complex (atan r) i)<br clear="none" class="">             (i* (%complex-atanh (complex (- i) r)) -1))))))</font></div><div class=""><br clear="none" class=""></div></div></div><div class=""><br clear="none" class=""></div></div></div></div>_______________________________________________<br clear="none" class="">Openmcl-devel mailing list<br clear="none" class=""><a rel="nofollow" shape="rect" ymailto="mailto:Openmcl-devel@clozure.com" target="_blank" href="mailto:Openmcl-devel@clozure.com" class="">Openmcl-devel@clozure.com</a><br clear="none" class=""><a href="https://lists.clozure.com/mailman/listinfo/openmcl-devel" class="">https://lists.clozure.com/mailman/listinfo/openmcl-devel</a><br clear="none" class=""></blockquote></div></div><br clear="none" class=""></div></div></div></div>
            </div>
        </div></div>_______________________________________________<br class="">Openmcl-devel mailing list<br class=""><a href="mailto:Openmcl-devel@clozure.com" class="">Openmcl-devel@clozure.com</a><br class=""><a href="https://lists.clozure.com/mailman/listinfo/openmcl-devel">https://lists.clozure.com/mailman/listinfo/openmcl-devel</a><br class=""></div></blockquote></div><br class=""></div></div></div>_______________________________________________<br>Openmcl-devel mailing list<br><a href="mailto:Openmcl-devel@clozure.com">Openmcl-devel@clozure.com</a><br>https://lists.clozure.com/mailman/listinfo/openmcl-devel<br></blockquote></div><br></div></body></html>