From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 22 Apr 1997 22:42:41 +0000 (+0000)
Subject: Implement new primitive INTEGER-LENGTH-IN-BITS.  This computes the
X-Git-Tag: 20090517-FFI~5213
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5fd3b6a3aadeb1e715731a412c867b898047adb3;p=mit-scheme.git

Implement new primitive INTEGER-LENGTH-IN-BITS.  This computes the
length of a non-negative integer in the obvious way; it computes the
length of a negative integer by negating it and then returning the
value for the positive equivalent.

This primitive can be used to greatly speed up the conversion of
rational numbers to flonums.
---

diff --git a/v7/src/microcode/artutl.c b/v7/src/microcode/artutl.c
index 15fa58390..68aebb9b2 100644
--- a/v7/src/microcode/artutl.c
+++ b/v7/src/microcode/artutl.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: artutl.c,v 1.12 1995/09/18 22:32:53 cph Exp $
+$Id: artutl.c,v 1.13 1997/04/22 22:42:16 cph Exp $
 
-Copyright (c) 1989-95 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
@@ -36,6 +36,7 @@ MIT in each case. */
 
 #include "scheme.h"
 #include <math.h>
+#include "limits.h"
 
 /* Conversions between Scheme types and C types. */
 
@@ -460,3 +461,25 @@ DEFUN (integer_remainder, (n, d), SCHEME_OBJECT n AND SCHEME_OBJECT d)
        : (bignum_to_integer (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));
+    }
+  else
+    return (bignum_length_in_bits (n));
+}
diff --git a/v7/src/microcode/extern.h b/v7/src/microcode/extern.h
index 6b106e180..29e540923 100644
--- a/v7/src/microcode/extern.h
+++ b/v7/src/microcode/extern.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: extern.h,v 9.53 1995/09/18 22:32:54 cph Exp $
+$Id: extern.h,v 9.54 1997/04/22 22:42:25 cph Exp $
 
-Copyright (c) 1987-95 Massachusetts Institute of Technology
+Copyright (c) 1987-97 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -205,6 +205,7 @@ extern Boolean EXFUN (integer_divide,
 		       SCHEME_OBJECT *, SCHEME_OBJECT *));
 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));
 
 /* Character utilities */
 extern long EXFUN (char_downcase, (long));
diff --git a/v7/src/microcode/intprm.c b/v7/src/microcode/intprm.c
index 9a206b18b..c7c15900c 100644
--- a/v7/src/microcode/intprm.c
+++ b/v7/src/microcode/intprm.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: intprm.c,v 1.4 1992/08/29 13:20:43 jinx Exp $
+$Id: intprm.c,v 1.5 1997/04/22 22:42:41 cph Exp $
 
-Copyright (c) 1989-1992 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
@@ -108,6 +108,8 @@ DEFINE_PRIMITIVE ("INTEGER-ADD-1", Prim_integer_add_1, 1, 1, 0)
      INTEGER_UNARY_OPERATION (integer_add_1)
 DEFINE_PRIMITIVE ("INTEGER-SUBTRACT-1", Prim_integer_subtract_1, 1, 1, 0)
      INTEGER_UNARY_OPERATION (integer_subtract_1)
+DEFINE_PRIMITIVE ("INTEGER-LENGTH-IN-BITS", Prim_integer_length_in_bits, 1, 1, 0)
+     INTEGER_UNARY_OPERATION (integer_length_in_bits)
 
 DEFINE_PRIMITIVE ("INTEGER-DIVIDE", Prim_integer_divide, 2, 2, 0)
 {