From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Kevin Ryde Newsgroups: gmane.lisp.guile.devel Subject: ash using shifts (was: ratio implementation) Date: Sat, 18 Oct 2003 10:55:31 +1000 Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Message-ID: <87znfz4b5o.fsf_-_@zip.com.au> References: <3F250809.9030108@ccrma.stanford.edu> <87smmyibk7.fsf@zagadka.ping.de> <3F6637EC.7010004@dirk-herrmanns-seiten.de> <3F66F68B.3070100@ccrma.stanford.edu> <3F6A1F1A.8000507@dirk-herrmanns-seiten.de> <87pth9cbmt.fsf@zagadka.ping.de> <3F8A853D.1020708@ccrma> <87n0c3zaoh.fsf@zip.com.au> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1066438639 4779 80.91.224.253 (18 Oct 2003 00:57:19 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Sat, 18 Oct 2003 00:57:19 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sat Oct 18 02:57:17 2003 Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1AAfPB-0008KG-00 for ; Sat, 18 Oct 2003 02:57:17 +0200 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.24) id 1AAfOH-0002Ih-I4 for guile-devel@m.gmane.org; Fri, 17 Oct 2003 20:56:21 -0400 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.24) id 1AAfOD-0002IY-KF for guile-devel@gnu.org; Fri, 17 Oct 2003 20:56:17 -0400 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.24) id 1AAfNh-0002Cz-JR for guile-devel@gnu.org; Fri, 17 Oct 2003 20:56:16 -0400 Original-Received: from [61.8.0.36] (helo=snoopy.pacific.net.au) by monty-python.gnu.org with esmtp (Exim 4.24) id 1AAfNg-0002BJ-O8 for guile-devel@gnu.org; Fri, 17 Oct 2003 20:55:45 -0400 Original-Received: from mongrel.pacific.net.au (mongrel.pacific.net.au [61.8.0.107]) by snoopy.pacific.net.au (8.12.3/8.12.3/Debian-6.6) with ESMTP id h9I0thUC031732 for ; Sat, 18 Oct 2003 10:55:43 +1000 Original-Received: from localhost (ppp60.dyn228.pacific.net.au [203.143.228.60]) by mongrel.pacific.net.au (8.12.3/8.12.3/Debian-6.6) with ESMTP id h9I0pcst025037 for ; Sat, 18 Oct 2003 10:51:38 +1000 Original-Received: from gg by localhost with local (Exim 3.35 #1 (Debian)) id 1AAfNW-0001py-00; Sat, 18 Oct 2003 10:55:34 +1000 Original-To: guile-devel@gnu.org Mail-Copies-To: never In-Reply-To: <87n0c3zaoh.fsf@zip.com.au> (Kevin Ryde's message of "Wed, 15 Oct 2003 09:01:02 +1000") User-Agent: Gnus/5.1003 (Gnus v5.10.3) Emacs/21.3 (gnu/linux) X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.2 Precedence: list List-Id: Developers list for Guile, the GNU extensibility library List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: main.gmane.org gmane.lisp.guile.devel:2902 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:2902 --=-=-= Speaking of ash, the bit of code below is what I'm looking at for shifts instead of mul or div. Untested as yet, but hopefully not too far wrong. Anyone who wants to take it forward should feel free ... or kick it into touch and do something different. --=-=-= Content-Type: text/x-csrc Content-Disposition: attachment; filename=ash.c SCM_DEFINE (scm_ash, "ash", 2, 0, 0, (SCM n, SCM cnt), "Return @var{n} shifted left by @var{cnt} bits, or shifted right\n" "if @var{cnt} is negative. This is an ``arithmetic'' shift.\n" "\n" "This is effectively a multiplication by @m{2^{cnt},\n" "2^@var{cnt}}, and when @var{cnt} is negative it's a division,\n" "rounded towards negative infinity. (Note that this is not the\n" "same rounding as @code{quotient} does.)\n" "\n" "With @var{n} viewed as an infinite precision twos complement,\n" "@code{ash} means a left shift introducing zero bits, or a right\n" "shift dropping bits.\n" "\n" "@lisp\n" "(number->string (ash #b1 3) 2) @result{} \"1000\"\n" "(number->string (ash #b1010 -1) 2) @result{} \"101\"\n" "\n" ";; -23 is bits ...11101001, -6 is bits ...111010\n" "(ash -23 -2) @result{} -6\n" "@end lisp") #define FUNC_NAME s_scm_ash { long bits_to_shift; SCM_VALIDATE_INUM (2, cnt); bits_to_shift = SCM_INUM (cnt); if (SCM_INUMP (y)) { long in = SCM_INUM (n); if (bits_to_shift > 0) { /* Left shift of more than SCM_I_FIXNUM_BIT-1 will certainly overflow a non-zero fixnum. For smaller shifts we check the bits going into positions above SCM_I_FIXNUM_BIT-1. If they're all 0s for in>=0, or all 1s for in<0 then there's no overflow. Those bits are "in >> (SCM_I_FIXNUM_BIT-1 - bits_to_shift". */ if (in == 0) return n; /* FIXME: This relies on signed right shifts being arithmetic, which is not guaranteed by C99. */ if (bits_to_shift < SCM_I_FIXNUM_BIT-1 && ((unsigned long) ((in >> (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1 <= 1))) { return SCM_MKINUM (in << bits_to_shift); } else { SCM result = scm_i_long2big (z); mpz_mul_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result), bits_to_shift); return result; } } else { bits_to_shift = -bits_to_shift; if (bits_to_shift >= LONG_BIT) return (in >= ? 0 : -1); else { /* FIXME: This relies on signed right shifts being arithmetic, which is not guaranteed by C99. */ return SCM_MKINUM (in >> bits_to_shift); } } } else if (SCM_BIGP (n)) { SCM result; if (bits_to_shift == 0) return n; result = scm_i_mkbig (); if (bits_to_shift >= 0) { mpz_mul_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (n), bits_to_shift); return result; } else { /* GMP doesn't have an fdiv_q_2exp variant returning just a long, so we have to allocate a bignum even if the result is going to be a fixnum. We could detect the case of bits_to_shift being so big as to leave us with only 0 or -1, and avoid allocating a bignum, but that doesn't seem worth worrying about. */ mpz_fdiv_q_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (n), -bits_to_shift); return scm_i_normbig (result); } } else { SCM_WRONG_TYPE_ARG (SCM_ARG1, n); } } #undef FUNC_NAME --=-=-= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://mail.gnu.org/mailman/listinfo/guile-devel --=-=-=--