Fix more GCC strict-aliasing warnings.
[emacs.git] / src / .gdbinit
blob90e06e9649d5348f8eafc2a21fa89a929ba222c7
1 # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 2000, 2001,
2 #   2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
3 #   Free Software Foundation, Inc.
5 # This file is part of GNU Emacs.
7 # GNU Emacs is free software; you can redistribute it and/or modify
8 # it under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3, or (at your option)
10 # any later version.
12 # GNU Emacs is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with GNU Emacs; see the file COPYING.  If not, write to the
19 # Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 # Boston, MA 02110-1301, USA.
22 # Force loading of symbols, enough to give us gdb_valbits etc.
23 set main
25 # Find lwlib source files too.
26 dir ../lwlib
27 #dir /gd/gnu/lesstif-0.89.9/lib/Xm
29 # Don't enter GDB when user types C-g to quit.
30 # This has one unfortunate effect: you can't type C-c
31 # at the GDB to stop Emacs, when using X.
32 # However, C-z works just as well in that case.
33 handle 2 noprint pass
35 # Make it work like SIGINT normally does.
36 handle SIGTSTP nopass
38 # Pass on user signals
39 handle SIGUSR1 noprint pass
40 handle SIGUSR2 noprint pass
42 # Don't pass SIGALRM to Emacs.  This makes problems when
43 # debugging.
44 handle SIGALRM ignore
46 # $valmask and $tagmask are mask values set up by the xreload macro below.
48 # Use $bugfix so that the value isn't a constant.
49 # Using a constant runs into GDB bugs sometimes.
50 define xgetptr
51   set $bugfix = $arg0
52   set $ptr = (gdb_use_union ? (gdb_use_lsb ? $bugfix.u.val << gdb_gctypebits : $bugfix.u.val) : $bugfix & $valmask) | gdb_data_seg_bits
53 end
55 define xgetint
56   set $bugfix = $arg0
57   set $int = gdb_use_union ? $bugfix.s.val : (gdb_use_lsb ? $bugfix : $bugfix << gdb_gctypebits) >> gdb_gctypebits
58 end
60 define xgettype
61   set $bugfix = $arg0
62   set $type = gdb_use_union ? $bugfix.s.type : (enum Lisp_Type) (gdb_use_lsb ? $bugfix & $tagmask : $bugfix >> gdb_valbits)
63 end
65 # Set up something to print out s-expressions.
66 # We save and restore print_output_debug_flag to prevent the w32 port
67 # from calling OutputDebugString, which causes GDB to display each
68 # character twice (yuk!).
69 define pr
70   set $output_debug = print_output_debug_flag
71   set print_output_debug_flag = 0
72   set debug_print ($)
73   set print_output_debug_flag = $output_debug
74 end
75 document pr
76 Print the emacs s-expression which is $.
77 Works only when an inferior emacs is executing.
78 end
80 # Print out s-expressions
81 define pp
82   set $tmp = $arg0
83   set $output_debug = print_output_debug_flag
84   set print_output_debug_flag = 0
85   set safe_debug_print ($tmp)
86   set print_output_debug_flag = $output_debug
87 end
88 document pp
89 Print the argument as an emacs s-expression
90 Works only when an inferior emacs is executing.
91 end
93 # Print out s-expressions from tool bar
94 define pp1
95   set $tmp = $arg0
96   set $output_debug = print_output_debug_flag
97   set print_output_debug_flag = 0
98   set safe_debug_print ($tmp)
99   set print_output_debug_flag = $output_debug
101 document pp1
102 Print the argument as an emacs s-expression.
103 Works only when an inferior emacs is executing.
104 For use on tool bar when debugging in Emacs
105 where the variable name would not otherwise
106 be recorded in the GUD buffer.
109 # Print value of lisp variable
110 define pv
111   set $tmp = "$arg0"
112   set $output_debug = print_output_debug_flag
113   set print_output_debug_flag = 0
114   set safe_debug_print ( find_symbol_value (intern ($tmp)))
115   set print_output_debug_flag = $output_debug
117 document pv
118 Print the value of the lisp variable given as argument.
119 Works only when an inferior emacs is executing.
122 # Print value of lisp variable
123 define pv1
124   set $tmp = "$arg0"
125   set $output_debug = print_output_debug_flag
126   set print_output_debug_flag = 0
127   set safe_debug_print (find_symbol_value (intern ($tmp)))
128   set print_output_debug_flag = $output_debug
130 document pv1
131 Print the value of the lisp variable given as argument.
132 Works only when an inferior emacs is executing.
133 For use when debugging in Emacs where the variable
134 name would not otherwise be recorded in the GUD buffer.
137 # Print out current buffer point and boundaries
138 define ppt
139   set $b = current_buffer
140   set $t = $b->text
141   printf "BUF PT: %d", $b->pt
142   if ($b->pt != $b->pt_byte)
143     printf "[%d]", $b->pt_byte
144   end
145   printf " of 1..%d", $t->z
146   if ($t->z != $t->z_byte)
147     printf "[%d]", $t->z_byte
148   end
149   if ($b->begv != 1 || $b->zv != $t->z)
150     printf " NARROW=%d..%d", $b->begv, $b->zv
151     if ($b->begv != $b->begv_byte || $b->zv != $b->zv_byte)
152       printf " [%d..%d]", $b->begv_byte, $b->zv_byte
153     end
154   end
155   printf " GAP: %d", $t->gpt
156   if ($t->gpt != $t->gpt_byte)
157     printf "[%d]", $t->gpt_byte
158   end
159   printf " SZ=%d\n", $t->gap_size
161 document ppt
162 Print current buffer's point and boundaries.
163 Prints values of point, beg, end, narrow, and gap for current buffer.
166 define pitmethod
167   set $itmethod = $arg0
168   # output $itmethod
169   if ($itmethod == 0)
170     printf "GET_FROM_BUFFER"
171   end
172   if ($itmethod == 1)
173     printf "GET_FROM_DISPLAY_VECTOR"
174   end
175   if ($itmethod == 2)
176     printf "GET_FROM_STRING"
177   end
178   if ($itmethod == 3)
179     printf "GET_FROM_C_STRING"
180   end
181   if ($itmethod == 4)
182     printf "GET_FROM_IMAGE"
183   end
184   if ($itmethod == 5)
185     printf "GET_FROM_STRETCH"
186   end
187   if ($itmethod < 0 || $itmethod > 5)
188     output $itmethod
189   end
191 document pitmethod
192 Pretty print it->method given as first arg
195 # Print out iterator given as first arg
196 define pitx
197   set $it = $arg0
198   printf "cur=%d", $it->current.pos.charpos
199   if ($it->current.pos.charpos != $it->current.pos.bytepos)
200     printf "[%d]", $it->current.pos.bytepos
201   end
202   printf " pos=%d", $it->position.charpos
203   if ($it->position.charpos != $it->position.bytepos)
204     printf "[%d]", $it->position.bytepos
205   end
206   printf " start=%d", $it->start.pos.charpos
207   if ($it->start.pos.charpos != $it->start.pos.bytepos)
208     printf "[%d]", $it->start.pos.bytepos
209   end
210   printf " end=%d", $it->end_charpos
211   printf " stop=%d", $it->stop_charpos
212   printf " face=%d", $it->face_id
213   if ($it->multibyte_p)
214     printf " MB"
215   end
216   if ($it->header_line_p)
217     printf " HL"
218   end
219   if ($it->n_overlay_strings > 0)
220     printf " nov=%d", $it->n_overlay_strings
221   end
222   if ($it->sp != 0)
223     printf " sp=%d", $it->sp
224   end
225   # IT_CHARACTER
226   if ($it->what == 0)
227     if ($it->len == 1 && $it->c >= ' ' && it->c < 255)
228       printf " ch='%c'", $it->c
229     else
230       printf " ch=[%d,%d]", $it->c, $it->len
231     end
232   else
233     printf " "
234     # output $it->what
235     if ($it->what == 0)
236       printf "IT_CHARACTER"
237     end
238     if ($it->what == 1)
239       printf "IT_COMPOSITION"
240     end
241     if ($it->what == 2)
242       printf "IT_IMAGE"
243     end
244     if ($it->what == 3)
245       printf "IT_STRETCH"
246     end
247     if ($it->what == 4)
248       printf "IT_EOB"
249     end
250     if ($it->what == 5)
251       printf "IT_TRUNCATION"
252     end
253     if ($it->what == 6)
254       printf "IT_CONTINUATION"
255     end
256     if ($it->what < 0 || $it->what > 6)
257       output $it->what
258     end
259   end
260   if ($it->method != 0)
261     # !GET_FROM_BUFFER
262     printf " next="
263     pitmethod $it->method
264     if ($it->method == 2)
265       # GET_FROM_STRING
266       printf "[%d]", $it->current.string_pos.charpos
267     end
268     if ($it->method == 4)
269       # GET_FROM_IMAGE
270       printf "[%d]", $it->image_id
271     end
272   end
273   printf "\n"
274   if ($it->region_beg_charpos >= 0)
275     printf "reg=%d-%d ", $it->region_beg_charpos, $it->region_end_charpos
276   end
277   printf "vpos=%d hpos=%d", $it->vpos, $it->hpos,
278   printf " y=%d lvy=%d", $it->current_y, $it->last_visible_y
279   printf " x=%d vx=%d-%d", $it->current_x, $it->first_visible_x, $it->last_visible_x
280   printf " w=%d", $it->pixel_width
281   printf " a+d=%d+%d=%d", $it->ascent, $it->descent, $it->ascent+$it->descent
282   printf " max=%d+%d=%d", $it->max_ascent, $it->max_descent, $it->max_ascent+$it->max_descent
283   printf "\n"
284   set $i = 0
285   while ($i < $it->sp && $i < 4)
286     set $e = $it->stack[$i]
287     printf "stack[%d]: ", $i
288     pitmethod $e->method
289     printf "[%d]", $e->position.charpos
290     printf "\n"
291     set $i = $i + 1
292   end
294 document pitx
295 Pretty print a display iterator.
296 Take one arg, an iterator object or pointer.
299 define pit
300   pitx it
302 document pit
303 Pretty print the display iterator it.
306 define prowx
307   set $row = $arg0
308   printf "y=%d x=%d pwid=%d", $row->y, $row->x, $row->pixel_width
309   printf " a+d=%d+%d=%d", $row->ascent, $row->height-$row->ascent, $row->height
310   printf " phys=%d+%d=%d", $row->phys_ascent, $row->phys_height-$row->phys_ascent, $row->phys_height
311   printf " vis=%d", $row->visible_height
312   printf "  L=%d T=%d R=%d", $row->used[0], $row->used[1], $row->used[2]
313   printf "\n"
314   printf "start=%d end=%d", $row->start.pos.charpos, $row->end.pos.charpos
315   if ($row->enabled_p)
316     printf " ENA"
317   end
318   if ($row->displays_text_p)
319     printf " DISP"
320   end
321   if ($row->mode_line_p)
322     printf " MODEL"
323   end
324   if ($row->continued_p)
325     printf " CONT"
326   end
327   if ($row-> truncated_on_left_p)
328     printf " TRUNC:L"
329   end
330   if ($row-> truncated_on_right_p)
331     printf " TRUNC:R"
332   end
333   if ($row->starts_in_middle_of_char_p)
334     printf " STARTMID"
335   end
336   if ($row->ends_in_middle_of_char_p)
337     printf " ENDMID"
338   end
339   if ($row->ends_in_newline_from_string_p)
340     printf " ENDNLFS"
341   end
342   if ($row->ends_at_zv_p)
343     printf " ENDZV"
344   end
345   if ($row->overlapped_p)
346     printf " OLAPD"
347   end
348   if ($row->overlapping_p)
349     printf " OLAPNG"
350   end
351   printf "\n"
353 document prowx
354 Pretty print information about glyph_row.
355 Takes one argument, a row object or pointer.
358 define prow
359   prowx row
361 document prow
362 Pretty print information about glyph_row in row.
366 define pcursorx
367   set $cp = $arg0
368   printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
370 document pcursorx
371 Pretty print a window cursor.
374 define pcursor
375   printf "output: "
376   pcursorx output_cursor
377   printf "\n"
379 document pcursor
380 Pretty print the output_cursor.
383 define pwinx
384   set $w = $arg0
385   xgetint $w->sequence_number
386   if ($w->mini_p != Qnil)
387     printf "Mini "
388   end
389   printf "Window %d ", $int
390   xgetptr $w->buffer
391   set $tem = (struct buffer *) $ptr
392   xgetptr $tem->name
393   printf "%s", ((struct Lisp_String *) $ptr)->data
394   printf "\n"
395   xgetptr $w->start
396   set $tem = (struct Lisp_Marker *) $ptr
397   printf "start=%d end:", $tem->charpos
398   if ($w->window_end_valid != Qnil)
399     xgetint $w->window_end_pos
400     printf "pos=%d", $int
401     xgetint $w->window_end_vpos
402     printf " vpos=%d", $int
403   else
404     printf "invalid"
405   end
406   printf " vscroll=%d", $w->vscroll
407   if ($w->force_start != Qnil)
408     printf " FORCE_START"
409   end
410   if ($w->must_be_updated_p)
411     printf " MUST_UPD"
412   end
413   printf "\n"
414   printf "cursor: "
415   pcursorx $w->cursor
416   printf "  phys: "
417   pcursorx $w->phys_cursor
418   if ($w->phys_cursor_on_p)
419     printf " ON"
420   else
421     printf " OFF"
422   end
423   printf " blk="
424   if ($w->last_cursor_off_p != $w->cursor_off_p)
425     if ($w->last_cursor_off_p)
426       printf "ON->"
427     else
428       printf "OFF->"
429     end
430   end
431   if ($w->cursor_off_p)
432     printf "ON"
433   else
434     printf "OFF"
435   end
436   printf "\n"
438 document pwinx
439 Pretty print a window structure.
440 Takes one argument, a pointer to a window structure.
443 define pwin
444   pwinx w
446 document pwin
447 Pretty print window structure w.
450 define pgx
451   set $g = $arg0
452   # CHAR_GLYPH
453   if ($g->type == 0)
454     if ($g->u.ch >= ' ' && $g->u.ch < 127)
455       printf "CHAR[%c]", $g->u.ch
456     else
457       printf "CHAR[0x%x]", $g->u.ch
458     end
459   end
460   # COMPOSITE_GLYPH
461   if ($g->type == 1)
462     printf "COMP[%d (%d..%d)]", $g->u.cmp.id, $g->u.cmp.from, $g->u.cmp.to
463   end
464   # IMAGE_GLYPH
465   if ($g->type == 2)
466     printf "IMAGE[%d]", $g->u.img_id
467   end
468   # STRETCH_GLYPH
469   if ($g->type == 3)
470     printf "STRETCH[%d+%d]", $g->u.stretch.height, $g->u.stretch.ascent
471   end
472   xgettype ($g->object)
473   if ($type == Lisp_String)
474     printf " str=%x[%d]", $g->object, $g->charpos
475   else
476     printf " pos=%d", $g->charpos
477   end
478   printf " w=%d a+d=%d+%d", $g->pixel_width, $g->ascent, $g->descent
479   # If not DEFAULT_FACE_ID
480   if ($g->face_id != 0)
481     printf " face=%d", $g->face_id
482   end
483   if ($g->voffset)
484     printf " vof=%d", $g->voffset
485   end
486   if ($g->multibyte_p)
487     printf " MB"
488   end
489   if ($g->padding_p)
490     printf " PAD"
491   end
492   if ($g->glyph_not_available_p)
493     printf " N/A"
494   end
495   if ($g->overlaps_vertically_p)
496     printf " OVL"
497   end
498   if ($g->left_box_line_p)
499     printf " ["
500   end
501   if ($g->right_box_line_p)
502     printf " ]"
503   end
504   if ($g->slice.x || $g->slice.y || $g->slice.width || $g->slice.height)
505     printf " slice=%d,%d,%d,%d" ,$g->slice.x, $g->slice.y, $g->slice.width, $g->slice.height
506   end
507   printf "\n"
509 document pgx
510 Pretty print a glyph structure.
511 Takes one argument, a pointer to a glyph structure.
514 define pg
515   set $pgidx = 0
516   pgx glyph
518 document pg
519 Pretty print glyph structure glyph.
522 define pgi
523   set $pgidx = $arg0
524   pgx (&glyph[$pgidx])
526 document pgi
527 Pretty print glyph structure glyph[I].
528 Takes one argument, a integer I.
531 define pgn
532   set $pgidx = $pgidx + 1
533   pgx (&glyph[$pgidx])
535 document pgn
536 Pretty print next glyph structure.
539 define pgrowx
540   set $row = $arg0
541   set $area = 0
542   set $xofs = $row->x
543   while ($area < 3)
544     set $used = $row->used[$area]
545     if ($used > 0)
546       set $gl0 = $row->glyphs[$area]
547       set $pgidx = 0
548       printf "%s: %d glyphs\n", ($area == 0 ? "LEFT" : $area == 2 ? "RIGHT" : "TEXT"), $used
549       while ($pgidx < $used)
550         printf "%3d %4d: ", $pgidx, $xofs
551         pgx $gl0[$pgidx]
552         set $xofs = $xofs + $gl0[$pgidx]->pixel_width
553         set $pgidx = $pgidx + 1
554       end
555     end
556     set $area = $area + 1
557   end
559 document pgrowx
560 Pretty print all glyphs in a row structure.
561 Takes one argument, a pointer to a row structure.
564 define pgrow
565   pgrowx row
567 document pgrow
568 Pretty print all glyphs in row structure row.
571 define pgrowit
572   pgrowx it->glyph_row
574 document pgrowit
575 Pretty print all glyphs in it->glyph_row.
578 define xtype
579   xgettype $
580   output $type
581   echo \n
582   if $type == Lisp_Misc
583     xmisctype
584   else
585     if $type == Lisp_Vectorlike
586       xvectype
587     end
588   end
590 document xtype
591 Print the type of $, assuming it is an Emacs Lisp value.
592 If the first type printed is Lisp_Vector or Lisp_Misc,
593 a second line gives the more precise type.
596 define xvectype
597   xgetptr $
598   set $size = ((struct Lisp_Vector *) $ptr)->size
599   output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
600   echo \n
602 document xvectype
603 Print the size or vector subtype of $.
604 This command assumes that $ is a vector or pseudovector.
607 define xmisctype
608   xgetptr $
609   output (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
610   echo \n
612 document xmisctype
613 Assume that $ is some misc type and print its specific type.
616 define xint
617   xgetint $
618   print $int
620 document xint
621 Print $ as an Emacs Lisp integer.  This gets the sign right.
624 define xptr
625   xgetptr $
626   print (void *) $ptr
628 document xptr
629 Print the pointer portion of an Emacs Lisp value in $.
632 define xmarker
633   xgetptr $
634   print (struct Lisp_Marker *) $ptr
636 document xmarker
637 Print $ as a marker pointer.
638 This command assumes that $ is an Emacs Lisp marker value.
641 define xoverlay
642   xgetptr $
643   print (struct Lisp_Overlay *) $ptr
645 document xoverlay
646 Print $ as a overlay pointer.
647 This command assumes that $ is an Emacs Lisp overlay value.
650 define xmiscfree
651   xgetptr $
652   print (struct Lisp_Free *) $ptr
654 document xmiscfree
655 Print $ as a misc free-cell pointer.
656 This command assumes that $ is an Emacs Lisp Misc value.
659 define xintfwd
660   xgetptr $
661   print (struct Lisp_Intfwd *) $ptr
663 document xintfwd
664 Print $ as an integer forwarding pointer.
665 This command assumes that $ is an Emacs Lisp Misc value.
668 define xboolfwd
669   xgetptr $
670   print (struct Lisp_Boolfwd *) $ptr
672 document xboolfwd
673 Print $ as a boolean forwarding pointer.
674 This command assumes that $ is an Emacs Lisp Misc value.
677 define xobjfwd
678   xgetptr $
679   print (struct Lisp_Objfwd *) $ptr
681 document xobjfwd
682 Print $ as an object forwarding pointer.
683 This command assumes that $ is an Emacs Lisp Misc value.
686 define xbufobjfwd
687   xgetptr $
688   print (struct Lisp_Buffer_Objfwd *) $ptr
690 document xbufobjfwd
691 Print $ as a buffer-local object forwarding pointer.
692 This command assumes that $ is an Emacs Lisp Misc value.
695 define xkbobjfwd
696   xgetptr $
697   print (struct Lisp_Kboard_Objfwd *) $ptr
699 document xkbobjfwd
700 Print $ as a kboard-local object forwarding pointer.
701 This command assumes that $ is an Emacs Lisp Misc value.
704 define xbuflocal
705   xgetptr $
706   print (struct Lisp_Buffer_Local_Value *) $ptr
708 document xbuflocal
709 Print $ as a buffer-local-value pointer.
710 This command assumes that $ is an Emacs Lisp Misc value.
713 define xsymbol
714   set $sym = $
715   xgetptr $sym
716   print (struct Lisp_Symbol *) $ptr
717   xprintsym $sym
718   echo \n
720 document xsymbol
721 Print the name and address of the symbol $.
722 This command assumes that $ is an Emacs Lisp symbol value.
725 define xstring
726   xgetptr $
727   print (struct Lisp_String *) $ptr
728   xprintstr $
729   echo \n
731 document xstring
732 Print the contents and address of the string $.
733 This command assumes that $ is an Emacs Lisp string value.
736 define xvector
737   xgetptr $
738   print (struct Lisp_Vector *) $ptr
739   output ($->size > 50) ? 0 : ($->contents[0])@($->size & ~gdb_array_mark_flag)
740 echo \n
742 document xvector
743 Print the contents and address of the vector $.
744 This command assumes that $ is an Emacs Lisp vector value.
747 define xprocess
748   xgetptr $
749   print (struct Lisp_Process *) $ptr
750   output *$
751   echo \n
753 document xprocess
754 Print the address of the struct Lisp_process to which $ points.
755 This command assumes that $ is a Lisp_Object.
758 define xframe
759   xgetptr $
760   print (struct frame *) $ptr
761   xgetptr $->name
762   set $ptr = (struct Lisp_String *) $ptr
763   xprintstr $ptr
764   echo \n
766 document xframe
767 Print $ as a frame pointer.
768 This command assumes $ is an Emacs Lisp frame value.
771 define xcompiled
772   xgetptr $
773   print (struct Lisp_Vector *) $ptr
774   output ($->contents[0])@($->size & 0xff)
776 document xcompiled
777 Print $ as a compiled function pointer.
778 This command assumes that $ is an Emacs Lisp compiled value.
781 define xwindow
782   xgetptr $
783   print (struct window *) $ptr
784   set $window = (struct window *) $ptr
785   xgetint $window->total_cols
786   set $width=$int
787   xgetint $window->total_lines
788   set $height=$int
789   xgetint $window->left_col
790   set $left=$int
791   xgetint $window->top_line
792   set $top=$int
793   printf "%dx%d+%d+%d\n", $width, $height, $left, $top
795 document xwindow
796 Print $ as a window pointer, assuming it is an Emacs Lisp window value.
797 Print the window's position as "WIDTHxHEIGHT+LEFT+TOP".
800 define xwinconfig
801   xgetptr $
802   print (struct save_window_data *) $ptr
804 document xwinconfig
805 Print $ as a window configuration pointer.
806 This command assumes that $ is an Emacs Lisp window configuration value.
809 define xsubr
810   xgetptr $
811   print (struct Lisp_Subr *) $ptr
812   output *$
813   echo \n
815 document xsubr
816 Print the address of the subr which the Lisp_Object $ points to.
819 define xchartable
820   xgetptr $
821   print (struct Lisp_Char_Table *) $ptr
822   printf "Purpose: "
823   xprintsym $->purpose
824   printf "  %d extra slots", ($->size & 0x1ff) - 68
825   echo \n
827 document xchartable
828 Print the address of the char-table $, and its purpose.
829 This command assumes that $ is an Emacs Lisp char-table value.
832 define xboolvector
833   xgetptr $
834   print (struct Lisp_Bool_Vector *) $ptr
835   output ($->size > 256) ? 0 : ($->data[0])@((($->size & ~gdb_array_mark_flag) + 7)/ 8)
836   echo \n
838 document xboolvector
839 Print the contents and address of the bool-vector $.
840 This command assumes that $ is an Emacs Lisp bool-vector value.
843 define xbuffer
844   xgetptr $
845   print (struct buffer *) $ptr
846   xgetptr $->name
847   output ((struct Lisp_String *) $ptr)->data
848   echo \n
850 document xbuffer
851 Set $ as a buffer pointer and the name of the buffer.
852 This command assumes $ is an Emacs Lisp buffer value.
855 define xhashtable
856   xgetptr $
857   print (struct Lisp_Hash_Table *) $ptr
859 document xhashtable
860 Set $ as a hash table pointer.
861 This command assumes that $ is an Emacs Lisp hash table value.
864 define xcons
865   xgetptr $
866   print (struct Lisp_Cons *) $ptr
867   output/x *$
868   echo \n
870 document xcons
871 Print the contents of $ as an Emacs Lisp cons.
874 define nextcons
875   p $.u.cdr
876   xcons
878 document nextcons
879 Print the contents of the next cell in a list.
880 This command assumes that the last thing you printed was a cons cell contents
881 (type struct Lisp_Cons) or a pointer to one.
883 define xcar
884   xgetptr $
885   xgettype $
886   print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
888 document xcar
889 Assume that $ is an Emacs Lisp pair and print its car.
892 define xcdr
893   xgetptr $
894   xgettype $
895   print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
897 document xcdr
898 Assume that $ is an Emacs Lisp pair and print its cdr.
901 define xlist
902   xgetptr $
903   set $cons = (struct Lisp_Cons *) $ptr
904   xgetptr Qnil
905   set $nil = $ptr
906   set $i = 0
907   while $cons != $nil && $i < 10
908     p/x $cons->car
909     xpr
910     xgetptr $cons->u.cdr
911     set $cons = (struct Lisp_Cons *) $ptr
912     set $i = $i + 1
913     printf "---\n"
914   end
915   if $cons == $nil
916     printf "nil\n"
917   else
918     printf "...\n"
919     p $ptr
920   end
922 document xlist
923 Print $ assuming it is a list.
926 define xfloat
927   xgetptr $
928   print ((struct Lisp_Float *) $ptr)->u.data
930 document xfloat
931 Print $ assuming it is a lisp floating-point number.
934 define xscrollbar
935   xgetptr $
936   print (struct scrollbar *) $ptr
937 output *$
938 echo \n
940 document xscrollbar
941 Print $ as a scrollbar pointer.
944 define xpr
945   xtype
946   if $type == Lisp_Int
947     xint
948   end
949   if $type == Lisp_Symbol
950     xsymbol
951   end
952   if $type == Lisp_String
953     xstring
954   end
955   if $type == Lisp_Cons
956     xcons
957   end
958   if $type == Lisp_Float
959     xfloat
960   end
961   if $type == Lisp_Misc
962     set $misc = (enum Lisp_Misc_Type) (((struct Lisp_Free *) $ptr)->type)
963     if $misc == Lisp_Misc_Free
964       xmiscfree
965     end
966     if $misc == Lisp_Misc_Boolfwd
967       xboolfwd
968     end
969     if $misc == Lisp_Misc_Marker
970       xmarker
971     end
972     if $misc == Lisp_Misc_Intfwd
973       xintfwd
974     end
975     if $misc == Lisp_Misc_Boolfwd
976       xboolfwd
977     end
978     if $misc == Lisp_Misc_Objfwd
979       xobjfwd
980     end
981     if $misc == Lisp_Misc_Buffer_Objfwd
982       xbufobjfwd
983     end
984     if $misc == Lisp_Misc_Buffer_Local_Value
985       xbuflocal
986     end
987 #    if $misc == Lisp_Misc_Some_Buffer_Local_Value
988 #      xvalue
989 #    end
990     if $misc == Lisp_Misc_Overlay
991       xoverlay
992     end
993     if $misc == Lisp_Misc_Kboard_Objfwd
994       xkbobjfwd
995     end
996 #    if $misc == Lisp_Misc_Save_Value
997 #      xsavevalue
998 #    end
999   end
1000   if $type == Lisp_Vectorlike
1001     set $size = ((struct Lisp_Vector *) $ptr)->size
1002     if ($size & PVEC_FLAG)
1003       set $vec = (enum pvec_type) ($size & PVEC_TYPE_MASK)
1004       if $vec == PVEC_NORMAL_VECTOR
1005         xvector
1006       end
1007       if $vec == PVEC_PROCESS
1008         xprocess
1009       end
1010       if $vec == PVEC_FRAME
1011         xframe
1012       end
1013       if $vec == PVEC_COMPILED
1014         xcompiled
1015       end
1016       if $vec == PVEC_WINDOW
1017         xwindow
1018       end
1019       if $vec == PVEC_WINDOW_CONFIGURATION
1020         xwinconfig
1021       end
1022       if $vec == PVEC_SUBR
1023         xsubr
1024       end
1025       if $vec == PVEC_CHAR_TABLE
1026         xchartable
1027       end
1028       if $vec == PVEC_BOOL_VECTOR
1029         xboolvector
1030       end
1031       if $vec == PVEC_BUFFER
1032         xbuffer
1033       end
1034       if $vec == PVEC_HASH_TABLE
1035         xhashtable
1036       end
1037     else
1038       xvector
1039     end
1040   end
1042 document xpr
1043 Print $ as a lisp object of any type.
1046 define xprintstr
1047   set $data = (char *) $arg0->data
1048   output ($arg0->size > 1000) ? 0 : ($data[0])@($arg0->size_byte < 0 ? $arg0->size & ~gdb_array_mark_flag : $arg0->size_byte)
1051 define xprintsym
1052   xgetptr $arg0
1053   set $sym = (struct Lisp_Symbol *) $ptr
1054   xgetptr $sym->xname
1055   set $sym_name = (struct Lisp_String *) $ptr
1056   xprintstr $sym_name
1058 document xprintsym
1059   Print argument as a symbol.
1062 define xcoding
1063   set $tmp = (struct Lisp_Hash_Table *) ((Vcoding_system_hash_table & $valmask) | gdb_data_seg_bits)
1064   set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & $valmask) | gdb_data_seg_bits)
1065   set $name = $tmp->contents[$arg0 * 2]
1066   print $name
1067   pr
1068   print $tmp->contents[$arg0 * 2 + 1]
1069   pr
1071 document xcoding
1072   Print the name and attributes of coding system that has ID (argument).
1075 define xcharset
1076   set $tmp = (struct Lisp_Hash_Table *) ((Vcharset_hash_table & $valmask) | gdb_data_seg_bits)
1077   set $tmp = (struct Lisp_Vector *) (($tmp->key_and_value & $valmask) | gdb_data_seg_bits)
1078   p $tmp->contents[charset_table[$arg0].hash_index * 2]
1079   pr
1081 document xcharset
1082   Print the name of charset that has ID (argument).
1085 define xfontset
1086   xgetptr $
1087   set $tbl = (struct Lisp_Char_Table *) $ptr
1088   print $tbl
1089   xgetint $tbl->extras[0]
1090   printf " ID:%d", $int
1091   xgettype $tbl->extras[1]
1092   xgetptr $tbl->extras[1]
1093   if $type == Lisp_String
1094     set $ptr = (struct Lisp_String *) $ptr
1095     printf " Name:"
1096     xprintstr $ptr
1097   else
1098     xgetptr $tbl->extras[2]
1099     set $ptr = (struct Lisp_Char_Table *) $ptr
1100     xgetptr $ptr->extras[1]
1101     set $ptr = (struct Lisp_String *) $ptr
1102     printf " Realized from:"
1103     xprintstr $ptr
1104   end
1105   echo \n
1108 define xfont
1109   xgetptr $
1110   set $size = (((struct Lisp_Vector *) $ptr)->size & 0x1FF)
1111   if $size == FONT_SPEC_MAX
1112     print (struct font_spec *) $ptr
1113   else
1114     if $size == FONT_ENTITY_MAX
1115       print (struct font_entity *) $ptr
1116     else
1117       print (struct font *) $ptr
1118     end
1119   end
1121 document xfont
1122 Print $ assuming it is a list font (font-spec, font-entity, or font-object).
1125 define xbacktrace
1126   set $bt = backtrace_list
1127   while $bt
1128     xgettype (*$bt->function)
1129     if $type == Lisp_Symbol
1130       xprintsym (*$bt->function)
1131       printf " (0x%x)\n", $bt->args
1132     else
1133       xgetptr *$bt->function
1134       printf "0x%x ", $ptr
1135       if $type == Lisp_Vectorlike
1136         xgetptr (*$bt->function)
1137         set $size = ((struct Lisp_Vector *) $ptr)->size
1138         output ($size & PVEC_FLAG) ? (enum pvec_type) ($size & PVEC_TYPE_MASK) : $size & ~gdb_array_mark_flag
1139       else
1140         printf "Lisp type %d", $type
1141       end
1142       echo \n
1143     end
1144     set $bt = $bt->next
1145   end
1147 document xbacktrace
1148   Print a backtrace of Lisp function calls from backtrace_list.
1149   Set a breakpoint at Fsignal and call this to see from where
1150   an error was signaled.
1153 define which
1154   set debug_print (which_symbols ($arg0))
1156 document which
1157   Print symbols which references a given lisp object
1158   either as its symbol value or symbol function.
1161 define xbytecode
1162   set $bt = byte_stack_list
1163   while $bt
1164     xgettype ($bt->byte_string)
1165     printf "0x%x => ", $bt->byte_string
1166     which $bt->byte_string
1167     set $bt = $bt->next
1168   end
1170 document xbytecode
1171   Print a backtrace of the byte code stack.
1174 # Show Lisp backtrace after normal backtrace.
1175 define hookpost-backtrace
1176   set $bt = backtrace_list
1177   if $bt
1178     echo \n
1179     echo Lisp Backtrace:\n
1180     xbacktrace
1181   end
1184 define xreload
1185   set $tagmask = (((long)1 << gdb_gctypebits) - 1)
1186   set $valmask = gdb_use_lsb ? ~($tagmask) : ((long)1 << gdb_valbits) - 1
1188 document xreload
1189   When starting Emacs a second time in the same gdb session under
1190   FreeBSD 2.2.5, gdb 4.13, $valmask have lost
1191   their values.  (The same happens on current (2000) versions of GNU/Linux
1192   with gdb 5.0.)
1193   This function reloads them.
1195 xreload
1197 # Flush display (X only)
1198 define ff
1199   set x_flush (0)
1201 document ff
1202 Flush pending X window display updates to screen.
1203 Works only when an inferior emacs is executing.
1207 define hook-run
1208   xreload
1211 # Call xreload if a new Emacs executable is loaded.
1212 define hookpost-run
1213   xreload
1216 set print pretty on
1217 set print sevenbit-strings
1219 show environment DISPLAY
1220 show environment TERM
1222 # People get bothered when they see messages about non-existent functions...
1223 xgetptr Vsystem_type
1224 # $ptr is NULL in temacs
1225 if ($ptr != 0)
1226   set $tem = (struct Lisp_Symbol *) $ptr
1227   xgetptr $tem->xname
1228   set $tem = (struct Lisp_String *) $ptr
1229   set $tem = (char *) $tem->data
1231   # Don't let abort actually run, as it will make stdio stop working and
1232   # therefore the `pr' command above as well.
1233   if $tem[0] == 'w' && $tem[1] == 'i' && $tem[2] == 'n' && $tem[3] == 'd'
1234     # The windows-nt build replaces abort with its own function.
1235     break w32_abort
1236   else
1237     break abort
1238   end
1241 # x_error_quitter is defined only on X.  But window-system is set up
1242 # only at run time, during Emacs startup, so we need to defer setting
1243 # the breakpoint.  init_sys_modes is the first function called on
1244 # every platform after init_display, where window-system is set.
1245 tbreak init_sys_modes
1246 commands
1247   silent
1248   xgetptr Vinitial_window_system
1249   set $tem = (struct Lisp_Symbol *) $ptr
1250   xgetptr $tem->xname
1251   set $tem = (struct Lisp_String *) $ptr
1252   set $tem = (char *) $tem->data
1253   # If we are running in synchronous mode, we want a chance to look
1254   # around before Emacs exits.  Perhaps we should put the break
1255   # somewhere else instead...
1256   if $tem[0] == 'x' && $tem[1] == '\0'
1257     break x_error_quitter
1258   end
1259   continue