Mercurial > hg > xemacs-beta

changeset 4329:d9eb5ea14f65

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Provide %b in #'format; use it for converting between ints and bit vectors. lisp/ChangeLog addition: 2007-12-17 Aidan Kehoe <kehoea@parhasard.net> * subr.el (integer-to-bit-vector): New. * subr.el (bit-vector-to-integer): New. Provide naive implementations using the Lisp reader for these. src/ChangeLog addition: 2007-12-17 Aidan Kehoe <kehoea@parhasard.net> * doprnt.c (emacs_doprnt_1): Add support for formatted printing of both longs and bignums as base 2. * editfns.c (Fformat): Document the new %b escape for #'format. * lisp.h: Make ulong_to_bit_string available beside long_to_string. * lread.c: Fix a bug where the integer base was being ignored in certain contexts; thank you Sebastian Freundt. This is necessary for correct behaviour of #'integer-to-bit-vector and #'bit-vector-to-integer, just added to subr.el * print.c (ulong_to_bit_string): New. Analagous to long_to_string, but used all the time when %b is encountered, since we can't pass that to sprintf. man/ChangeLog addition: 2007-12-17 Aidan Kehoe <kehoea@parhasard.net> * lispref/strings.texi (Formatting Strings): Document %b for binary output.
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 17 Dec 2007 08:44:14 +0100
parents dfd878799ef0
children 3483b381b0a9
files lisp/ChangeLog lisp/subr.el man/ChangeLog man/lispref/strings.texi src/ChangeLog src/doprnt.c src/editfns.c src/lisp.h src/lread.c src/print.c
diffstat 10 files changed, 106 insertions(+), 10 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Fri Dec 14 14:25:04 2007 +0100
+++ b/lisp/ChangeLog	Mon Dec 17 08:44:14 2007 +0100
@@ -1,3 +1,9 @@
+2007-12-17  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* subr.el (integer-to-bit-vector): New.
+	* subr.el (bit-vector-to-integer): New.
+	Provide naive implementations using the Lisp reader for these. 
+
 2007-12-14  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* process.el (substitute-env-vars):
--- a/lisp/subr.el	Fri Dec 14 14:25:04 2007 +0100
+++ b/lisp/subr.el	Mon Dec 17 08:44:14 2007 +0100
@@ -913,6 +913,26 @@
 (define-function 'char-int 'char-to-int)
 (define-function 'int-char 'int-to-char)
 
+;; XEmacs addition.
+(defun integer-to-bit-vector (integer &optional minlength)
+  "Return INTEGER converted to a bit vector.
+Optional argument MINLENGTH gives a minimum length for the returned vector.
+If MINLENGTH is not given, zero high-order bits will be ignored."
+  (check-argument-type #'integerp integer)
+  (setq minlength (or minlength 0))
+  (check-nonnegative-number minlength)
+  (read (format (format "#*%%0%db" minlength) integer)))
+
+;; XEmacs addition.
+(defun bit-vector-to-integer (bit-vector)
+  "Return BIT-VECTOR converted to an integer.
+If bignum support is available, BIT-VECTOR's length is unlimited.
+Otherwise the limit is the number of value bits in an Lisp integer. "
+  (check-argument-type #'bit-vector-p bit-vector)
+  (setq bit-vector (prin1-to-string bit-vector))
+  (aset bit-vector 1 ?b)
+  (read bit-vector))
+
 (defun string-width (string)
   "Return number of columns STRING occupies when displayed.
 With international (Mule) support, uses the charset-columns attribute of
--- a/man/ChangeLog	Fri Dec 14 14:25:04 2007 +0100
+++ b/man/ChangeLog	Mon Dec 17 08:44:14 2007 +0100
@@ -1,3 +1,8 @@
+2007-12-17  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* lispref/strings.texi (Formatting Strings):
+	Document %b for binary output.
+
 2007-12-10  Ville Skyttä  <scop@xemacs.org>
 
 	* internals/internals.texi: Spelling fixes.
--- a/man/lispref/strings.texi	Fri Dec 14 14:25:04 2007 +0100
+++ b/man/lispref/strings.texi	Mon Dec 17 08:44:14 2007 +0100
@@ -715,6 +715,11 @@
 Replace the specification with the base-sixteen representation of an
 integer, using uppercase letters.
 
+@item %b
+@cindex integer to binary
+Replace the specification with the base-two representation of an
+integer.
+
 @item %c
 Replace the specification with the character which is the value given.
 
--- a/src/ChangeLog	Fri Dec 14 14:25:04 2007 +0100
+++ b/src/ChangeLog	Mon Dec 17 08:44:14 2007 +0100
@@ -1,3 +1,21 @@
+2007-12-17  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* doprnt.c (emacs_doprnt_1):
+	Add support for formatted printing of both longs and bignums as
+	base 2.
+	* editfns.c (Fformat):
+	Document the new %b escape for #'format. 
+	* lisp.h:
+	Make ulong_to_bit_string available beside long_to_string. 
+	* lread.c:
+	Fix a bug where the integer base was being ignored in certain
+	contexts; thank you Sebastian Freundt. This is necessary for
+	correct behaviour of #'integer-to-bit-vector and
+	#'bit-vector-to-integer, just added to subr.el
+	* print.c (ulong_to_bit_string): New.
+	Analagous to long_to_string, but used all the time when %b is
+	encountered, since we can't pass that to sprintf. 	
+
 2007-12-12  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* config.h.in:
--- a/src/doprnt.c	Fri Dec 14 14:25:04 2007 +0100
+++ b/src/doprnt.c	Mon Dec 17 08:44:14 2007 +0100
@@ -34,7 +34,7 @@
 #include "lstream.h"
 
 static const char * const valid_flags = "-+ #0";
-static const char * const valid_converters = "dic" "ouxX" "feEgG" "sS"
+static const char * const valid_converters = "dic" "ouxX" "feEgG" "sS" "b"
 #if defined(HAVE_BIGNUM) || defined(HAVE_RATIO)
   "npyY"
 #endif
@@ -43,11 +43,11 @@
 #endif
   ;
 static const char * const int_converters = "dic";
-static const char * const unsigned_int_converters = "ouxX";
+static const char * const unsigned_int_converters = "ouxXb";
 static const char * const double_converters = "feEgG";
 static const char * const string_converters = "sS";
 #if defined(HAVE_BIGNUM) || defined(HAVE_RATIO)
-static const char * const bignum_converters = "npyY";
+static const char * const bignum_converters = "npyY\337";
 #endif
 #ifdef HAVE_BIGFLOAT
 static const char * const bigfloat_converters = "FhHkK";
@@ -665,6 +665,7 @@
 			case 'o': ch = 'p'; break;
 			case 'x': ch = 'y'; break;
 			case 'X': ch = 'Y'; break;
+                        case 'b': ch = 'b'; break;
 			default: /* ch == 'u' */
 			  if (strchr (unsigned_int_converters, ch) &&
 			      ratio_sign (XRATIO_DATA (obj)) < 0)
@@ -684,6 +685,7 @@
 			case 'o': ch = 'p'; break;
 			case 'x': ch = 'y'; break;
 			case 'X': ch = 'Y'; break;
+                        case 'b': ch = '\337'; break;
 			default: /* ch == 'u' */
 			  if (strchr (unsigned_int_converters, ch) &&
 			      bignum_sign (XBIGNUM_DATA (obj)) < 0)
@@ -733,13 +735,22 @@
 #if defined(HAVE_BIGNUM) || defined(HAVE_RATIO)
 	  else if (strchr (bignum_converters, ch))
 	    {
+              int base = 16;
+              
+              if (ch == 'n')
+                base = 10;
+              else if (ch == 'p')
+                base = 8;
+              else if (ch == '\337')
+                base = 2;
+
 #ifdef HAVE_BIGNUM
 	      if (BIGNUMP (arg.obj))
 		{
+                  bignum *d = XBIGNUM_DATA (arg.obj);
 		  Ibyte *text_to_print =
 		    (Ibyte *) bignum_to_string (XBIGNUM_DATA (arg.obj),
-						ch == 'n' ? 10 :
-						(ch == 'p' ? 8 : 16));
+						base);
 		  doprnt_2 (stream, text_to_print,
 			    strlen ((const char *) text_to_print),
 			    spec->minwidth, -1, spec->minus_flag,
@@ -751,9 +762,7 @@
 	      if (RATIOP (arg.obj))
 		{
 		  Ibyte *text_to_print =
-		    (Ibyte *) ratio_to_string (XRATIO_DATA (arg.obj),
-					       ch == 'n' ? 10 :
-					       (ch == 'p' ? 8 : 16));
+		    (Ibyte *) ratio_to_string (XRATIO_DATA (arg.obj), base);
 		  doprnt_2 (stream, text_to_print,
 			    strlen ((const char *) text_to_print),
 			    spec->minwidth, -1, spec->minus_flag,
@@ -774,6 +783,15 @@
 	      xfree (text_to_print, Ibyte *);
 	    }
 #endif /* HAVE_BIGFLOAT */
+          else if (ch == 'b')
+            {
+              Ascbyte *text_to_print = alloca_array (char, SIZEOF_LONG * 8 + 1);
+              
+              ulong_to_bit_string (text_to_print, arg.ul);
+              doprnt_2 (stream, (Ibyte *)text_to_print,
+                        qxestrlen ((Ibyte *)text_to_print), 
+                        spec->minwidth, -1, spec->minus_flag, spec->zero_flag);
+            }
 	  else
 	    {
 	      Ascbyte *text_to_print;
--- a/src/editfns.c	Fri Dec 14 14:25:04 2007 +0100
+++ b/src/editfns.c	Mon Dec 17 08:44:14 2007 +0100
@@ -2155,7 +2155,7 @@
 %s means print all objects as-is, using `princ'.
 %S means print all objects as s-expressions, using `prin1'.
 %d or %i means print as an integer in decimal (%o octal, %x lowercase hex,
-  %X uppercase hex).
+  %X uppercase hex, %b binary).
 %c means print as a single character.
 %f means print as a floating-point number in fixed notation (e.g. 785.200).
 %e or %E means print as a floating-point number in scientific notation
--- a/src/lisp.h	Fri Dec 14 14:25:04 2007 +0100
+++ b/src/lisp.h	Mon Dec 17 08:44:14 2007 +0100
@@ -4982,6 +4982,7 @@
 #define DECIMAL_PRINT_SIZE(integral_type) \
 (((2410824 * sizeof (integral_type)) / 1000000) + 3)
 void long_to_string (char *, long);
+void ulong_to_bit_string (char *, unsigned long);
 extern int print_escape_newlines;
 extern MODULE_API int print_readably;
 Lisp_Object internal_with_output_to_temp_buffer (Lisp_Object,
--- a/src/lread.c	Fri Dec 14 14:25:04 2007 +0100
+++ b/src/lread.c	Mon Dec 17 08:44:14 2007 +0100
@@ -2029,7 +2029,7 @@
  overflow:
 #ifdef HAVE_BIGNUM
   {
-    bignum_set_string (scratch_bignum, (const char *) buf, 0);
+    bignum_set_string (scratch_bignum, (const char *) buf, base);
     return make_bignum_bg (scratch_bignum);
   }
 #else
--- a/src/print.c	Fri Dec 14 14:25:04 2007 +0100
+++ b/src/print.c	Mon Dec 17 08:44:14 2007 +0100
@@ -1269,6 +1269,29 @@
 #undef DIGITS_18
 #undef DIGITS_19
 
+void
+ulong_to_bit_string (char *p, unsigned long number)
+{
+  int i, seen_high_order = 0;;
+  
+  for (i = ((SIZEOF_LONG * 8) - 1); i >= 0; --i)
+    {
+      if (number & (unsigned long)1 << i)
+        {
+          seen_high_order = 1;
+          *p++ = '1';
+        }
+      else
+        {
+          if (seen_high_order)
+            {
+              *p++ = '0';
+            }
+        }
+    }
+  *p = '\0';
+}
+
 static void
 print_vector_internal (const char *start, const char *end,
                        Lisp_Object obj,