Fix various python lazy string bugs.
[deliverable/binutils-gdb.git] / gdb / guile / scm-lazy-string.c
CommitLineData
ed3ef339
DE
1/* Scheme interface to lazy strings.
2
61baf725 3 Copyright (C) 2010-2017 Free Software Foundation, Inc.
ed3ef339
DE
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"
ed3ef339
DE
26#include "valprint.h"
27#include "language.h"
ed3ef339
DE
28#include "guile-internal.h"
29
30/* The <gdb:lazy-string> smob. */
31
32typedef struct
33{
34 /* This always appears first. */
35 gdb_smob base;
36
37 /* Holds the address of the lazy string. */
38 CORE_ADDR address;
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;
55} lazy_string_smob;
56
57static const char lazy_string_smob_name[] = "gdb:lazy-string";
58
59/* The tag Guile knows the lazy string smob by. */
60static scm_t_bits lazy_string_smob_tag;
61\f
62/* Administrivia for lazy string smobs. */
63
ed3ef339
DE
64/* The smob "free" function for <gdb:lazy-string>. */
65
66static size_t
67lsscm_free_lazy_string_smob (SCM self)
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
78static int
79lsscm_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
100static SCM
101lsscm_make_lazy_string_smob (CORE_ADDR address, int length,
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
129int
130lsscm_is_lazy_string (SCM scm)
131{
132 return SCM_SMOB_PREDICATE (lazy_string_smob_tag, scm);
133}
134
135/* (lazy-string? object) -> boolean */
136
137static SCM
138gdbscm_lazy_string_p (SCM 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
146SCM
147lsscm_make_lazy_string (CORE_ADDR address, int length,
148 const char *encoding, struct type *type)
149{
150 if (address == 0 && length != 0)
151 {
152 return gdbscm_make_out_of_range_error
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 {
160 return gdbscm_make_out_of_range_error
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
170static SCM
171lsscm_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,
174 lazy_string_smob_name);
175
176 return self;
177}
178\f
179/* Lazy string methods. */
180
181/* (lazy-string-address <gdb:lazy-string>) -> address */
182
183static SCM
184gdbscm_lazy_string_address (SCM self)
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
194static SCM
195gdbscm_lazy_string_length (SCM self)
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
205static SCM
206gdbscm_lazy_string_encoding (SCM self)
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
220static SCM
221gdbscm_lazy_string_type (SCM self)
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
231static SCM
232gdbscm_lazy_string_to_value (SCM self)
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;
ed3ef339
DE
237
238 if (ls_smob->address == 0)
239 {
240 gdbscm_throw (gdbscm_make_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
241 _("cannot create a value from NULL")));
242 }
243
492d29ea 244 TRY
ed3ef339
DE
245 {
246 value = value_at_lazy (ls_smob->type, ls_smob->address);
247 }
492d29ea
PA
248 CATCH (except, RETURN_MASK_ALL)
249 {
250 GDBSCM_HANDLE_GDB_EXCEPTION (except);
251 }
252 END_CATCH
ed3ef339
DE
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
268struct value *
269lsscm_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;
ed3ef339
DE
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
492d29ea 288 TRY
ed3ef339
DE
289 {
290 value = value_at_lazy (ls_smob->type, ls_smob->address);
291 }
492d29ea 292 CATCH (except, RETURN_MASK_ALL)
ed3ef339
DE
293 {
294 *except_scmp = gdbscm_scm_from_gdb_exception (except);
295 return NULL;
296 }
492d29ea 297 END_CATCH
ed3ef339
DE
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
305void
306lsscm_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\f
320/* Initialize the Scheme lazy-strings code. */
321
322static const scheme_function lazy_string_functions[] =
323{
72e02483 324 { "lazy-string?", 1, 0, 0, as_a_scm_t_subr (gdbscm_lazy_string_p),
ed3ef339
DE
325 "\
326Return #t if the object is a <gdb:lazy-string> object." },
327
72e02483
PA
328 { "lazy-string-address", 1, 0, 0,
329 as_a_scm_t_subr (gdbscm_lazy_string_address),
ed3ef339
DE
330 "\
331Return the address of the lazy-string." },
332
72e02483 333 { "lazy-string-length", 1, 0, 0, as_a_scm_t_subr (gdbscm_lazy_string_length),
ed3ef339
DE
334 "\
335Return the length of the lazy-string.\n\
336If the length is -1 then the length is determined by the first null\n\
337of appropriate width." },
338
72e02483
PA
339 { "lazy-string-encoding", 1, 0, 0,
340 as_a_scm_t_subr (gdbscm_lazy_string_encoding),
ed3ef339
DE
341 "\
342Return the encoding of the lazy-string." },
343
72e02483 344 { "lazy-string-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_lazy_string_type),
ed3ef339
DE
345 "\
346Return the <gdb:type> of the lazy-string." },
347
72e02483
PA
348 { "lazy-string->value", 1, 0, 0,
349 as_a_scm_t_subr (gdbscm_lazy_string_to_value),
ed3ef339
DE
350 "\
351Return the <gdb:value> representation of the lazy-string." },
352
353 END_FUNCTIONS
354};
355
356void
357gdbscm_initialize_lazy_strings (void)
358{
359 lazy_string_smob_tag = gdbscm_make_smob_type (lazy_string_smob_name,
360 sizeof (lazy_string_smob));
ed3ef339
DE
361 scm_set_smob_free (lazy_string_smob_tag, lsscm_free_lazy_string_smob);
362 scm_set_smob_print (lazy_string_smob_tag, lsscm_print_lazy_string_smob);
363
364 gdbscm_define_functions (lazy_string_functions, 1);
365}
This page took 0.447379 seconds and 4 git commands to generate.