GDB (xrefs)
scm-lazy-string.c
Go to the documentation of this file.
1 /* Scheme interface to lazy strings.
2 
3  Copyright (C) 2010-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 "value.h"
26 #include "valprint.h"
27 #include "language.h"
28 #include "guile-internal.h"
29 
30 /* The <gdb:lazy-string> smob. */
31 
32 typedef struct
33 {
34  /* This always appears first. */
36 
37  /* Holds the address of the lazy string. */
39 
40  /* Holds the encoding that will be applied to the string when the string
41  is printed by GDB. If the encoding is set to NULL then GDB will select
42  the most appropriate encoding when the sting is printed.
43  Space for this is malloc'd and will be freed when the object is
44  freed. */
45  char *encoding;
46 
47  /* Holds the length of the string in characters. If the length is -1,
48  then the string will be fetched and encoded up to the first null of
49  appropriate width. */
50  int length;
51 
52  /* This attribute holds the type that is represented by the lazy
53  string's type. */
54  struct type *type;
56 
57 static const char lazy_string_smob_name[] = "gdb:lazy-string";
58 
59 /* The tag Guile knows the lazy string smob by. */
60 static scm_t_bits lazy_string_smob_tag;
61 
62 /* Administrivia for lazy string smobs. */
63 
64 /* The smob "free" function for <gdb:lazy-string>. */
65 
66 static size_t
68 {
69  lazy_string_smob *v_smob = (lazy_string_smob *) SCM_SMOB_DATA (self);
70 
71  xfree (v_smob->encoding);
72 
73  return 0;
74 }
75 
76 /* The smob "print" function for <gdb:lazy-string>. */
77 
78 static int
79 lsscm_print_lazy_string_smob (SCM self, SCM port, scm_print_state *pstate)
80 {
81  lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (self);
82 
83  gdbscm_printf (port, "#<%s", lazy_string_smob_name);
84  gdbscm_printf (port, " @%s", hex_string (ls_smob->address));
85  if (ls_smob->length >= 0)
86  gdbscm_printf (port, " length %d", ls_smob->length);
87  if (ls_smob->encoding != NULL)
88  gdbscm_printf (port, " encoding %s", ls_smob->encoding);
89  scm_puts (">", port);
90 
91  scm_remember_upto_here_1 (self);
92 
93  /* Non-zero means success. */
94  return 1;
95 }
96 
97 /* Low level routine to create a <gdb:lazy-string> object.
98  The caller must verify !(address == 0 && length != 0). */
99 
100 static SCM
102  const char *encoding, struct type *type)
103 {
104  lazy_string_smob *ls_smob = (lazy_string_smob *)
105  scm_gc_malloc (sizeof (lazy_string_smob), lazy_string_smob_name);
106  SCM ls_scm;
107 
108  /* Caller must verify this. */
109  gdb_assert (!(address == 0 && length != 0));
110  gdb_assert (type != NULL);
111 
112  ls_smob->address = address;
113  /* Coerce all values < 0 to -1. */
114  ls_smob->length = length < 0 ? -1 : length;
115  if (encoding == NULL || strcmp (encoding, "") == 0)
116  ls_smob->encoding = NULL;
117  else
118  ls_smob->encoding = xstrdup (encoding);
119  ls_smob->type = type;
120 
121  ls_scm = scm_new_smob (lazy_string_smob_tag, (scm_t_bits) ls_smob);
122  gdbscm_init_gsmob (&ls_smob->base);
123 
124  return ls_scm;
125 }
126 
127 /* Return non-zero if SCM is a <gdb:lazy-string> object. */
128 
129 int
131 {
132  return SCM_SMOB_PREDICATE (lazy_string_smob_tag, scm);
133 }
134 
135 /* (lazy-string? object) -> boolean */
136 
137 static SCM
139 {
140  return scm_from_bool (lsscm_is_lazy_string (scm));
141 }
142 
143 /* Main entry point to create a <gdb:lazy-string> object.
144  If there's an error a <gdb:exception> object is returned. */
145 
146 SCM
148  const char *encoding, struct type *type)
149 {
150  if (address == 0 && length != 0)
151  {
153  (NULL, 0, scm_from_int (length),
154  _("cannot create a lazy string with address 0x0"
155  " and a non-zero length"));
156  }
157 
158  if (type == NULL)
159  {
161  (NULL, 0, scm_from_int (0), _("a lazy string's type cannot be NULL"));
162  }
163 
164  return lsscm_make_lazy_string_smob (address, length, encoding, type);
165 }
166 
167 /* Returns the <gdb:lazy-string> smob in SELF.
168  Throws an exception if SELF is not a <gdb:lazy-string> object. */
169 
170 static SCM
171 lsscm_get_lazy_string_arg_unsafe (SCM self, int arg_pos, const char *func_name)
172 {
173  SCM_ASSERT_TYPE (lsscm_is_lazy_string (self), self, arg_pos, func_name,
175 
176  return self;
177 }
178 
179 /* Lazy string methods. */
180 
181 /* (lazy-string-address <gdb:lazy-string>) -> address */
182 
183 static SCM
185 {
186  SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
187  lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
188 
189  return gdbscm_scm_from_ulongest (ls_smob->address);
190 }
191 
192 /* (lazy-string-length <gdb:lazy-string>) -> integer */
193 
194 static SCM
196 {
197  SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
198  lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
199 
200  return scm_from_int (ls_smob->length);
201 }
202 
203 /* (lazy-string-encoding <gdb:lazy-string>) -> string */
204 
205 static SCM
207 {
208  SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
209  lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
210 
211  /* An encoding can be set to NULL by the user, so check first.
212  If NULL return #f. */
213  if (ls_smob != NULL)
214  return gdbscm_scm_from_c_string (ls_smob->encoding);
215  return SCM_BOOL_F;
216 }
217 
218 /* (lazy-string-type <gdb:lazy-string>) -> <gdb:type> */
219 
220 static SCM
222 {
223  SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
224  lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
225 
226  return tyscm_scm_from_type (ls_smob->type);
227 }
228 
229 /* (lazy-string->value <gdb:lazy-string>) -> <gdb:value> */
230 
231 static SCM
233 {
234  SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
235  lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
236  struct value *value = NULL;
237 
238  if (ls_smob->address == 0)
239  {
241  _("cannot create a value from NULL")));
242  }
243 
244  TRY
245  {
246  value = value_at_lazy (ls_smob->type, ls_smob->address);
247  }
248  CATCH (except, RETURN_MASK_ALL)
249  {
251  }
252  END_CATCH
253 
254  return vlscm_scm_from_value (value);
255 }
256 
257 /* A "safe" version of gdbscm_lazy_string_to_value for use by
258  vlscm_convert_typed_value_from_scheme.
259  The result, upon success, is the value of <gdb:lazy-string> STRING.
260  ARG_POS is the argument position of STRING in the original Scheme
261  function call, used in exception text.
262  If there's an error, NULL is returned and a <gdb:exception> object
263  is stored in *except_scmp.
264 
265  Note: The result is still "lazy". The caller must call value_fetch_lazy
266  to actually fetch the value. */
267 
268 struct value *
269 lsscm_safe_lazy_string_to_value (SCM string, int arg_pos,
270  const char *func_name, SCM *except_scmp)
271 {
272  lazy_string_smob *ls_smob;
273  struct value *value = NULL;
274 
275  gdb_assert (lsscm_is_lazy_string (string));
276 
277  ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (string);
278  *except_scmp = SCM_BOOL_F;
279 
280  if (ls_smob->address == 0)
281  {
282  *except_scmp
283  = gdbscm_make_out_of_range_error (FUNC_NAME, SCM_ARG1, string,
284  _("cannot create a value from NULL"));
285  return NULL;
286  }
287 
288  TRY
289  {
290  value = value_at_lazy (ls_smob->type, ls_smob->address);
291  }
292  CATCH (except, RETURN_MASK_ALL)
293  {
294  *except_scmp = gdbscm_scm_from_gdb_exception (except);
295  return NULL;
296  }
297  END_CATCH
298 
299  return value;
300 }
301 
302 /* Print a lazy string to STREAM using val_print_string.
303  STRING must be a <gdb:lazy-string> object. */
304 
305 void
306 lsscm_val_print_lazy_string (SCM string, struct ui_file *stream,
307  const struct value_print_options *options)
308 {
309  lazy_string_smob *ls_smob;
310 
311  gdb_assert (lsscm_is_lazy_string (string));
312 
313  ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (string);
314 
315  val_print_string (ls_smob->type, ls_smob->encoding,
316  ls_smob->address, ls_smob->length,
317  stream, options);
318 }
319 
320 /* Initialize the Scheme lazy-strings code. */
321 
322 static const scheme_function lazy_string_functions[] =
323 {
324  { "lazy-string?", 1, 0, 0, gdbscm_lazy_string_p,
325  "\
326 Return #t if the object is a <gdb:lazy-string> object." },
327 
328  { "lazy-string-address", 1, 0, 0, gdbscm_lazy_string_address,
329  "\
330 Return the address of the lazy-string." },
331 
332  { "lazy-string-length", 1, 0, 0, gdbscm_lazy_string_length,
333  "\
334 Return the length of the lazy-string.\n\
335 If the length is -1 then the length is determined by the first null\n\
336 of appropriate width." },
337 
338  { "lazy-string-encoding", 1, 0, 0, gdbscm_lazy_string_encoding,
339  "\
340 Return the encoding of the lazy-string." },
341 
342  { "lazy-string-type", 1, 0, 0, gdbscm_lazy_string_type,
343  "\
344 Return the <gdb:type> of the lazy-string." },
345 
346  { "lazy-string->value", 1, 0, 0, gdbscm_lazy_string_to_value,
347  "\
348 Return the <gdb:value> representation of the lazy-string." },
349 
351 };
352 
353 void
355 {
357  sizeof (lazy_string_smob));
360 
361  gdbscm_define_functions (lazy_string_functions, 1);
362 }
static const char lazy_string_smob_name[]
static SCM gdbscm_lazy_string_length(SCM self)
static SCM scm_new_smob(scm_t_bits tc, scm_t_bits data)
void gdbscm_define_functions(const scheme_function *, int is_public)
Definition: scm-utils.c:44
bfd_vma CORE_ADDR
Definition: common-types.h:41
SCM gdbscm_scm_from_ulongest(ULONGEST l)
Definition: scm-utils.c:552
void xfree(void *)
Definition: common-utils.c:97
SCM tyscm_scm_from_type(struct type *type)
Definition: scm-type.c:303
static SCM gdbscm_lazy_string_address(SCM self)
#define FUNC_NAME
static SCM lsscm_get_lazy_string_arg_unsafe(SCM self, int arg_pos, const char *func_name)
SCM gdbscm_make_out_of_range_error(const char *subr, int arg_pos, SCM bad_value, const char *error)
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
#define END_CATCH
SCM vlscm_scm_from_value(struct value *value)
Definition: scm-value.c:258
#define TRY
static size_t lsscm_free_lazy_string_smob(SCM self)
void gdbscm_init_gsmob(gdb_smob *base)
Definition: scm-gsmob.c:113
#define CATCH(EXCEPTION, MASK)
static struct parser_state * pstate
Definition: ada-exp.c:149
SCM lsscm_make_lazy_string(CORE_ADDR address, int length, const char *encoding, struct type *type)
SCM gdbscm_scm_from_c_string(const char *string)
Definition: scm-string.c:44
SCM gdbscm_scm_from_gdb_exception(struct gdb_exception exception)
void lsscm_val_print_lazy_string(SCM string, struct ui_file *stream, const struct value_print_options *options)
void gdbscm_initialize_lazy_strings(void)
Definition: gdbtypes.h:749
static SCM lsscm_make_lazy_string_smob(CORE_ADDR address, int length, const char *encoding, struct type *type)
void gdbscm_throw(SCM exception) ATTRIBUTE_NORETURN
static const char * type
Definition: language.c:103
#define gdb_assert(expr)
Definition: gdb_assert.h:33
struct value * lsscm_safe_lazy_string_to_value(SCM string, int arg_pos, const char *func_name, SCM *except_scmp)
struct value * value_at_lazy(struct type *type, CORE_ADDR addr)
Definition: valops.c:951
static SCM gdbscm_lazy_string_encoding(SCM self)
static char encoding[]
Definition: remote-mips.c:2988
void gdbscm_printf(SCM port, const char *format,...) ATTRIBUTE_PRINTF(2
static SCM gdbscm_lazy_string_to_value(SCM self)
Definition: value.c:172
static SCM gdbscm_lazy_string_type(SCM self)
unsigned length
Definition: gdbtypes.h:807
#define END_FUNCTIONS
struct type * type
#define GDBSCM_HANDLE_GDB_EXCEPTION(exception)
static scm_t_bits lazy_string_smob_tag
int val_print_string(struct type *elttype, const char *encoding, CORE_ADDR addr, int len, struct ui_file *stream, const struct value_print_options *options)
Definition: valprint.c:2496
int lsscm_is_lazy_string(SCM scm)
static SCM gdbscm_lazy_string_p(SCM scm)
static int lsscm_print_lazy_string_smob(SCM self, SCM port, scm_print_state *pstate)