GDB (xrefs)
scm-pretty-print.c
Go to the documentation of this file.
1 /* GDB/Scheme pretty-printing.
2 
3  Copyright (C) 2008-2015 Free Software Foundation, Inc.
4 
5  This file is part of GDB.
6 
7  This program 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 of the License, or
10  (at your option) any later version.
11 
12  This program 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.
16 
17  You should have received a copy of the GNU General Public License
18  along with this program. If not, see <http://www.gnu.org/licenses/>. */
19 
20 /* See README file in this directory for implementation notes, coding
21  conventions, et.al. */
22 
23 #include "defs.h"
24 #include "charset.h"
25 #include "symtab.h" /* Needed by language.h. */
26 #include "language.h"
27 #include "objfiles.h"
28 #include "value.h"
29 #include "valprint.h"
30 #include "guile-internal.h"
31 
32 /* Return type of print_string_repr. */
33 
35 {
36  /* The string method returned None. */
38  /* The string method had an error. */
40  /* Everything ok. */
42 };
43 
44 /* Display hints. */
45 
47 {
48  /* No display hint. */
50  /* The display hint has a bad value. */
52  /* Print as an array. */
54  /* Print as a map. */
56  /* Print as a string. */
58 };
59 
60 /* The <gdb:pretty-printer> smob. */
61 
62 typedef struct
63 {
64  /* This must appear first. */
66 
67  /* A string representing the name of the printer. */
68  SCM name;
69 
70  /* A boolean indicating whether the printer is enabled. */
71  SCM enabled;
72 
73  /* A procedure called to look up the printer for the given value.
74  The procedure is called as (lookup gdb:pretty-printer value).
75  The result should either be a gdb:pretty-printer object that will print
76  the value, or #f if the value is not recognized. */
77  SCM lookup;
78 
79  /* Note: Attaching subprinters to this smob is left to Scheme. */
81 
82 /* The <gdb:pretty-printer-worker> smob. */
83 
84 typedef struct
85 {
86  /* This must appear first. */
88 
89  /* Either #f or one of the supported display hints: map, array, string.
90  If neither of those then the display hint is ignored (treated as #f). */
92 
93  /* A procedure called to pretty-print the value.
94  (lambda (printer) ...) -> string | <gdb:lazy-string> | <gdb:value> */
95  SCM to_string;
96 
97  /* A procedure called to print children of the value.
98  (lambda (printer) ...) -> <gdb:iterator>
99  The iterator returns a pair for each iteration: (name . value),
100  where "value" can have the same types as to_string. */
101  SCM children;
103 
104 static const char pretty_printer_smob_name[] =
105  "gdb:pretty-printer";
106 static const char pretty_printer_worker_smob_name[] =
107  "gdb:pretty-printer-worker";
108 
109 /* The tag Guile knows the pretty-printer smobs by. */
110 static scm_t_bits pretty_printer_smob_tag;
112 
113 /* The global pretty-printer list. */
115 
116 /* gdb:pp-type-error. */
118 
119 /* Pretty-printer display hints are specified by strings. */
120 static SCM ppscm_map_string;
123 
124 /* Administrivia for pretty-printer matcher smobs. */
125 
126 /* The smob "print" function for <gdb:pretty-printer>. */
127 
128 static int
129 ppscm_print_pretty_printer_smob (SCM self, SCM port, scm_print_state *pstate)
130 {
131  pretty_printer_smob *pp_smob = (pretty_printer_smob *) SCM_SMOB_DATA (self);
132 
133  gdbscm_printf (port, "#<%s ", pretty_printer_smob_name);
134  scm_write (pp_smob->name, port);
135  scm_puts (gdbscm_is_true (pp_smob->enabled) ? " enabled" : " disabled",
136  port);
137  scm_puts (">", port);
138 
139  scm_remember_upto_here_1 (self);
140 
141  /* Non-zero means success. */
142  return 1;
143 }
144 
145 /* (make-pretty-printer string procedure) -> <gdb:pretty-printer> */
146 
147 static SCM
149 {
151  scm_gc_malloc (sizeof (pretty_printer_smob),
153  SCM smob;
154 
155  SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG1, FUNC_NAME,
156  _("string"));
157  SCM_ASSERT_TYPE (gdbscm_is_procedure (lookup), lookup, SCM_ARG2, FUNC_NAME,
158  _("procedure"));
159 
160  pp_smob->name = name;
161  pp_smob->lookup = lookup;
162  pp_smob->enabled = SCM_BOOL_T;
163  smob = scm_new_smob (pretty_printer_smob_tag, (scm_t_bits) pp_smob);
164  gdbscm_init_gsmob (&pp_smob->base);
165 
166  return smob;
167 }
168 
169 /* Return non-zero if SCM is a <gdb:pretty-printer> object. */
170 
171 static int
173 {
174  return SCM_SMOB_PREDICATE (pretty_printer_smob_tag, scm);
175 }
176 
177 /* (pretty-printer? object) -> boolean */
178 
179 static SCM
181 {
182  return scm_from_bool (ppscm_is_pretty_printer (scm));
183 }
184 
185 /* Returns the <gdb:pretty-printer> object in SELF.
186  Throws an exception if SELF is not a <gdb:pretty-printer> object. */
187 
188 static SCM
189 ppscm_get_pretty_printer_arg_unsafe (SCM self, int arg_pos,
190  const char *func_name)
191 {
192  SCM_ASSERT_TYPE (ppscm_is_pretty_printer (self), self, arg_pos, func_name,
194 
195  return self;
196 }
197 
198 /* Returns a pointer to the pretty-printer smob of SELF.
199  Throws an exception if SELF is not a <gdb:pretty-printer> object. */
200 
201 static pretty_printer_smob *
203  const char *func_name)
204 {
205  SCM pp_scm = ppscm_get_pretty_printer_arg_unsafe (self, arg_pos, func_name);
206  pretty_printer_smob *pp_smob
207  = (pretty_printer_smob *) SCM_SMOB_DATA (pp_scm);
208 
209  return pp_smob;
210 }
211 
212 /* Pretty-printer methods. */
213 
214 /* (pretty-printer-enabled? <gdb:pretty-printer>) -> boolean */
215 
216 static SCM
218 {
219  pretty_printer_smob *pp_smob
221 
222  return pp_smob->enabled;
223 }
224 
225 /* (set-pretty-printer-enabled! <gdb:pretty-printer> boolean)
226  -> unspecified */
227 
228 static SCM
229 gdbscm_set_pretty_printer_enabled_x (SCM self, SCM enabled)
230 {
231  pretty_printer_smob *pp_smob
233 
234  pp_smob->enabled = scm_from_bool (gdbscm_is_true (enabled));
235 
236  return SCM_UNSPECIFIED;
237 }
238 
239 /* (pretty-printers) -> list
240  Returns the list of global pretty-printers. */
241 
242 static SCM
244 {
245  return pretty_printer_list;
246 }
247 
248 /* (set-pretty-printers! list) -> unspecified
249  Set the global pretty-printers list. */
250 
251 static SCM
253 {
254  SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers)), printers,
255  SCM_ARG1, FUNC_NAME, _("list"));
256 
257  pretty_printer_list = printers;
258 
259  return SCM_UNSPECIFIED;
260 }
261 
262 /* Administrivia for pretty-printer-worker smobs.
263  These are created when a matcher recognizes a value. */
264 
265 /* The smob "print" function for <gdb:pretty-printer-worker>. */
266 
267 static int
269  scm_print_state *pstate)
270 {
272  = (pretty_printer_worker_smob *) SCM_SMOB_DATA (self);
273 
275  scm_write (w_smob->display_hint, port);
276  scm_puts (" ", port);
277  scm_write (w_smob->to_string, port);
278  scm_puts (" ", port);
279  scm_write (w_smob->children, port);
280  scm_puts (">", port);
281 
282  scm_remember_upto_here_1 (self);
283 
284  /* Non-zero means success. */
285  return 1;
286 }
287 
288 /* (make-pretty-printer-worker string procedure procedure)
289  -> <gdb:pretty-printer-worker> */
290 
291 static SCM
293  SCM children)
294 {
296  scm_gc_malloc (sizeof (pretty_printer_worker_smob),
298  SCM w_scm;
299 
300  w_smob->display_hint = display_hint;
301  w_smob->to_string = to_string;
302  w_smob->children = children;
303  w_scm = scm_new_smob (pretty_printer_worker_smob_tag, (scm_t_bits) w_smob);
304  gdbscm_init_gsmob (&w_smob->base);
305  return w_scm;
306 }
307 
308 /* Return non-zero if SCM is a <gdb:pretty-printer-worker> object. */
309 
310 static int
312 {
313  return SCM_SMOB_PREDICATE (pretty_printer_worker_smob_tag, scm);
314 }
315 
316 /* (pretty-printer-worker? object) -> boolean */
317 
318 static SCM
320 {
321  return scm_from_bool (ppscm_is_pretty_printer_worker (scm));
322 }
323 
324 /* Helper function to create a <gdb:exception> object indicating that the
325  type of some value returned from a pretty-printer is invalid. */
326 
327 static SCM
328 ppscm_make_pp_type_error_exception (const char *message, SCM object)
329 {
330  char *msg = xstrprintf ("%s: ~S", message);
331  struct cleanup *cleanup = make_cleanup (xfree, msg);
332  SCM exception
334  NULL /* func */, msg,
335  scm_list_1 (object), scm_list_1 (object));
336 
337  do_cleanups (cleanup);
338 
339  return exception;
340 }
341 
342 /* Print MESSAGE as an exception (meaning it is controlled by
343  "guile print-stack").
344  Called from the printer code when the Scheme code returns an invalid type
345  for something. */
346 
347 static void
348 ppscm_print_pp_type_error (const char *message, SCM object)
349 {
350  SCM exception = ppscm_make_pp_type_error_exception (message, object);
351 
352  gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
353 }
354 
355 /* Helper function for find_pretty_printer which iterates over a list,
356  calls each function and inspects output. This will return a
357  <gdb:pretty-printer> object if one recognizes VALUE. If no printer is
358  found, it will return #f. On error, it will return a <gdb:exception>
359  object.
360 
361  Note: This has to be efficient and careful.
362  We don't want to excessively slow down printing of values, but any kind of
363  random crud can appear in the pretty-printer list, and we can't crash
364  because of it. */
365 
366 static SCM
368 {
369  SCM orig_list = list;
370 
371  if (scm_is_null (list))
372  return SCM_BOOL_F;
373  if (gdbscm_is_false (scm_list_p (list))) /* scm_is_pair? */
374  {
376  (_("pretty-printer list is not a list"), list);
377  }
378 
379  for ( ; scm_is_pair (list); list = scm_cdr (list))
380  {
381  SCM matcher = scm_car (list);
382  SCM worker;
383  pretty_printer_smob *pp_smob;
384  int rc;
385 
386  if (!ppscm_is_pretty_printer (matcher))
387  {
389  (_("pretty-printer list contains non-pretty-printer object"),
390  matcher);
391  }
392 
393  pp_smob = (pretty_printer_smob *) SCM_SMOB_DATA (matcher);
394 
395  /* Skip if disabled. */
396  if (gdbscm_is_false (pp_smob->enabled))
397  continue;
398 
399  if (!gdbscm_is_procedure (pp_smob->lookup))
400  {
402  (_("invalid lookup object in pretty-printer matcher"),
403  pp_smob->lookup);
404  }
405 
406  worker = gdbscm_safe_call_2 (pp_smob->lookup, matcher,
407  value, gdbscm_memory_error_p);
408  if (!gdbscm_is_false (worker))
409  {
410  if (gdbscm_is_exception (worker))
411  return worker;
412  if (ppscm_is_pretty_printer_worker (worker))
413  return worker;
415  (_("invalid result from pretty-printer lookup"), worker);
416  }
417  }
418 
419  if (!scm_is_null (list))
420  {
422  (_("pretty-printer list is not a list"), orig_list);
423  }
424 
425  return SCM_BOOL_F;
426 }
427 
428 /* Subroutine of find_pretty_printer to simplify it.
429  Look for a pretty-printer to print VALUE in all objfiles.
430  If there's an error an exception smob is returned.
431  The result is #f, if no pretty-printer was found.
432  Otherwise the result is the pretty-printer smob. */
433 
434 static SCM
436 {
437  struct objfile *objfile;
438 
439  ALL_OBJFILES (objfile)
440  {
441  objfile_smob *o_smob = ofscm_objfile_smob_from_objfile (objfile);
443  value);
444 
445  /* Note: This will return if pp is a <gdb:exception> object,
446  which is what we want. */
447  if (gdbscm_is_true (pp))
448  return pp;
449  }
450 
451  return SCM_BOOL_F;
452 }
453 
454 /* Subroutine of find_pretty_printer to simplify it.
455  Look for a pretty-printer to print VALUE in the current program space.
456  If there's an error an exception smob is returned.
457  The result is #f, if no pretty-printer was found.
458  Otherwise the result is the pretty-printer smob. */
459 
460 static SCM
462 {
464  SCM pp
466 
467  return pp;
468 }
469 
470 /* Subroutine of find_pretty_printer to simplify it.
471  Look for a pretty-printer to print VALUE in the gdb module.
472  If there's an error a Scheme exception is returned.
473  The result is #f, if no pretty-printer was found.
474  Otherwise the result is the pretty-printer smob. */
475 
476 static SCM
478 {
479  SCM pp = ppscm_search_pp_list (pretty_printer_list, value);
480 
481  return pp;
482 }
483 
484 /* Find the pretty-printing constructor function for VALUE. If no
485  pretty-printer exists, return #f. If one exists, return the
486  gdb:pretty-printer smob that implements it. On error, an exception smob
487  is returned.
488 
489  Note: In the end it may be better to call out to Scheme once, and then
490  do all of the lookup from Scheme. TBD. */
491 
492 static SCM
494 {
495  SCM pp;
496 
497  /* Look at the pretty-printer list for each objfile
498  in the current program-space. */
500  /* Note: This will return if function is a <gdb:exception> object,
501  which is what we want. */
502  if (gdbscm_is_true (pp))
503  return pp;
504 
505  /* Look at the pretty-printer list for the current program-space. */
507  /* Note: This will return if function is a <gdb:exception> object,
508  which is what we want. */
509  if (gdbscm_is_true (pp))
510  return pp;
511 
512  /* Look at the pretty-printer list in the gdb module. */
514  return pp;
515 }
516 
517 /* Pretty-print a single value, via the PRINTER, which must be a
518  <gdb:pretty-printer-worker> object.
519  The caller is responsible for ensuring PRINTER is valid.
520  If the function returns a string, an SCM containing the string
521  is returned. If the function returns #f that means the pretty
522  printer returned #f as a value. Otherwise, if the function returns a
523  <gdb:value> object, *OUT_VALUE is set to the value and #t is returned.
524  It is an error if the printer returns #t.
525  On error, an exception smob is returned. */
526 
527 static SCM
528 ppscm_pretty_print_one_value (SCM printer, struct value **out_value,
529  struct gdbarch *gdbarch,
530  const struct language_defn *language)
531 {
532  SCM result = SCM_BOOL_F;
533 
534  *out_value = NULL;
535  TRY
536  {
537  int rc;
539  = (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
540 
541  result = gdbscm_safe_call_1 (w_smob->to_string, printer,
543  if (gdbscm_is_false (result))
544  ; /* Done. */
545  else if (scm_is_string (result)
546  || lsscm_is_lazy_string (result))
547  ; /* Done. */
548  else if (vlscm_is_value (result))
549  {
550  SCM except_scm;
551 
552  *out_value
554  result, &except_scm,
555  gdbarch, language);
556  if (*out_value != NULL)
557  result = SCM_BOOL_T;
558  else
559  result = except_scm;
560  }
561  else if (gdbscm_is_exception (result))
562  ; /* Done. */
563  else
564  {
565  /* Invalid result from to-string. */
567  (_("invalid result from pretty-printer to-string"), result);
568  }
569  }
570  CATCH (except, RETURN_MASK_ALL)
571  {
572  }
573  END_CATCH
574 
575  return result;
576 }
577 
578 /* Return the display hint for PRINTER as a Scheme object.
579  The caller is responsible for ensuring PRINTER is a
580  <gdb:pretty-printer-worker> object. */
581 
582 static SCM
584 {
586  = (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
587 
588  return w_smob->display_hint;
589 }
590 
591 /* Return the display hint for the pretty-printer PRINTER.
592  The caller is responsible for ensuring PRINTER is a
593  <gdb:pretty-printer-worker> object.
594  Returns the display hint or #f if the hint is not a string. */
595 
596 static enum display_hint
598 {
599  SCM hint = ppscm_get_display_hint_scm (printer);
600 
601  if (gdbscm_is_false (hint))
602  return HINT_NONE;
603  if (scm_is_string (hint))
604  {
605  if (gdbscm_is_true (scm_string_equal_p (hint, ppscm_array_string)))
606  return HINT_STRING;
607  if (gdbscm_is_true (scm_string_equal_p (hint, ppscm_map_string)))
608  return HINT_STRING;
609  if (gdbscm_is_true (scm_string_equal_p (hint, ppscm_string_string)))
610  return HINT_STRING;
611  return HINT_ERROR;
612  }
613  return HINT_ERROR;
614 }
615 
616 /* A wrapper for gdbscm_print_gdb_exception that ignores memory errors.
617  EXCEPTION is a <gdb:exception> object. */
618 
619 static void
621  struct ui_file *stream)
622 {
624  {
625  char *msg = gdbscm_exception_message_to_string (exception);
626  struct cleanup *cleanup = make_cleanup (xfree, msg);
627 
628  /* This "shouldn't happen", but play it safe. */
629  if (msg == NULL || *msg == '\0')
630  fprintf_filtered (stream, _("<error reading variable>"));
631  else
632  {
633  /* Remove the trailing newline. We could instead call a special
634  routine for printing memory error messages, but this is easy
635  enough for now. */
636  size_t len = strlen (msg);
637 
638  if (msg[len - 1] == '\n')
639  msg[len - 1] = '\0';
640  fprintf_filtered (stream, _("<error reading variable: %s>"), msg);
641  }
642 
643  do_cleanups (cleanup);
644  }
645  else
646  gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
647 }
648 
649 /* Helper for gdbscm_apply_val_pretty_printer which calls to_string and
650  formats the result. */
651 
652 static enum string_repr_result
653 ppscm_print_string_repr (SCM printer, enum display_hint hint,
654  struct ui_file *stream, int recurse,
655  const struct value_print_options *options,
656  struct gdbarch *gdbarch,
657  const struct language_defn *language)
658 {
659  struct value *replacement = NULL;
660  SCM str_scm;
662 
663  str_scm = ppscm_pretty_print_one_value (printer, &replacement,
664  gdbarch, language);
665  if (gdbscm_is_false (str_scm))
666  {
667  result = STRING_REPR_NONE;
668  }
669  else if (scm_is_eq (str_scm, SCM_BOOL_T))
670  {
671  struct value_print_options opts = *options;
672 
673  gdb_assert (replacement != NULL);
674  opts.addressprint = 0;
675  common_val_print (replacement, stream, recurse, &opts, language);
676  result = STRING_REPR_OK;
677  }
678  else if (scm_is_string (str_scm))
679  {
680  struct cleanup *cleanup;
681  size_t length;
682  char *string
683  = gdbscm_scm_to_string (str_scm, &length,
684  target_charset (gdbarch), 0 , NULL);
685 
686  cleanup = make_cleanup (xfree, string);
687  if (hint == HINT_STRING)
688  {
689  struct type *type = builtin_type (gdbarch)->builtin_char;
690 
691  LA_PRINT_STRING (stream, type, (gdb_byte *) string,
692  length, NULL, 0, options);
693  }
694  else
695  {
696  /* Alas scm_to_stringn doesn't nul-terminate the string if we
697  ask for the length. */
698  size_t i;
699 
700  for (i = 0; i < length; ++i)
701  {
702  if (string[i] == '\0')
703  fputs_filtered ("\\000", stream);
704  else
705  fputc_filtered (string[i], stream);
706  }
707  }
708  result = STRING_REPR_OK;
709  do_cleanups (cleanup);
710  }
711  else if (lsscm_is_lazy_string (str_scm))
712  {
713  struct value_print_options local_opts = *options;
714 
715  local_opts.addressprint = 0;
716  lsscm_val_print_lazy_string (str_scm, stream, &local_opts);
717  result = STRING_REPR_OK;
718  }
719  else
720  {
721  gdb_assert (gdbscm_is_exception (str_scm));
723  result = STRING_REPR_ERROR;
724  }
725 
726  return result;
727 }
728 
729 /* Helper for gdbscm_apply_val_pretty_printer that formats children of the
730  printer, if any exist.
731  The caller is responsible for ensuring PRINTER is a printer smob.
732  If PRINTED_NOTHING is true, then nothing has been printed by to_string,
733  and format output accordingly. */
734 
735 static void
736 ppscm_print_children (SCM printer, enum display_hint hint,
737  struct ui_file *stream, int recurse,
738  const struct value_print_options *options,
739  struct gdbarch *gdbarch,
740  const struct language_defn *language,
741  int printed_nothing)
742 {
744  = (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
745  int is_map, is_array, done_flag, pretty;
746  unsigned int i;
747  SCM children, status;
748  SCM iter = SCM_BOOL_F; /* -Wall */
749  struct cleanup *cleanups;
750 
751  if (gdbscm_is_false (w_smob->children))
752  return;
753  if (!gdbscm_is_procedure (w_smob->children))
754  {
756  (_("pretty-printer \"children\" object is not a procedure or #f"),
757  w_smob->children);
758  return;
759  }
760 
761  cleanups = make_cleanup (null_cleanup, NULL);
762 
763  /* If we are printing a map or an array, we want special formatting. */
764  is_map = hint == HINT_MAP;
765  is_array = hint == HINT_ARRAY;
766 
767  children = gdbscm_safe_call_1 (w_smob->children, printer,
769  if (gdbscm_is_exception (children))
770  {
772  goto done;
773  }
774  /* We combine two steps here: get children, make an iterator out of them.
775  This simplifies things because there's no language means of creating
776  iterators, and it's the printer object that knows how it will want its
777  children iterated over. */
778  if (!itscm_is_iterator (children))
779  {
781  (_("result of pretty-printer \"children\" procedure is not"
782  " a <gdb:iterator> object"), children);
783  goto done;
784  }
785  iter = children;
786 
787  /* Use the prettyformat_arrays option if we are printing an array,
788  and the pretty option otherwise. */
789  if (is_array)
790  pretty = options->prettyformat_arrays;
791  else
792  {
793  if (options->prettyformat == Val_prettyformat)
794  pretty = 1;
795  else
796  pretty = options->prettyformat_structs;
797  }
798 
799  done_flag = 0;
800  for (i = 0; i < options->print_max; ++i)
801  {
802  int rc;
803  SCM scm_name, v_scm;
804  char *name;
806  struct cleanup *inner_cleanup = make_cleanup (null_cleanup, NULL);
807 
808  if (gdbscm_is_exception (item))
809  {
811  break;
812  }
813  if (itscm_is_end_of_iteration (item))
814  {
815  /* Set a flag so we can know whether we printed all the
816  available elements. */
817  done_flag = 1;
818  break;
819  }
820 
821  if (! scm_is_pair (item))
822  {
824  (_("result of pretty-printer children iterator is not a pair"
825  " or (end-of-iteration)"),
826  item);
827  continue;
828  }
829  scm_name = scm_car (item);
830  v_scm = scm_cdr (item);
831  if (!scm_is_string (scm_name))
832  {
834  (_("first element of pretty-printer children iterator is not"
835  " a string"), item);
836  continue;
837  }
838  name = gdbscm_scm_to_c_string (scm_name);
839  make_cleanup (xfree, name);
840 
841  /* Print initial "{". For other elements, there are three cases:
842  1. Maps. Print a "," after each value element.
843  2. Arrays. Always print a ",".
844  3. Other. Always print a ",". */
845  if (i == 0)
846  {
847  if (printed_nothing)
848  fputs_filtered ("{", stream);
849  else
850  fputs_filtered (" = {", stream);
851  }
852 
853  else if (! is_map || i % 2 == 0)
854  fputs_filtered (pretty ? "," : ", ", stream);
855 
856  /* In summary mode, we just want to print "= {...}" if there is
857  a value. */
858  if (options->summary)
859  {
860  /* This increment tricks the post-loop logic to print what
861  we want. */
862  ++i;
863  /* Likewise. */
864  pretty = 0;
865  break;
866  }
867 
868  if (! is_map || i % 2 == 0)
869  {
870  if (pretty)
871  {
872  fputs_filtered ("\n", stream);
873  print_spaces_filtered (2 + 2 * recurse, stream);
874  }
875  else
876  wrap_here (n_spaces (2 + 2 *recurse));
877  }
878 
879  if (is_map && i % 2 == 0)
880  fputs_filtered ("[", stream);
881  else if (is_array)
882  {
883  /* We print the index, not whatever the child method
884  returned as the name. */
885  if (options->print_array_indexes)
886  fprintf_filtered (stream, "[%d] = ", i);
887  }
888  else if (! is_map)
889  {
890  fputs_filtered (name, stream);
891  fputs_filtered (" = ", stream);
892  }
893 
894  if (lsscm_is_lazy_string (v_scm))
895  {
896  struct value_print_options local_opts = *options;
897 
898  local_opts.addressprint = 0;
899  lsscm_val_print_lazy_string (v_scm, stream, &local_opts);
900  }
901  else if (scm_is_string (v_scm))
902  {
903  char *output = gdbscm_scm_to_c_string (v_scm);
904 
905  fputs_filtered (output, stream);
906  xfree (output);
907  }
908  else
909  {
910  SCM except_scm;
911  struct value *value
913  v_scm, &except_scm,
914  gdbarch, language);
915 
916  if (value == NULL)
917  {
918  ppscm_print_exception_unless_memory_error (except_scm, stream);
919  break;
920  }
921  common_val_print (value, stream, recurse + 1, options, language);
922  }
923 
924  if (is_map && i % 2 == 0)
925  fputs_filtered ("] = ", stream);
926 
927  do_cleanups (inner_cleanup);
928  }
929 
930  if (i)
931  {
932  if (!done_flag)
933  {
934  if (pretty)
935  {
936  fputs_filtered ("\n", stream);
937  print_spaces_filtered (2 + 2 * recurse, stream);
938  }
939  fputs_filtered ("...", stream);
940  }
941  if (pretty)
942  {
943  fputs_filtered ("\n", stream);
944  print_spaces_filtered (2 * recurse, stream);
945  }
946  fputs_filtered ("}", stream);
947  }
948 
949  done:
950  do_cleanups (cleanups);
951 
952  /* Play it safe, make sure ITER doesn't get GC'd. */
953  scm_remember_upto_here_1 (iter);
954 }
955 
956 /* This is the extension_language_ops.apply_val_pretty_printer "method". */
957 
958 enum ext_lang_rc
960  struct type *type, const gdb_byte *valaddr,
962  struct ui_file *stream, int recurse,
963  const struct value *val,
964  const struct value_print_options *options,
965  const struct language_defn *language)
966 {
967  struct gdbarch *gdbarch = get_type_arch (type);
968  SCM exception = SCM_BOOL_F;
969  SCM printer = SCM_BOOL_F;
970  SCM val_obj = SCM_BOOL_F;
971  struct value *value;
972  enum display_hint hint;
973  struct cleanup *cleanups;
974  int result = EXT_LANG_RC_NOP;
975  enum string_repr_result print_result;
976 
977  /* No pretty-printer support for unavailable values. */
978  if (!value_bytes_available (val, embedded_offset, TYPE_LENGTH (type)))
979  return EXT_LANG_RC_NOP;
980 
982  return EXT_LANG_RC_NOP;
983 
984  cleanups = make_cleanup (null_cleanup, NULL);
985 
986  /* Instantiate the printer. */
987  if (valaddr)
988  valaddr += embedded_offset;
989  value = value_from_contents_and_address (type, valaddr,
990  address + embedded_offset);
991 
992  set_value_component_location (value, val);
993  /* set_value_component_location resets the address, so we may
994  need to set it again. */
995  if (VALUE_LVAL (value) != lval_internalvar
997  && VALUE_LVAL (value) != lval_computed)
998  set_value_address (value, address + embedded_offset);
999 
1000  val_obj = vlscm_scm_from_value (value);
1001  if (gdbscm_is_exception (val_obj))
1002  {
1003  exception = val_obj;
1004  result = EXT_LANG_RC_ERROR;
1005  goto done;
1006  }
1007 
1008  printer = ppscm_find_pretty_printer (val_obj);
1009 
1010  if (gdbscm_is_exception (printer))
1011  {
1012  exception = printer;
1013  result = EXT_LANG_RC_ERROR;
1014  goto done;
1015  }
1016  if (gdbscm_is_false (printer))
1017  {
1018  result = EXT_LANG_RC_NOP;
1019  goto done;
1020  }
1022 
1023  /* If we are printing a map, we want some special formatting. */
1024  hint = ppscm_get_display_hint_enum (printer);
1025  if (hint == HINT_ERROR)
1026  {
1027  /* Print the error as an exception for consistency. */
1028  SCM hint_scm = ppscm_get_display_hint_scm (printer);
1029 
1030  ppscm_print_pp_type_error ("Invalid display hint", hint_scm);
1031  /* Fall through. A bad hint doesn't stop pretty-printing. */
1032  hint = HINT_NONE;
1033  }
1034 
1035  /* Print the section. */
1036  print_result = ppscm_print_string_repr (printer, hint, stream, recurse,
1037  options, gdbarch, language);
1038  if (print_result != STRING_REPR_ERROR)
1039  {
1040  ppscm_print_children (printer, hint, stream, recurse, options,
1041  gdbarch, language,
1042  print_result == STRING_REPR_NONE);
1043  }
1044 
1045  result = EXT_LANG_RC_OK;
1046 
1047  done:
1048  if (gdbscm_is_exception (exception))
1049  ppscm_print_exception_unless_memory_error (exception, stream);
1050  do_cleanups (cleanups);
1051  return result;
1052 }
1053 
1054 /* Initialize the Scheme pretty-printer code. */
1055 
1056 static const scheme_function pretty_printer_functions[] =
1057 {
1058  { "make-pretty-printer", 2, 0, 0, gdbscm_make_pretty_printer,
1059  "\
1060 Create a <gdb:pretty-printer> object.\n\
1061 \n\
1062  Arguments: name lookup\n\
1063  name: a string naming the matcher\n\
1064  lookup: a procedure:\n\
1065  (pretty-printer <gdb:value>) -> <gdb:pretty-printer-worker> | #f." },
1066 
1067  { "pretty-printer?", 1, 0, 0, gdbscm_pretty_printer_p,
1068  "\
1069 Return #t if the object is a <gdb:pretty-printer> object." },
1070 
1071  { "pretty-printer-enabled?", 1, 0, 0, gdbscm_pretty_printer_enabled_p,
1072  "\
1073 Return #t if the pretty-printer is enabled." },
1074 
1075  { "set-pretty-printer-enabled!", 2, 0, 0,
1077  "\
1078 Set the enabled flag of the pretty-printer.\n\
1079 Returns \"unspecified\"." },
1080 
1081  { "make-pretty-printer-worker", 3, 0, 0, gdbscm_make_pretty_printer_worker,
1082  "\
1083 Create a <gdb:pretty-printer-worker> object.\n\
1084 \n\
1085  Arguments: display-hint to-string children\n\
1086  display-hint: either #f or one of \"array\", \"map\", or \"string\"\n\
1087  to-string: a procedure:\n\
1088  (pretty-printer) -> string | #f | <gdb:value>\n\
1089  children: either #f or a procedure:\n\
1090  (pretty-printer) -> <gdb:iterator>" },
1091 
1092  { "pretty-printer-worker?", 1, 0, 0, gdbscm_pretty_printer_worker_p,
1093  "\
1094 Return #t if the object is a <gdb:pretty-printer-worker> object." },
1095 
1096  { "pretty-printers", 0, 0, 0, gdbscm_pretty_printers,
1097  "\
1098 Return the list of global pretty-printers." },
1099 
1100  { "set-pretty-printers!", 1, 0, 0,
1102  "\
1103 Set the list of global pretty-printers." },
1104 
1106 };
1107 
1108 void
1110 {
1113  sizeof (pretty_printer_smob));
1114  scm_set_smob_print (pretty_printer_smob_tag,
1116 
1119  sizeof (pretty_printer_worker_smob));
1120  scm_set_smob_print (pretty_printer_worker_smob_tag,
1122 
1123  gdbscm_define_functions (pretty_printer_functions, 1);
1124 
1125  pretty_printer_list = SCM_EOL;
1126 
1127  pp_type_error_symbol = scm_from_latin1_symbol ("gdb:pp-type-error");
1128 
1129  ppscm_map_string = scm_from_latin1_string ("map");
1130  ppscm_array_string = scm_from_latin1_string ("array");
1131  ppscm_string_string = scm_from_latin1_string ("string");
1132 }
static enum display_hint ppscm_get_display_hint_enum(SCM printer)
static SCM ppscm_array_string
const char * target_charset(struct gdbarch *gdbarch)
Definition: charset.c:407
static SCM scm_new_smob(scm_t_bits tc, scm_t_bits data)
static SCM gdbscm_set_pretty_printer_enabled_x(SCM self, SCM enabled)
static SCM ppscm_find_pretty_printer_from_objfiles(SCM value)
static SCM gdbscm_make_pretty_printer(SCM name, SCM lookup)
void gdbscm_define_functions(const scheme_function *, int is_public)
Definition: scm-utils.c:44
struct value * value_from_contents_and_address(struct type *type, const gdb_byte *valaddr, CORE_ADDR address)
Definition: value.c:3529
bfd_vma CORE_ADDR
Definition: common-types.h:41
static pretty_printer_smob * ppscm_get_pretty_printer_smob_arg_unsafe(SCM self, int arg_pos, const char *func_name)
void xfree(void *)
Definition: common-utils.c:97
ext_lang_rc
static SCM ppscm_search_pp_list(SCM list, SCM value)
int fputc_filtered(int c, struct ui_file *stream)
Definition: utils.c:2178
struct value * vlscm_convert_value_from_scheme(const char *func_name, int obj_arg_pos, SCM obj, SCM *except_scmp, struct gdbarch *gdbarch, const struct language_defn *language)
Definition: scm-math.c:893
static SCM ppscm_get_pretty_printer_arg_unsafe(SCM self, int arg_pos, const char *func_name)
static SCM ppscm_map_string
char * gdbscm_scm_to_c_string(SCM string)
Definition: scm-string.c:55
static SCM ppscm_find_pretty_printer(SCM value)
const struct builtin_type * builtin_type(struct gdbarch *gdbarch)
Definition: gdbtypes.c:4766
void common_val_print(struct value *val, struct ui_file *stream, int recurse, const struct value_print_options *options, const struct language_defn *language)
Definition: valprint.c:846
#define FUNC_NAME
int vlscm_is_value(SCM scm)
Definition: scm-value.c:240
static int ppscm_print_pretty_printer_worker_smob(SCM self, SCM port, scm_print_state *pstate)
scm_t_bits gdbscm_make_smob_type(const char *name, size_t size)
Definition: scm-gsmob.c:102
#define _(String)
Definition: gdb_locale.h:40
static SCM gdbscm_pretty_printer_p(SCM scm)
static SCM gdbscm_pretty_printer_enabled_p(SCM self)
#define END_CATCH
enum val_prettyformat prettyformat
Definition: valprint.h:28
SCM vlscm_scm_from_value(struct value *value)
Definition: scm-value.c:258
#define VALUE_LVAL(val)
Definition: value.h:411
int gdbscm_is_exception(SCM scm)
#define gdbscm_is_true(scm)
#define GDBSCM_ARG_NONE
void set_value_address(struct value *value, CORE_ADDR addr)
Definition: value.c:1463
void null_cleanup(void *arg)
Definition: cleanups.c:295
#define TRY
const char *const name
Definition: aarch64-tdep.c:68
#define ALL_OBJFILES(obj)
Definition: objfiles.h:579
void gdbscm_init_gsmob(gdb_smob *base)
Definition: scm-gsmob.c:113
void gdbscm_initialize_pretty_printers(void)
#define CATCH(EXCEPTION, MASK)
char * gdbscm_exception_message_to_string(SCM exception)
objfile_smob * ofscm_objfile_smob_from_objfile(struct objfile *objfile)
Definition: scm-objfile.c:147
static scm_t_bits pretty_printer_smob_tag
static struct parser_state * pstate
Definition: ada-exp.c:149
static scm_t_bits pretty_printer_worker_smob_tag
static SCM gdbscm_pretty_printer_worker_p(SCM scm)
void fprintf_filtered(struct ui_file *stream, const char *format,...)
Definition: utils.c:2351
SCM gdbscm_exception_key(SCM excp)
excp_matcher_func gdbscm_memory_error_p
#define gdbscm_is_false(scm)
static int ppscm_is_pretty_printer(SCM scm)
mach_port_t mach_port_t name mach_port_t mach_port_t name error_t int status
Definition: gnu-nat.c:1816
static SCM ppscm_find_pretty_printer_from_gdb(SCM value)
void fputs_filtered(const char *linebuffer, struct ui_file *stream)
Definition: utils.c:2145
int prettyformat_structs
Definition: valprint.h:34
struct cleanup * make_cleanup(make_cleanup_ftype *function, void *arg)
Definition: cleanups.c:117
Definition: gdbtypes.h:749
SCM gdbscm_safe_call_2(SCM proc, SCM arg0, SCM arg1, excp_matcher_func *ok_excps)
struct gdbarch * get_type_arch(const struct type *type)
Definition: gdbtypes.c:232
SCM ofscm_objfile_smob_pretty_printers(objfile_smob *o_smob)
Definition: scm-objfile.c:58
char * n_spaces(int n)
Definition: utils.c:2442
#define gdb_assert(expr)
Definition: gdb_assert.h:33
static void ppscm_print_pp_type_error(const char *message, SCM object)
static SCM gdbscm_make_pretty_printer_worker(SCM display_hint, SCM to_string, SCM children)
static int ppscm_print_pretty_printer_smob(SCM self, SCM port, scm_print_state *pstate)
static SCM gdbscm_set_pretty_printers_x(SCM printers)
void lsscm_val_print_lazy_string(SCM string, struct ui_file *stream, const struct value_print_options *options)
int lsscm_is_lazy_string(SCM scm)
char * xstrprintf(const char *format,...)
Definition: common-utils.c:107
void wrap_here(char *indent)
Definition: utils.c:1930
enum ext_lang_rc gdbscm_apply_val_pretty_printer(const struct extension_language_defn *extlang, struct type *type, const gdb_byte *valaddr, int embedded_offset, CORE_ADDR address, struct ui_file *stream, int recurse, const struct value *val, const struct value_print_options *options, const struct language_defn *language)
display_hint
void gdbscm_printf(SCM port, const char *format,...) ATTRIBUTE_PRINTF(2
static SCM ppscm_get_display_hint_scm(SCM printer)
Definition: value.c:172
static SCM ppscm_pretty_print_one_value(SCM printer, struct value **out_value, struct gdbarch *gdbarch, const struct language_defn *language)
int itscm_is_end_of_iteration(SCM obj)
Definition: scm-iterator.c:197
SCM gdbscm_safe_call_1(SCM proc, SCM arg0, excp_matcher_func *ok_excps)
static int ppscm_is_pretty_printer_worker(SCM scm)
void print_spaces_filtered(int n, struct ui_file *stream)
Definition: utils.c:2464
bfd_byte gdb_byte
Definition: common-types.h:38
unsigned length
Definition: gdbtypes.h:807
#define END_FUNCTIONS
struct type * builtin_char
Definition: gdbtypes.h:1481
void gdbscm_print_gdb_exception(SCM port, SCM exception)
static SCM ppscm_string_string
static void ppscm_print_children(SCM printer, enum display_hint hint, struct ui_file *stream, int recurse, const struct value_print_options *options, struct gdbarch *gdbarch, const struct language_defn *language, int printed_nothing)
SCM psscm_pspace_smob_pretty_printers(const pspace_smob *)
Definition: scm-progspace.c:61
static const char pretty_printer_smob_name[]
int value_bytes_available(const struct value *value, int offset, int length)
Definition: value.c:352
static SCM pretty_printer_list
static SCM ppscm_make_pp_type_error_exception(const char *message, SCM object)
struct program_space * current_program_space
Definition: progspace.c:35
SCM gdbscm_make_error(SCM key, const char *subr, const char *message, SCM args, SCM data)
language
Definition: defs.h:167
SCM itscm_safe_call_next_x(SCM iter, excp_matcher_func *ok_excps)
Definition: scm-iterator.c:215
static SCM gdbscm_pretty_printers(void)
unsigned int print_max
Definition: valprint.h:53
static enum string_repr_result ppscm_print_string_repr(SCM printer, enum display_hint hint, struct ui_file *stream, int recurse, const struct value_print_options *options, struct gdbarch *gdbarch, const struct language_defn *language)
int gdb_scheme_initialized
static void ppscm_print_exception_unless_memory_error(SCM exception, struct ui_file *stream)
#define LA_PRINT_STRING(stream, elttype, string, length, encoding, force_ellipses, options)
Definition: language.h:496
static SCM pp_type_error_symbol
int itscm_is_iterator(SCM scm)
Definition: scm-iterator.c:172
string_repr_result
#define TYPE_LENGTH(thistype)
Definition: gdbtypes.h:1237
CORE_ADDR address
Definition: value.c:216
static SCM ppscm_find_pretty_printer_from_progspace(SCM value)
pspace_smob * psscm_pspace_smob_from_pspace(struct program_space *)
int gdbscm_is_procedure(SCM proc)
Definition: scm-utils.c:579
static const char pretty_printer_worker_smob_name[]
SCM char * gdbscm_scm_to_string(SCM string, size_t *lenp, const char *charset, int strict, SCM *except_scmp)
Definition: scm-string.c:120
int embedded_offset
Definition: value.c:312
void do_cleanups(struct cleanup *old_chain)
Definition: cleanups.c:175
void set_value_component_location(struct value *component, const struct value *whole)
Definition: value.c:1761
const ULONGEST const LONGEST len
Definition: target.h:309