From 8b058d447425857f933c119edbac3c1e2da3e1f3 Mon Sep 17 00:00:00 2001
From: Eli Zaretskii <eliz@gnu.org>
Date: Sat, 29 Oct 2011 15:35:23 +0200
Subject: [PATCH] Fix the `xbytecode' user-defined command in .gdbinit.

 src/.gdbinit (xprintbytestr): New command.
 (xwhichsymbols): Renamed from `which'; all callers changed.
 (xbytecode): Print the byte-code string as well.
 src/alloc.c (which_symbols): New function.
---
 src/.gdbinit  | 28 ++++++++++++++++++++++------
 src/ChangeLog |  9 +++++++++
 src/alloc.c   | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 80 insertions(+), 6 deletions(-)

diff --git a/src/.gdbinit b/src/.gdbinit
index b908ef005d6..80415abe40d 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -1245,20 +1245,36 @@ document xbacktrace
   an error was signaled.
 end
 
-define which
-  set debug_print (which_symbols ($arg0))
+define xprintbytestr
+  set $data = (char *) $arg0->data
+  printf "Bytecode: "
+  output/u ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
+end
+document xprintbytestr
+  Print a string of byte code.
+end
+
+define xwhichsymbols
+  set $output_debug = print_output_debug_flag
+  set print_output_debug_flag = 0
+  set safe_debug_print (which_symbols ($arg0, $arg1))
+  set print_output_debug_flag = $output_debug
 end
-document which
+document xwhichsymbols
   Print symbols which references a given lisp object
   either as its symbol value or symbol function.
+  Call with two arguments: the lisp object and the
+  maximum number of symbols referencing it to produce.
 end
 
 define xbytecode
   set $bt = byte_stack_list
   while $bt
-    xgettype ($bt->byte_string)
-    printf "0x%x => ", $bt->byte_string
-    which $bt->byte_string
+    xgetptr $bt->byte_string
+    set $ptr = (struct Lisp_String *) $ptr
+    xprintbytestr $ptr
+    printf "\n0x%x => ", $bt->byte_string
+    xwhichsymbols $bt->byte_string 5
     set $bt = $bt->next
   end
 end
diff --git a/src/ChangeLog b/src/ChangeLog
index 5a7d66ceb17..98c050c2379 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,12 @@
+2011-10-29  Eli Zaretskii  <eliz@gnu.org>
+
+	Fix the `xbytecode' command.
+	* .gdbinit (xprintbytestr): New command.
+	(xwhichsymbols): Renamed from `which'; all callers changed.
+	(xbytecode): Print the byte-code string as well.
+
+	* alloc.c (which_symbols): New function.
+
 2011-10-29  Andreas Schwab  <schwab@linux-m68k.org>
 
 	* minibuf.c (read_minibuf_noninteractive): Allow reading empty
diff --git a/src/alloc.c b/src/alloc.c
index 6e999a0ba6d..ac5da1c2fa1 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -6250,6 +6250,55 @@ Frames, windows, buffers, and subprocesses count as vectors
   return Flist (8, consed);
 }
 
+/* Find at most FIND_MAX symbols which have OBJ as their value or
+   function.  This is used in gdbinit's `xwhichsymbols' command.  */
+
+Lisp_Object
+which_symbols (Lisp_Object obj, int find_max)
+{
+   struct symbol_block *sblk;
+   int gc_count = inhibit_garbage_collection ();
+   Lisp_Object found = Qnil;
+
+   if (!EQ (obj, Vdead))
+     {
+       for (sblk = symbol_block; sblk; sblk = sblk->next)
+	 {
+	   struct Lisp_Symbol *sym = sblk->symbols;
+	   int bn;
+
+	   for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, sym++)
+	     {
+	       Lisp_Object val;
+	       Lisp_Object tem;
+
+	       if (sblk == symbol_block && bn >= symbol_block_index)
+		 break;
+
+	       XSETSYMBOL (tem, sym);
+	       val = find_symbol_value (tem);
+	       if (EQ (val, obj)
+		   || EQ (sym->function, obj)
+		   || (!NILP (sym->function)
+		       && COMPILEDP (sym->function)
+		       && EQ (AREF (sym->function, COMPILED_BYTECODE), obj))
+		   || (!NILP (val)
+		       && COMPILEDP (val)
+		       && EQ (AREF (val, COMPILED_BYTECODE), obj)))
+		 {
+		   found = Fcons (tem, found);
+		   if (--find_max == 0)
+		     goto out;
+		 }
+	     }
+	 }
+     }
+
+  out:
+   unbind_to (gc_count, Qnil);
+   return found;
+}
+
 #ifdef ENABLE_CHECKING
 int suppress_checking;
 
-- 
2.39.5