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: bit-extract using mpz Date: Sat, 15 Nov 2003 08:21:54 +1000 Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Message-ID: <87islm7fr1.fsf@zip.com.au> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1068848723 29360 80.91.224.253 (14 Nov 2003 22:25:23 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Fri, 14 Nov 2003 22:25:23 +0000 (UTC) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Fri Nov 14 23:25:21 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 1AKmNU-0003su-00 for ; Fri, 14 Nov 2003 23:25:20 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.24) id 1AKnKm-0004oz-N8 for guile-devel@m.gmane.org; Fri, 14 Nov 2003 18:26:36 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.24) id 1AKnJd-0004Xe-MR for guile-devel@gnu.org; Fri, 14 Nov 2003 18:25:25 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.24) id 1AKnIr-0003QB-3M for guile-devel@gnu.org; Fri, 14 Nov 2003 18:25:08 -0500 Original-Received: from [199.232.41.8] (helo=mx20.gnu.org) by monty-python.gnu.org with esmtp (TLSv1:DES-CBC3-SHA:168) (Exim 4.24) id 1AKnIq-0003Ib-Af for guile-devel@gnu.org; Fri, 14 Nov 2003 18:24:36 -0500 Original-Received: from [61.8.0.36] (helo=snoopy.pacific.net.au) by mx20.gnu.org with esmtp (Exim 4.24) id 1AKmKb-0004Ow-23 for guile-devel@gnu.org; Fri, 14 Nov 2003 17:22:21 -0500 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 hAEMMIV0015719 for ; Sat, 15 Nov 2003 09:22:18 +1100 Original-Received: from localhost (ppp22.dyn228.pacific.net.au [203.143.228.22]) by mongrel.pacific.net.au (8.12.3/8.12.3/Debian-6.6) with ESMTP id hAEML0DJ006450 for ; Sat, 15 Nov 2003 09:21:00 +1100 Original-Received: from gg by localhost with local (Exim 3.35 #1 (Debian)) id 1AKmKB-0004x1-00; Sat, 15 Nov 2003 08:21:55 +1000 Original-To: guile-devel@gnu.org Mail-Copies-To: never 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:3023 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:3023 --=-=-= * numbers.c (scm_bit_extract): Use mpz functions, rearrange inum case to share some shifting. The existing bit-operations.test does a good job on this, I couldn't spot further cases that wanted exercising. New code, for ease of contemplation: #define MIN(x,y) ((x) < (y) ? (x) : (y)) SCM_DEFINE (scm_bit_extract, "bit-extract", 3, 0, 0, (SCM n, SCM start, SCM end), "Return the integer composed of the @var{start} (inclusive)\n" "through @var{end} (exclusive) bits of @var{n}. The\n" "@var{start}th bit becomes the 0-th bit in the result.\n" "\n" "@lisp\n" "(number->string (bit-extract #b1101101010 0 4) 2)\n" " @result{} \"1010\"\n" "(number->string (bit-extract #b1101101010 4 9) 2)\n" " @result{} \"10110\"\n" "@end lisp") #define FUNC_NAME s_scm_bit_extract { unsigned long int istart, iend, bits; SCM_VALIDATE_INUM_MIN_COPY (2, start,0, istart); SCM_VALIDATE_INUM_MIN_COPY (3, end, 0, iend); SCM_ASSERT_RANGE (3, end, (iend >= istart)); /* how many bits to keep */ bits = iend - istart; if (SCM_INUMP (n)) { long int in = SCM_INUM (n); /* When istart>=SCM_I_FIXNUM_BIT we can just limit the shift to SCM_I_FIXNUM_BIT-1 to get either 0 or -1 per the sign of "in". FIXME: This shift relies on signed right shifts being arithmetic, which is not guaranteed by C99. */ in >>= MIN (istart, SCM_I_FIXNUM_BIT-1); if (in < 0 && bits >= SCM_I_FIXNUM_BIT) { /* Since we emulate two's complement encoded numbers, this * special case requires us to produce a result that has * more bits than can be stored in a fixnum. */ SCM result = scm_i_long2big (in); mpz_fdiv_r_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result), bits); return result; } /* mask down to requisite bits */ bits = MIN (bits, SCM_I_FIXNUM_BIT); return SCM_MAKINUM (in & ((1L << bits) - 1)); } else if (SCM_BIGP (n)) { SCM result; if (bits == 1) { result = SCM_MAKINUM (mpz_tstbit (SCM_I_BIG_MPZ (n), istart)); } else { /* ENHANCE-ME: It'd be nice not to allocate a new bignum when bits= istart)); + /* how many bits to keep */ + bits = iend - istart; + if (SCM_INUMP (n)) { long int in = SCM_INUM (n); - unsigned long int bits = iend - istart; + + /* When istart>=SCM_I_FIXNUM_BIT we can just limit the shift to + SCM_I_FIXNUM_BIT-1 to get either 0 or -1 per the sign of "in". + FIXME: This shift relies on signed right shifts being arithmetic, + which is not guaranteed by C99. */ + in >>= MIN (istart, SCM_I_FIXNUM_BIT-1); if (in < 0 && bits >= SCM_I_FIXNUM_BIT) { /* Since we emulate two's complement encoded numbers, this * special case requires us to produce a result that has - * more bits than can be stored in a fixnum. Thus, we fall - * back to the more general algorithm that is used for - * bignums. + * more bits than can be stored in a fixnum. */ - goto generalcase; + SCM result = scm_i_long2big (in); + mpz_fdiv_r_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result), + bits); + return result; } - if (istart < SCM_I_FIXNUM_BIT) - { - in = in >> istart; - if (bits < SCM_I_FIXNUM_BIT) - return SCM_MAKINUM (in & ((1L << bits) - 1)); - else /* we know: in >= 0 */ - return SCM_MAKINUM (in); - } - else if (in < 0) - return SCM_MAKINUM (-1L & ((1L << bits) - 1)); - else - return SCM_MAKINUM (0); + /* mask down to requisite bits */ + bits = MIN (bits, SCM_I_FIXNUM_BIT); + return SCM_MAKINUM (in & ((1L << bits) - 1)); } else if (SCM_BIGP (n)) { - generalcase: - { - SCM num1 = SCM_MAKINUM (1L); - SCM num2 = SCM_MAKINUM (2L); - SCM bits = SCM_MAKINUM (iend - istart); - SCM mask = scm_difference (scm_integer_expt (num2, bits), num1); - return scm_logand (mask, scm_ash (n, SCM_MAKINUM (-istart))); - } + SCM result; + if (bits == 1) + { + result = SCM_MAKINUM (mpz_tstbit (SCM_I_BIG_MPZ (n), istart)); + } + else + { + /* ENHANCE-ME: It'd be nice not to allocate a new bignum when + bits