Add new primitive INTEGER-SHIFT-LEFT. This is a very fast way to

multiply an integer by a power of two.

diff --git a/v7/src/microcode/artutl.c b/v7/src/microcode/artutl.c
index 68aebb9b25049b80ab3cd0f0aa98bb26a7923099..218fd71b0888163b537af1ccb4cfdc522588dc35 100644 (file)
--- a/v7/src/microcode/artutl.c
+++ b/v7/src/microcode/artutl.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: artutl.c,v 1.13 1997/04/22 22:42:16 cph Exp $
+$Id: artutl.c,v 1.14 1997/04/23 05:40:18 cph Exp $
 
 Copyright (c) 1989-97 Massachusetts Institute of Technology
 
@@ -462,24 +462,46 @@ DEFUN (integer_remainder, (n, d), SCHEME_OBJECT n AND SCHEME_OBJECT d)
   }
 }
 \f
+static unsigned long
+DEFUN (unsigned_long_length_in_bits, (n), unsigned long n)
+{
+  unsigned long result = 0;
+  while (n > 0)
+    {
+      result += 1;
+      n >>= 1;
+    }
+  return (result);
+}
+
 SCHEME_OBJECT
 DEFUN (integer_length_in_bits, (n), SCHEME_OBJECT n)
 {
   if (FIXNUM_P (n))
     {
       long n1 = (FIXNUM_TO_LONG (n));
-      unsigned long n2 = ((n1 < 0) ? (- n1) : n1);
-      unsigned long result = ((sizeof (unsigned long)) * CHAR_BIT);
-      unsigned long m = (1 << (result - 1));
-      while (result > 0)
-       {
-         if (n2 >= m)
-           break;
-         result -= 1;
-         m >>= 1;
-       }
-      return (LONG_TO_UNSIGNED_FIXNUM (result));
+      return (LONG_TO_UNSIGNED_FIXNUM
+             (unsigned_long_length_in_bits ((n1 < 0) ? (- n1) : n1)));
     }
   else
     return (bignum_length_in_bits (n));
 }
+
+SCHEME_OBJECT
+DEFUN (integer_shift_left, (n, m), SCHEME_OBJECT n AND unsigned long m)
+{
+  if ((m == 0) || (!integer_positive_p (n)))
+    return (n);
+  if (FIXNUM_P (n))
+    {
+      unsigned long n1 = (UNSIGNED_FIXNUM_TO_LONG (n));
+      unsigned long ln = (unsigned_long_length_in_bits (n1));
+      unsigned long lr = (ln + m);
+      return
+       ((lr <= FIXNUM_LENGTH)
+        ? (LONG_TO_UNSIGNED_FIXNUM (n1 << m))
+        : (unsigned_long_to_shifted_bignum (n1, m, 0)));
+    }
+  else
+    return (bignum_shift_left (n, m));
+}

diff --git a/v7/src/microcode/bignum.c b/v7/src/microcode/bignum.c
index 3b16c106feddbe5b193eb465ed2398fce578c9f5..8a7c70d20c7a8bffbb772d01d7fdfaf9eb92f5cb 100644 (file)
--- a/v7/src/microcode/bignum.c
+++ b/v7/src/microcode/bignum.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: bignum.c,v 9.43 1997/01/02 05:21:30 cph Exp $
+$Id: bignum.c,v 9.44 1997/04/23 05:40:11 cph Exp $
 
 Copyright (c) 1989-97 Massachusetts Institute of Technology
 
@@ -664,6 +664,90 @@ DEFUN_VOID (bignum_length_upper_limit)
 }
 \f
 bignum_type
+DEFUN (bignum_shift_left, (n, m), bignum_type n AND unsigned long m)
+{
+  unsigned long ln = (BIGNUM_LENGTH (n));
+  unsigned long delta = 0;
+  if (m == 0)
+    return (n);
+  {
+    bignum_digit_type digit = (BIGNUM_REF (n, (ln - 1)));
+    while (digit > 0)
+      {
+       delta += 1;
+       digit >>= 1;
+      }
+  }
+  {
+    unsigned long zeroes = (m / BIGNUM_DIGIT_LENGTH);
+    unsigned long shift = (m % BIGNUM_DIGIT_LENGTH);
+    unsigned long ln2
+      = (((ln - 1) + ((delta + m) / BIGNUM_DIGIT_LENGTH))
+        + (((delta + m) % BIGNUM_DIGIT_LENGTH) != 0));
+    bignum_type result = (bignum_allocate (ln2, (BIGNUM_NEGATIVE_P (n))));
+    bignum_digit_type * scan_n = (BIGNUM_START_PTR (n));
+    bignum_digit_type * end_n = (scan_n + ln);
+    bignum_digit_type * scan_result = (BIGNUM_START_PTR (result));
+    while ((zeroes--) > 0)
+      (*scan_result++) = 0;
+    if (shift == 0)
+      while (scan_n < end_n)
+       (*scan_result++) = (*scan_n++);
+    else
+      {
+       unsigned long temp = 0;
+       while (scan_n < end_n)
+         {
+           bignum_digit_type digit = (*scan_n++);
+           (*scan_result++) = (((digit << shift) & BIGNUM_DIGIT_MASK) | temp);
+           temp = (digit >> (BIGNUM_DIGIT_LENGTH - shift));
+         }
+       if (temp != 0)
+         (*scan_result) = temp;
+      }
+    return (result);
+  }
+}
+
+bignum_type
+DEFUN (unsigned_long_to_shifted_bignum, (n, m, sign),
+       unsigned long n AND
+       unsigned long m AND
+       int sign)
+{
+  unsigned long delta = 0;
+  if (n == 0)
+    return (BIGNUM_ZERO ());
+  {
+    unsigned long n1 = n;
+    while (n1 > 0)
+      {
+       delta += 1;
+       n1 >>= 1;
+      }
+  }
+  {
+    unsigned long zeroes = (m / BIGNUM_DIGIT_LENGTH);
+    unsigned long shift = (m % BIGNUM_DIGIT_LENGTH);
+    unsigned long ln
+      = (((delta + m) / BIGNUM_DIGIT_LENGTH)
+        + (((delta + m) % BIGNUM_DIGIT_LENGTH) != 0));
+    bignum_type result = (bignum_allocate (ln, sign));
+    bignum_digit_type * scan_result = (BIGNUM_START_PTR (result));
+    while ((zeroes--) > 0)
+      (*scan_result++) = 0;
+    (*scan_result++) = ((n << shift) & BIGNUM_DIGIT_MASK);
+    n >>= (BIGNUM_DIGIT_LENGTH - shift);
+    while (n > 0)
+      {
+       (*scan_result++) = (n & BIGNUM_DIGIT_MASK);
+       n >>= BIGNUM_DIGIT_LENGTH;
+      }
+    return (result);
+  }
+}
+\f
+bignum_type
 DEFUN (digit_stream_to_bignum,
        (n_digits, producer, context, radix, negative_p),
        fast unsigned int n_digits

diff --git a/v7/src/microcode/bignum.h b/v7/src/microcode/bignum.h
index a25a24b480f7bb15a6fb075f44f9e3574b46ab69..d4d47ad5d3db3ac20d403df52ba26f9bebf7b59c 100644 (file)
--- a/v7/src/microcode/bignum.h
+++ b/v7/src/microcode/bignum.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: bignum.h,v 9.29 1996/10/02 18:57:02 cph Exp $
+$Id: bignum.h,v 9.30 1997/04/23 05:40:26 cph Exp $
 
-Copyright (c) 1989-96 Massachusetts Institute of Technology
+Copyright (c) 1989-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -92,6 +92,9 @@ extern int EXFUN
                           int twos_complement_p));
 extern bignum_type EXFUN (bignum_length_in_bits, (bignum_type));
 extern bignum_type EXFUN (bignum_length_upper_limit, (void));
+extern bignum_type EXFUN (bignum_shift_left, (bignum_type, unsigned long));
+extern bignum_type EXFUN
+  (unsigned_long_to_shifted_bignum, (unsigned long, unsigned long, int));
 extern bignum_type EXFUN
   (digit_stream_to_bignum,
    (unsigned int n_digits,

diff --git a/v7/src/microcode/extern.h b/v7/src/microcode/extern.h
index 29e540923f28e6ca0246dd4fb63a9a577f310579..a0a33b4867495ec422205b829bfa4c5341b033cd 100644 (file)
--- a/v7/src/microcode/extern.h
+++ b/v7/src/microcode/extern.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: extern.h,v 9.54 1997/04/22 22:42:25 cph Exp $
+$Id: extern.h,v 9.55 1997/04/23 05:41:03 cph Exp $
 
 Copyright (c) 1987-97 Massachusetts Institute of Technology
 
@@ -206,6 +206,8 @@ extern Boolean EXFUN (integer_divide,
 extern SCHEME_OBJECT EXFUN (integer_quotient, (SCHEME_OBJECT, SCHEME_OBJECT));
 extern SCHEME_OBJECT EXFUN (integer_remainder, (SCHEME_OBJECT, SCHEME_OBJECT));
 extern SCHEME_OBJECT EXFUN (integer_length_in_bits, (SCHEME_OBJECT));
+extern SCHEME_OBJECT EXFUN
+  (integer_shift_left, (SCHEME_OBJECT, SCHEME_OBJECT));
 
 /* Character utilities */
 extern long EXFUN (char_downcase, (long));

diff --git a/v7/src/microcode/intprm.c b/v7/src/microcode/intprm.c
index c7c15900c6eedb34da125576915efeb3e4407bf7..1b0e64355189d52b8af1a232166a0d448e39f7b4 100644 (file)
--- a/v7/src/microcode/intprm.c
+++ b/v7/src/microcode/intprm.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: intprm.c,v 1.5 1997/04/22 22:42:41 cph Exp $
+$Id: intprm.c,v 1.6 1997/04/23 05:40:32 cph Exp $
 
 Copyright (c) 1989-97 Massachusetts Institute of Technology
 
@@ -180,3 +180,16 @@ DEFINE_PRIMITIVE ("INTEGER->FLONUM", Prim_integer_to_flonum, 2, 2, 0)
     PRIMITIVE_RETURN (SHARP_F);
   }
 }
+
+DEFINE_PRIMITIVE ("INTEGER-SHIFT-LEFT", Prim_integer_shift_left, 2, 2, 0)
+{
+  PRIMITIVE_HEADER (2);
+  Set_Time_Zone (Zone_Math);
+  CHECK_ARG (1, INTEGER_P);
+  {
+    SCHEME_OBJECT n = (ARG_REF (1));
+    if (integer_negative_p (n))
+      error_bad_range_arg (1);
+    PRIMITIVE_RETURN (integer_shift_left (n, (arg_ulong_integer (2))));
+  }
+}