1 /* Scheme interface to lazy strings.
3 Copyright (C) 2010-2014 Free Software Foundation, Inc.
5 This file is part of GDB.
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.
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.
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/>. */
20 /* See README file in this directory for implementation notes, coding
21 conventions, et.al. */
26 #include "exceptions.h"
29 #include "gdb_assert.h"
30 #include "guile-internal.h"
32 /* The <gdb:lazy-string> smob. */
36 /* This always appears first. */
39 /* Holds the address of the lazy string. */
42 /* Holds the encoding that will be applied to the string when the string
43 is printed by GDB. If the encoding is set to NULL then GDB will select
44 the most appropriate encoding when the sting is printed.
45 Space for this is malloc'd and will be freed when the object is
49 /* Holds the length of the string in characters. If the length is -1,
50 then the string will be fetched and encoded up to the first null of
54 /* This attribute holds the type that is represented by the lazy
59 static const char lazy_string_smob_name
[] = "gdb:lazy-string";
61 /* The tag Guile knows the lazy string smob by. */
62 static scm_t_bits lazy_string_smob_tag
;
64 /* Administrivia for lazy string smobs. */
66 /* The smob "mark" function for <gdb:lazy-string>. */
69 lsscm_mark_lazy_string_smob (SCM self
)
71 lazy_string_smob
*ls_smob
= (lazy_string_smob
*) SCM_SMOB_DATA (self
);
74 return gdbscm_mark_gsmob (&ls_smob
->base
);
77 /* The smob "free" function for <gdb:lazy-string>. */
80 lsscm_free_lazy_string_smob (SCM self
)
82 lazy_string_smob
*v_smob
= (lazy_string_smob
*) SCM_SMOB_DATA (self
);
84 xfree (v_smob
->encoding
);
89 /* The smob "print" function for <gdb:lazy-string>. */
92 lsscm_print_lazy_string_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
94 lazy_string_smob
*ls_smob
= (lazy_string_smob
*) SCM_SMOB_DATA (self
);
96 gdbscm_printf (port
, "#<%s", lazy_string_smob_name
);
97 gdbscm_printf (port
, " @%s", hex_string (ls_smob
->address
));
98 if (ls_smob
->length
>= 0)
99 gdbscm_printf (port
, " length %d", ls_smob
->length
);
100 if (ls_smob
->encoding
!= NULL
)
101 gdbscm_printf (port
, " encoding %s", ls_smob
->encoding
);
102 scm_puts (">", port
);
104 scm_remember_upto_here_1 (self
);
106 /* Non-zero means success. */
110 /* Low level routine to create a <gdb:lazy-string> object.
111 The caller must verify !(address == 0 && length != 0). */
114 lsscm_make_lazy_string_smob (CORE_ADDR address
, int length
,
115 const char *encoding
, struct type
*type
)
117 lazy_string_smob
*ls_smob
= (lazy_string_smob
*)
118 scm_gc_malloc (sizeof (lazy_string_smob
), lazy_string_smob_name
);
121 /* Caller must verify this. */
122 gdb_assert (!(address
== 0 && length
!= 0));
123 gdb_assert (type
!= NULL
);
125 ls_smob
->address
= address
;
126 /* Coerce all values < 0 to -1. */
127 ls_smob
->length
= length
< 0 ? -1 : length
;
128 if (encoding
== NULL
|| strcmp (encoding
, "") == 0)
129 ls_smob
->encoding
= NULL
;
131 ls_smob
->encoding
= xstrdup (encoding
);
132 ls_smob
->type
= type
;
134 ls_scm
= scm_new_smob (lazy_string_smob_tag
, (scm_t_bits
) ls_smob
);
135 gdbscm_init_gsmob (&ls_smob
->base
);
140 /* Return non-zero if SCM is a <gdb:lazy-string> object. */
143 lsscm_is_lazy_string (SCM scm
)
145 return SCM_SMOB_PREDICATE (lazy_string_smob_tag
, scm
);
148 /* (lazy-string? object) -> boolean */
151 gdbscm_lazy_string_p (SCM scm
)
153 return scm_from_bool (lsscm_is_lazy_string (scm
));
156 /* Main entry point to create a <gdb:lazy-string> object.
157 If there's an error a <gdb:exception> object is returned. */
160 lsscm_make_lazy_string (CORE_ADDR address
, int length
,
161 const char *encoding
, struct type
*type
)
163 if (address
== 0 && length
!= 0)
165 return gdbscm_make_out_of_range_error
166 (NULL
, 0, scm_from_int (length
),
167 _("cannot create a lazy string with address 0x0"
168 " and a non-zero length"));
173 return gdbscm_make_out_of_range_error
174 (NULL
, 0, scm_from_int (0), _("a lazy string's type cannot be NULL"));
177 return lsscm_make_lazy_string_smob (address
, length
, encoding
, type
);
180 /* Returns the <gdb:lazy-string> smob in SELF.
181 Throws an exception if SELF is not a <gdb:lazy-string> object. */
184 lsscm_get_lazy_string_arg_unsafe (SCM self
, int arg_pos
, const char *func_name
)
186 SCM_ASSERT_TYPE (lsscm_is_lazy_string (self
), self
, arg_pos
, func_name
,
187 lazy_string_smob_name
);
192 /* Lazy string methods. */
194 /* (lazy-string-address <gdb:lazy-string>) -> address */
197 gdbscm_lazy_string_address (SCM self
)
199 SCM ls_scm
= lsscm_get_lazy_string_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
200 lazy_string_smob
*ls_smob
= (lazy_string_smob
*) SCM_SMOB_DATA (ls_scm
);
202 return gdbscm_scm_from_ulongest (ls_smob
->address
);
205 /* (lazy-string-length <gdb:lazy-string>) -> integer */
208 gdbscm_lazy_string_length (SCM self
)
210 SCM ls_scm
= lsscm_get_lazy_string_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
211 lazy_string_smob
*ls_smob
= (lazy_string_smob
*) SCM_SMOB_DATA (ls_scm
);
213 return scm_from_int (ls_smob
->length
);
216 /* (lazy-string-encoding <gdb:lazy-string>) -> string */
219 gdbscm_lazy_string_encoding (SCM self
)
221 SCM ls_scm
= lsscm_get_lazy_string_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
222 lazy_string_smob
*ls_smob
= (lazy_string_smob
*) SCM_SMOB_DATA (ls_scm
);
224 /* An encoding can be set to NULL by the user, so check first.
225 If NULL return #f. */
227 return gdbscm_scm_from_c_string (ls_smob
->encoding
);
231 /* (lazy-string-type <gdb:lazy-string>) -> <gdb:type> */
234 gdbscm_lazy_string_type (SCM self
)
236 SCM ls_scm
= lsscm_get_lazy_string_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
237 lazy_string_smob
*ls_smob
= (lazy_string_smob
*) SCM_SMOB_DATA (ls_scm
);
239 return tyscm_scm_from_type (ls_smob
->type
);
242 /* (lazy-string->value <gdb:lazy-string>) -> <gdb:value> */
245 gdbscm_lazy_string_to_value (SCM self
)
247 SCM ls_scm
= lsscm_get_lazy_string_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
248 lazy_string_smob
*ls_smob
= (lazy_string_smob
*) SCM_SMOB_DATA (ls_scm
);
249 struct value
*value
= NULL
;
250 volatile struct gdb_exception except
;
252 if (ls_smob
->address
== 0)
254 gdbscm_throw (gdbscm_make_out_of_range_error (FUNC_NAME
, SCM_ARG1
, self
,
255 _("cannot create a value from NULL")));
258 TRY_CATCH (except
, RETURN_MASK_ALL
)
260 value
= value_at_lazy (ls_smob
->type
, ls_smob
->address
);
262 GDBSCM_HANDLE_GDB_EXCEPTION (except
);
264 return vlscm_scm_from_value (value
);
267 /* A "safe" version of gdbscm_lazy_string_to_value for use by
268 vlscm_convert_typed_value_from_scheme.
269 The result, upon success, is the value of <gdb:lazy-string> STRING.
270 ARG_POS is the argument position of STRING in the original Scheme
271 function call, used in exception text.
272 If there's an error, NULL is returned and a <gdb:exception> object
273 is stored in *except_scmp.
275 Note: The result is still "lazy". The caller must call value_fetch_lazy
276 to actually fetch the value. */
279 lsscm_safe_lazy_string_to_value (SCM string
, int arg_pos
,
280 const char *func_name
, SCM
*except_scmp
)
282 lazy_string_smob
*ls_smob
;
283 struct value
*value
= NULL
;
284 volatile struct gdb_exception except
;
286 gdb_assert (lsscm_is_lazy_string (string
));
288 ls_smob
= (lazy_string_smob
*) SCM_SMOB_DATA (string
);
289 *except_scmp
= SCM_BOOL_F
;
291 if (ls_smob
->address
== 0)
294 = gdbscm_make_out_of_range_error (FUNC_NAME
, SCM_ARG1
, string
,
295 _("cannot create a value from NULL"));
299 TRY_CATCH (except
, RETURN_MASK_ALL
)
301 value
= value_at_lazy (ls_smob
->type
, ls_smob
->address
);
303 if (except
.reason
< 0)
305 *except_scmp
= gdbscm_scm_from_gdb_exception (except
);
312 /* Print a lazy string to STREAM using val_print_string.
313 STRING must be a <gdb:lazy-string> object. */
316 lsscm_val_print_lazy_string (SCM string
, struct ui_file
*stream
,
317 const struct value_print_options
*options
)
319 lazy_string_smob
*ls_smob
;
321 gdb_assert (lsscm_is_lazy_string (string
));
323 ls_smob
= (lazy_string_smob
*) SCM_SMOB_DATA (string
);
325 val_print_string (ls_smob
->type
, ls_smob
->encoding
,
326 ls_smob
->address
, ls_smob
->length
,
330 /* Initialize the Scheme lazy-strings code. */
332 static const scheme_function lazy_string_functions
[] =
334 { "lazy-string?", 1, 0, 0, gdbscm_lazy_string_p
,
336 Return #t if the object is a <gdb:lazy-string> object." },
338 { "lazy-string-address", 1, 0, 0, gdbscm_lazy_string_address
,
340 Return the address of the lazy-string." },
342 { "lazy-string-length", 1, 0, 0, gdbscm_lazy_string_length
,
344 Return the length of the lazy-string.\n\
345 If the length is -1 then the length is determined by the first null\n\
346 of appropriate width." },
348 { "lazy-string-encoding", 1, 0, 0, gdbscm_lazy_string_encoding
,
350 Return the encoding of the lazy-string." },
352 { "lazy-string-type", 1, 0, 0, gdbscm_lazy_string_type
,
354 Return the <gdb:type> of the lazy-string." },
356 { "lazy-string->value", 1, 0, 0, gdbscm_lazy_string_to_value
,
358 Return the <gdb:value> representation of the lazy-string." },
364 gdbscm_initialize_lazy_strings (void)
366 lazy_string_smob_tag
= gdbscm_make_smob_type (lazy_string_smob_name
,
367 sizeof (lazy_string_smob
));
368 scm_set_smob_mark (lazy_string_smob_tag
, lsscm_mark_lazy_string_smob
);
369 scm_set_smob_free (lazy_string_smob_tag
, lsscm_free_lazy_string_smob
);
370 scm_set_smob_print (lazy_string_smob_tag
, lsscm_print_lazy_string_smob
);
372 gdbscm_define_functions (lazy_string_functions
, 1);