mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
fix bug in ash opcode
* libguile/vm-i-scheme.c (ash): Fix embarrassing bug in (ash 1 32). * test-suite/tests/bit-operations.test ("bitshifts on word boundaries"): Add tests.
This commit is contained in:
parent
e275b8a220
commit
8ecd1943ef
2 changed files with 21 additions and 4 deletions
|
@ -287,10 +287,23 @@ VM_DEFINE_FUNCTION (157, ash, "ash", 2)
|
|||
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
|
||||
{
|
||||
if (SCM_I_INUM (y) < 0)
|
||||
/* Right shift, will be a fixnum. */
|
||||
RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) >> -SCM_I_INUM (y)));
|
||||
else if ((SCM_I_INUM (x) << SCM_I_INUM (y)) >> SCM_I_INUM (y)
|
||||
== SCM_I_INUM (x))
|
||||
RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) << SCM_I_INUM (y)));
|
||||
else
|
||||
/* Left shift. See comments in scm_ash. */
|
||||
{
|
||||
long nn, bits_to_shift;
|
||||
|
||||
nn = SCM_I_INUM (x);
|
||||
bits_to_shift = SCM_I_INUM (y);
|
||||
|
||||
if (bits_to_shift < SCM_I_FIXNUM_BIT-1
|
||||
&& ((unsigned long)
|
||||
(SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1)
|
||||
<= 1))
|
||||
RETURN (SCM_I_MAKINUM (nn << bits_to_shift));
|
||||
/* fall through */
|
||||
}
|
||||
/* fall through */
|
||||
}
|
||||
SYNC_REGISTER ();
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;;; bit-operations.test --- bitwise operations on numbers -*- scheme -*-
|
||||
;;;; Copyright (C) 2000, 2001, 2003, 2006, 2009 Free Software Foundation, Inc.
|
||||
;;;; Copyright (C) 2000, 2001, 2003, 2006, 2009, 2010 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
@ -362,3 +362,7 @@
|
|||
(+ fixnum-bit fixnum-bit 1) (- (ash 1 (+ fixnum-bit 1)) 1))
|
||||
(list (- fixnum-min 1) (+ fixnum-bit 1)
|
||||
(+ fixnum-bit fixnum-bit 2) (- (ash 1 (+ fixnum-bit 1)) 1))))))
|
||||
|
||||
(with-test-prefix "bitshifts on word boundaries"
|
||||
(pass-if (= (ash 1 32) 4294967296))
|
||||
(pass-if (= (ash 1 64) 18446744073709551616)))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue