Avoid long futile looping on a TTY under huge values of hscroll.

[bpt/emacs.git] / src / .gdbinit

diff --git a/src/.gdbinit b/src/.gdbinit
index 2cf5663..1db2532 100644 (file)
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -1,4 +1,4 @@
-# Copyright (C) 1992-1998, 2000-2011  Free Software Foundation, Inc.
+# Copyright (C) 1992-1998, 2000-2012  Free Software Foundation, Inc.

 #
 # This file is part of GNU Emacs.
 #
 #
 # This file is part of GNU Emacs.
 #


@@ -49,17 +49,26 @@ handle SIGALRM ignore
 # Using a constant runs into GDB bugs sometimes.
 define xgetptr
   set $bugfix = $arg0
 # Using a constant runs into GDB bugs sometimes.
 define xgetptr
   set $bugfix = $arg0

-  set $ptr = (gdb_use_union ? (gdb_use_lsb ? $bugfix.u.val << gdb_gctypebits : $bugfix.u.val) : $bugfix & $valmask) | gdb_data_seg_bits
+  if gdb_use_struct
+    set $bugfix = $bugfix.i
+  end
+  set $ptr = $bugfix & $valmask | gdb_data_seg_bits

 end
 
 define xgetint
   set $bugfix = $arg0
 end
 
 define xgetint
   set $bugfix = $arg0

-  set $int = gdb_use_union ? $bugfix.s.val : (gdb_use_lsb ? $bugfix : $bugfix << gdb_gctypebits) >> gdb_gctypebits
+  if gdb_use_struct
+    set $bugfix = $bugfix.i
+  end
+  set $int = gdb_use_lsb ? $bugfix >> (gdb_gctypebits - 1) : $bugfix << (gdb_gctypebits - 1) >> (gdb_gctypebits - 1)

 end
 
 define xgettype
   set $bugfix = $arg0
 end
 
 define xgettype
   set $bugfix = $arg0

-  set $type = gdb_use_union ? $bugfix.s.type : (enum Lisp_Type) (gdb_use_lsb ? $bugfix & $tagmask : $bugfix >> gdb_valbits)
+  if gdb_use_struct
+    set $bugfix = $bugfix.i
+  end
+  set $type = (enum Lisp_Type) (gdb_use_lsb ? $bugfix & $tagmask : $bugfix >> gdb_valbits)

 end
 
 # Set up something to print out s-expressions.
 end
 
 # Set up something to print out s-expressions.


@@ -67,10 +76,7 @@ end
 # from calling OutputDebugString, which causes GDB to display each
 # character twice (yuk!).
 define pr
 # from calling OutputDebugString, which causes GDB to display each
 # character twice (yuk!).
 define pr

-  set $output_debug = print_output_debug_flag
-  set print_output_debug_flag = 0
-  set debug_print ($)
-  set print_output_debug_flag = $output_debug
+  pp $

 end
 document pr
 Print the emacs s-expression which is $.
 end
 document pr
 Print the emacs s-expression which is $.


@@ -90,48 +96,17 @@ Print the argument as an emacs s-expression
 Works only when an inferior emacs is executing.
 end
 
 Works only when an inferior emacs is executing.
 end
 

-# Print out s-expressions from tool bar
-define pp1
-  set $tmp = $arg0
-  set $output_debug = print_output_debug_flag
-  set print_output_debug_flag = 0
-  set safe_debug_print ($tmp)
-  set print_output_debug_flag = $output_debug
-end
-document pp1
-Print the argument as an emacs s-expression.
-Works only when an inferior emacs is executing.
-For use on tool bar when debugging in Emacs
-where the variable name would not otherwise
-be recorded in the GUD buffer.
-end
-

 # Print value of lisp variable
 define pv
 # Print value of lisp variable
 define pv

-  set $tmp = "$arg0"
-  set $output_debug = print_output_debug_flag
-  set print_output_debug_flag = 0
-  set safe_debug_print ( find_symbol_value (intern ($tmp)))
-  set print_output_debug_flag = $output_debug
-end
-document pv
-Print the value of the lisp variable given as argument.
-Works only when an inferior emacs is executing.
-end
-
-# Print value of lisp variable
-define pv1

   set $tmp = "$arg0"
   set $output_debug = print_output_debug_flag
   set print_output_debug_flag = 0
   set safe_debug_print (find_symbol_value (intern ($tmp)))
   set print_output_debug_flag = $output_debug
 end
   set $tmp = "$arg0"
   set $output_debug = print_output_debug_flag
   set print_output_debug_flag = 0
   set safe_debug_print (find_symbol_value (intern ($tmp)))
   set print_output_debug_flag = $output_debug
 end

-document pv1
+document pv

 Print the value of the lisp variable given as argument.
 Works only when an inferior emacs is executing.
 Print the value of the lisp variable given as argument.
 Works only when an inferior emacs is executing.

-For use when debugging in Emacs where the variable
-name would not otherwise be recorded in the GUD buffer.

 end
 
 # Print out current buffer point and boundaries
 end
 
 # Print out current buffer point and boundaries


@@ -288,8 +263,8 @@ define pitx
   while ($i < $it->sp && $i < 4)
     set $e = $it->stack[$i]
     printf "stack[%d]: ", $i
   while ($i < $it->sp && $i < 4)
     set $e = $it->stack[$i]
     printf "stack[%d]: ", $i

-    pitmethod $e->method
-    printf "[%d]", $e->position.charpos
+    pitmethod $e.method
+    printf "[%d]", $e.position.charpos

     printf "\n"
     set $i = $i + 1
   end
     printf "\n"
     set $i = $i + 1
   end


@@ -311,9 +286,8 @@ define prowx
   printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
   printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
   printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
   printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
   printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
   printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height

-  printf " vis=%d", $row->visible_height
-  printf "  L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
-  printf "\n"
+  printf " vis=%d\n", $row->visible_height
+  printf "used=(LMargin=%d,Text=%d,RMargin=%d) Hash=%d\n", $row->used[0], $row->used[1], $row->used[2], $row->hash

   printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
   if ($row->enabled_p)
     printf " ENA"
   printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
   if ($row->enabled_p)
     printf " ENA"


@@ -483,83 +457,83 @@ end
 define pgx
   set $g = $arg0
   # CHAR_GLYPH
 define pgx
   set $g = $arg0
   # CHAR_GLYPH

-  if ($g->type == 0)
-    if ($g->u.ch >= ' ' && $g->u.ch < 127)
-      printf "CHAR[%c]", $g->u.ch
+  if ($g.type == 0)
+    if ($g.u.ch >= ' ' && $g.u.ch < 127)
+      printf "CHAR[%c]", $g.u.ch

     else
     else

-      printf "CHAR[0x%x]", $g->u.ch
+      printf "CHAR[0x%x]", $g.u.ch

     end
   end
   # COMPOSITE_GLYPH
     end
   end
   # COMPOSITE_GLYPH

-  if ($g->type == 1)
-    printf "COMP[%d (%d..%d)]", $g->u.cmp.id, $g->slice.cmp.from, $g->slice.cmp.to
+  if ($g.type == 1)
+    printf "COMP[%d (%d..%d)]", $g.u.cmp.id, $g.slice.cmp.from, $g.slice.cmp.to

   end
   # GLYPHLESS_GLYPH
   end
   # GLYPHLESS_GLYPH

-  if ($g->type == 2)
+  if ($g.type == 2)

     printf "GLYPHLESS["
     printf "GLYPHLESS["

-    if ($g->u.glyphless.method == 0)
+    if ($g.u.glyphless.method == 0)

       printf "THIN]"
     end
       printf "THIN]"
     end

-    if ($g->u.glyphless.method == 1)
+    if ($g.u.glyphless.method == 1)

       printf "EMPTY]"
     end
       printf "EMPTY]"
     end

-    if ($g->u.glyphless.method == 2)
+    if ($g.u.glyphless.method == 2)

       printf "ACRO]"
     end
       printf "ACRO]"
     end

-    if ($g->u.glyphless.method == 3)
+    if ($g.u.glyphless.method == 3)

       printf "HEX]"
     end
   end
   # IMAGE_GLYPH
       printf "HEX]"
     end
   end
   # IMAGE_GLYPH

-  if ($g->type == 3)
-    printf "IMAGE[%d]", $g->u.img_id
+  if ($g.type == 3)
+    printf "IMAGE[%d]", $g.u.img_id

   end
   # STRETCH_GLYPH
   end
   # STRETCH_GLYPH

-  if ($g->type == 4)
-    printf "STRETCH[%d+%d]", $g->u.stretch.height, $g->u.stretch.ascent
+  if ($g.type == 4)
+    printf "STRETCH[%d+%d]", $g.u.stretch.height, $g.u.stretch.ascent

   end
   end

-  xgettype ($g->object)
+  xgettype ($g.object)

   if ($type == Lisp_String)
   if ($type == Lisp_String)

-    printf " str=%x[%d]", $g->object, $g->charpos
+    printf " str=%x[%d]", $g.object, $g.charpos

   else
   else

-    printf " pos=%d", $g->charpos
+    printf " pos=%d", $g.charpos

   end
   # For characters, print their resolved level and bidi type
   end
   # For characters, print their resolved level and bidi type

-  if ($g->type == 0)
-    printf " blev=%d,btyp=", $g->resolved_level
-    pbiditype $g->bidi_type
+  if ($g.type == 0)
+    printf " blev=%d,btyp=", $g.resolved_level
+    pbiditype $g.bidi_type

   end
   end

-  printf " w=%d a+d=%d+%d", $g->pixel_width, $g->ascent, $g->descent
+  printf " w=%d a+d=%d+%d", $g.pixel_width, $g.ascent, $g.descent

   # If not DEFAULT_FACE_ID
   # If not DEFAULT_FACE_ID

-  if ($g->face_id != 0)
-    printf " face=%d", $g->face_id
+  if ($g.face_id != 0)
+    printf " face=%d", $g.face_id

   end
   end

-  if ($g->voffset)
-    printf " vof=%d", $g->voffset
+  if ($g.voffset)
+    printf " vof=%d", $g.voffset

   end
   end

-  if ($g->multibyte_p)
+  if ($g.multibyte_p)

     printf " MB"
   end
     printf " MB"
   end

-  if ($g->padding_p)
+  if ($g.padding_p)

     printf " PAD"
   end
     printf " PAD"
   end

-  if ($g->glyph_not_available_p)
+  if ($g.glyph_not_available_p)

     printf " N/A"
   end
     printf " N/A"
   end

-  if ($g->overlaps_vertically_p)
+  if ($g.overlaps_vertically_p)

     printf " OVL"
   end
     printf " OVL"
   end

-  if ($g->avoid_cursor_p)
+  if ($g.avoid_cursor_p)

     printf " AVOID"
   end
     printf " AVOID"
   end

-  if ($g->left_box_line_p)
+  if ($g.left_box_line_p)

     printf " ["
   end
     printf " ["
   end

-  if ($g->right_box_line_p)
+  if ($g.right_box_line_p)

     printf " ]"
   end
     printf " ]"
   end

-  if ($g->slice.img.x || $g->slice.img.y || $g->slice.img.width || $g->slice.img.height)
-    printf " slice=%d,%d,%d,%d" ,$g->slice.img.x, $g->slice.img.y, $g->slice.img.width, $g->slice.img.height
+  if ($g.slice.img.x || $g.slice.img.y || $g.slice.img.width || $g.slice.img.height)
+    printf " slice=%d,%d,%d,%d" ,$g.slice.img.x, $g.slice.img.y, $g.slice.img.width, $g.slice.img.height

   end
   printf "\n"
 end
   end
   printf "\n"
 end


@@ -677,7 +651,7 @@ end
 
 define xvectype
   xgetptr $
 
 define xvectype
   xgetptr $

-  set $size = ((struct Lisp_Vector *) $ptr)->size
+  set $size = ((struct Lisp_Vector *) $ptr)->header.size

   output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
   echo \n
 end
   output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
   echo \n
 end


@@ -738,60 +712,6 @@ Print $ as a misc free-cell pointer.
 This command assumes that $ is an Emacs Lisp Misc value.
 end
 
 This command assumes that $ is an Emacs Lisp Misc value.
 end
 

-define xintfwd
-  xgetptr $
-  print (struct Lisp_Intfwd *) $ptr
-end
-document xintfwd
-Print $ as an integer forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xboolfwd
-  xgetptr $
-  print (struct Lisp_Boolfwd *) $ptr
-end
-document xboolfwd
-Print $ as a boolean forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xobjfwd
-  xgetptr $
-  print (struct Lisp_Objfwd *) $ptr
-end
-document xobjfwd
-Print $ as an object forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xbufobjfwd
-  xgetptr $
-  print (struct Lisp_Buffer_Objfwd *) $ptr
-end
-document xbufobjfwd
-Print $ as a buffer-local object forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xkbobjfwd
-  xgetptr $
-  print (struct Lisp_Kboard_Objfwd *) $ptr
-end
-document xkbobjfwd
-Print $ as a kboard-local object forwarding pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-
-define xbuflocal
-  xgetptr $
-  print (struct Lisp_Buffer_Local_Value *) $ptr
-end
-document xbuflocal
-Print $ as a buffer-local-value pointer.
-This command assumes that $ is an Emacs Lisp Misc value.
-end
-

 define xsymbol
   set $sym = $
   xgetptr $sym
 define xsymbol
   set $sym = $
   xgetptr $sym


@@ -818,7 +738,7 @@ end
 define xvector
   xgetptr $
   print (struct Lisp_Vector *) $ptr
 define xvector
   xgetptr $
   print (struct Lisp_Vector *) $ptr

-  output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
+  output ($->header.size > 50) ? 0 : ($->contents[0])@($->header.size & ~gdb_array_mark_flag)

 echo \n
 end
 document xvector
 echo \n
 end
 document xvector


@@ -853,7 +773,7 @@ end
 define xcompiled
   xgetptr $
   print (struct Lisp_Vector *) $ptr
 define xcompiled
   xgetptr $
   print (struct Lisp_Vector *) $ptr

-  output ($->contents[0])@($->size & 0xff)
+  output ($->contents[0])@($->header.size & 0xff)

 end
 document xcompiled
 Print $ as a compiled function pointer.
 end
 document xcompiled
 Print $ as a compiled function pointer.


@@ -903,7 +823,7 @@ define xchartable
   print (struct Lisp_Char_Table *) $ptr
   printf "Purpose: "
   xprintsym $->purpose
   print (struct Lisp_Char_Table *) $ptr
   printf "Purpose: "
   xprintsym $->purpose

-  printf "  %d extra slots", ($->size & 0x1ff) - 68
+  printf "  %d extra slots", ($->header.size & 0x1ff) - 68

   echo \n
 end
 document xchartable
   echo \n
 end
 document xchartable


@@ -927,7 +847,7 @@ end
 define xboolvector
   xgetptr $
   print (struct Lisp_Bool_Vector *) $ptr
 define xboolvector
   xgetptr $
   print (struct Lisp_Bool_Vector *) $ptr

-  output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
+  output ($->header.size > 256) ? 0 : ($->data[0])@((($->header.size & ~gdb_array_mark_flag) + 7)/ 8)

   echo \n
 end
 document xboolvector
   echo \n
 end
 document xboolvector


@@ -1038,7 +958,7 @@ end
 
 define xpr
   xtype
 
 define xpr
   xtype

-  if $type == Lisp_Int
+  if $type == Lisp_Int0 || $type == Lisp_Int1

     xint
   end
   if $type == Lisp_Symbol
     xint
   end
   if $type == Lisp_Symbol


@@ -1058,42 +978,18 @@ define xpr
     if $misc == Lisp_Misc_Free
       xmiscfree
     end
     if $misc == Lisp_Misc_Free
       xmiscfree
     end

-    if $misc == Lisp_Misc_Boolfwd
-      xboolfwd
-    end

     if $misc == Lisp_Misc_Marker
       xmarker
     end
     if $misc == Lisp_Misc_Marker
       xmarker
     end

-    if $misc == Lisp_Misc_Intfwd
-      xintfwd
-    end
-    if $misc == Lisp_Misc_Boolfwd
-      xboolfwd
-    end
-    if $misc == Lisp_Misc_Objfwd
-      xobjfwd
-    end
-    if $misc == Lisp_Misc_Buffer_Objfwd
-      xbufobjfwd
-    end
-    if $misc == Lisp_Misc_Buffer_Local_Value
-      xbuflocal
-    end
-#    if $misc == Lisp_Misc_Some_Buffer_Local_Value
-#      xvalue
-#    end

     if $misc == Lisp_Misc_Overlay
       xoverlay
     end
     if $misc == Lisp_Misc_Overlay
       xoverlay
     end

-    if $misc == Lisp_Misc_Kboard_Objfwd
-      xkbobjfwd
-    end

 #    if $misc == Lisp_Misc_Save_Value
 #      xsavevalue
 #    end
   end
   if $type == Lisp_Vectorlike
 #    if $misc == Lisp_Misc_Save_Value
 #      xsavevalue
 #    end
   end
   if $type == Lisp_Vectorlike

-    set $size = ((struct Lisp_Vector *) $ptr)->size
+    set $size = ((struct Lisp_Vector *) $ptr)->header.size

     if ($size & PVEC_FLAG)
       set $vec = (enum pvec_type) ($size & PVEC_TYPE_MASK)
       if $vec == PVEC_NORMAL_VECTOR
     if ($size & PVEC_FLAG)
       set $vec = (enum pvec_type) ($size & PVEC_TYPE_MASK)
       if $vec == PVEC_NORMAL_VECTOR


@@ -1202,7 +1098,7 @@ end
 
 define xfont
   xgetptr $
 
 define xfont
   xgetptr $

-  set $size = (((struct Lisp_Vector *) $ptr)->size & 0x1FF)
+  set $size = (((struct Lisp_Vector *) $ptr)->header.size & 0x1FF)

   if $size == FONT_SPEC_MAX
     print (struct font_spec *) $ptr
   else
   if $size == FONT_SPEC_MAX
     print (struct font_spec *) $ptr
   else


@@ -1229,7 +1125,7 @@ define xbacktrace
       printf "0x%x ", $ptr
       if $type == Lisp_Vectorlike
        xgetptr (*$bt->function)
       printf "0x%x ", $ptr
       if $type == Lisp_Vectorlike
        xgetptr (*$bt->function)

-        set $size = ((struct Lisp_Vector *) $ptr)->size
+        set $size = ((struct Lisp_Vector *) $ptr)->header.size

         output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
       else
         printf "Lisp type %d", $type
         output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
       else
         printf "Lisp type %d", $type


@@ -1245,20 +1141,36 @@ document xbacktrace
   an error was signaled.
 end
 
   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
 end

-document which
+
+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 xwhichsymbols

   Print symbols which references a given lisp object
   either as its symbol value or symbol function.
   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
 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
     set $bt = $bt->next
   end
 end


@@ -1277,8 +1189,10 @@ define hookpost-backtrace
 end
 
 define xreload
 end
 
 define xreload

-  set $tagmask = (((long)1 << gdb_gctypebits) - 1)
-  set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
+  set $tagmask = ((1 << gdb_gctypebits) - 1)
+  # The consing_since_gc business widens the 1 to EMACS_INT,
+  # a symbol not directly visible to GDB.
+  set $valmask = gdb_use_lsb ? ~($tagmask) : ((consing_since_gc - consing_since_gc + 1) << gdb_valbits) - 1

 end
 document xreload
   When starting Emacs a second time in the same gdb session under
 end
 document xreload
   When starting Emacs a second time in the same gdb session under