Commit | Line | Data |
---|---|---|
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 | ||
32 | typedef 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 | ||
a7c0469f DE |
47 | /* If TYPE is an array: If the length is known, then this value is the |
48 | array's length, otherwise it is -1. | |
49 | If TYPE is not an array: Then this value represents the string's length. | |
50 | In either case, if the value is -1 then the string will be fetched and | |
51 | encoded up to the first null of appropriate width. */ | |
ed3ef339 DE |
52 | int length; |
53 | ||
a7c0469f DE |
54 | /* The type of the string. |
55 | For example if the lazy string was created from a C "char*" then TYPE | |
56 | represents a C "char*". To get the type of the character in the string | |
57 | call lsscm_elt_type which handles the different kinds of values for TYPE. | |
58 | This is recorded as an SCM object so that we take advantage of support for | |
59 | preserving the type should its owning objfile go away. */ | |
60 | SCM type; | |
ed3ef339 DE |
61 | } lazy_string_smob; |
62 | ||
63 | static const char lazy_string_smob_name[] = "gdb:lazy-string"; | |
64 | ||
65 | /* The tag Guile knows the lazy string smob by. */ | |
66 | static scm_t_bits lazy_string_smob_tag; | |
67 | \f | |
68 | /* Administrivia for lazy string smobs. */ | |
69 | ||
ed3ef339 DE |
70 | /* The smob "free" function for <gdb:lazy-string>. */ |
71 | ||
72 | static size_t | |
73 | lsscm_free_lazy_string_smob (SCM self) | |
74 | { | |
75 | lazy_string_smob *v_smob = (lazy_string_smob *) SCM_SMOB_DATA (self); | |
76 | ||
77 | xfree (v_smob->encoding); | |
78 | ||
79 | return 0; | |
80 | } | |
81 | ||
82 | /* The smob "print" function for <gdb:lazy-string>. */ | |
83 | ||
84 | static int | |
85 | lsscm_print_lazy_string_smob (SCM self, SCM port, scm_print_state *pstate) | |
86 | { | |
87 | lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (self); | |
88 | ||
89 | gdbscm_printf (port, "#<%s", lazy_string_smob_name); | |
90 | gdbscm_printf (port, " @%s", hex_string (ls_smob->address)); | |
91 | if (ls_smob->length >= 0) | |
92 | gdbscm_printf (port, " length %d", ls_smob->length); | |
93 | if (ls_smob->encoding != NULL) | |
94 | gdbscm_printf (port, " encoding %s", ls_smob->encoding); | |
95 | scm_puts (">", port); | |
96 | ||
97 | scm_remember_upto_here_1 (self); | |
98 | ||
99 | /* Non-zero means success. */ | |
100 | return 1; | |
101 | } | |
102 | ||
103 | /* Low level routine to create a <gdb:lazy-string> object. | |
a7c0469f DE |
104 | The caller must verify: |
105 | - length >= -1 | |
106 | - !(address == 0 && length != 0) | |
107 | - type != NULL */ | |
ed3ef339 DE |
108 | |
109 | static SCM | |
110 | lsscm_make_lazy_string_smob (CORE_ADDR address, int length, | |
111 | const char *encoding, struct type *type) | |
112 | { | |
113 | lazy_string_smob *ls_smob = (lazy_string_smob *) | |
114 | scm_gc_malloc (sizeof (lazy_string_smob), lazy_string_smob_name); | |
115 | SCM ls_scm; | |
116 | ||
a7c0469f | 117 | gdb_assert (length >= -1); |
ed3ef339 DE |
118 | gdb_assert (!(address == 0 && length != 0)); |
119 | gdb_assert (type != NULL); | |
120 | ||
121 | ls_smob->address = address; | |
a7c0469f | 122 | ls_smob->length = length; |
ed3ef339 DE |
123 | if (encoding == NULL || strcmp (encoding, "") == 0) |
124 | ls_smob->encoding = NULL; | |
125 | else | |
126 | ls_smob->encoding = xstrdup (encoding); | |
a7c0469f | 127 | ls_smob->type = tyscm_scm_from_type (type); |
ed3ef339 DE |
128 | |
129 | ls_scm = scm_new_smob (lazy_string_smob_tag, (scm_t_bits) ls_smob); | |
130 | gdbscm_init_gsmob (&ls_smob->base); | |
131 | ||
132 | return ls_scm; | |
133 | } | |
134 | ||
135 | /* Return non-zero if SCM is a <gdb:lazy-string> object. */ | |
136 | ||
137 | int | |
138 | lsscm_is_lazy_string (SCM scm) | |
139 | { | |
140 | return SCM_SMOB_PREDICATE (lazy_string_smob_tag, scm); | |
141 | } | |
142 | ||
143 | /* (lazy-string? object) -> boolean */ | |
144 | ||
145 | static SCM | |
146 | gdbscm_lazy_string_p (SCM scm) | |
147 | { | |
148 | return scm_from_bool (lsscm_is_lazy_string (scm)); | |
149 | } | |
150 | ||
151 | /* Main entry point to create a <gdb:lazy-string> object. | |
152 | If there's an error a <gdb:exception> object is returned. */ | |
153 | ||
154 | SCM | |
155 | lsscm_make_lazy_string (CORE_ADDR address, int length, | |
156 | const char *encoding, struct type *type) | |
157 | { | |
a7c0469f DE |
158 | if (length < -1) |
159 | { | |
160 | return gdbscm_make_out_of_range_error (NULL, 0, | |
161 | scm_from_int (length), | |
162 | _("invalid length")); | |
163 | } | |
164 | ||
ed3ef339 DE |
165 | if (address == 0 && length != 0) |
166 | { | |
167 | return gdbscm_make_out_of_range_error | |
168 | (NULL, 0, scm_from_int (length), | |
a7c0469f | 169 | _("cannot create a lazy string with address 0x0," |
ed3ef339 DE |
170 | " and a non-zero length")); |
171 | } | |
172 | ||
173 | if (type == NULL) | |
174 | { | |
175 | return gdbscm_make_out_of_range_error | |
176 | (NULL, 0, scm_from_int (0), _("a lazy string's type cannot be NULL")); | |
177 | } | |
178 | ||
179 | return lsscm_make_lazy_string_smob (address, length, encoding, type); | |
180 | } | |
181 | ||
182 | /* Returns the <gdb:lazy-string> smob in SELF. | |
183 | Throws an exception if SELF is not a <gdb:lazy-string> object. */ | |
184 | ||
185 | static SCM | |
186 | lsscm_get_lazy_string_arg_unsafe (SCM self, int arg_pos, const char *func_name) | |
187 | { | |
188 | SCM_ASSERT_TYPE (lsscm_is_lazy_string (self), self, arg_pos, func_name, | |
189 | lazy_string_smob_name); | |
190 | ||
191 | return self; | |
192 | } | |
a7c0469f DE |
193 | |
194 | /* Return the type of a character in lazy string LS_SMOB. */ | |
195 | ||
196 | static struct type * | |
197 | lsscm_elt_type (lazy_string_smob *ls_smob) | |
198 | { | |
199 | struct type *type = tyscm_scm_to_type (ls_smob->type); | |
200 | struct type *realtype; | |
201 | ||
202 | realtype = check_typedef (type); | |
203 | ||
204 | switch (TYPE_CODE (realtype)) | |
205 | { | |
206 | case TYPE_CODE_PTR: | |
207 | case TYPE_CODE_ARRAY: | |
208 | return TYPE_TARGET_TYPE (realtype); | |
209 | default: | |
210 | /* This is done to preserve existing behaviour. PR 20769. | |
211 | E.g., gdb.parse_and_eval("my_int_variable").lazy_string().type. */ | |
212 | return realtype; | |
213 | } | |
214 | } | |
ed3ef339 DE |
215 | \f |
216 | /* Lazy string methods. */ | |
217 | ||
218 | /* (lazy-string-address <gdb:lazy-string>) -> address */ | |
219 | ||
220 | static SCM | |
221 | gdbscm_lazy_string_address (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 gdbscm_scm_from_ulongest (ls_smob->address); | |
227 | } | |
228 | ||
229 | /* (lazy-string-length <gdb:lazy-string>) -> integer */ | |
230 | ||
231 | static SCM | |
232 | gdbscm_lazy_string_length (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 | ||
237 | return scm_from_int (ls_smob->length); | |
238 | } | |
239 | ||
240 | /* (lazy-string-encoding <gdb:lazy-string>) -> string */ | |
241 | ||
242 | static SCM | |
243 | gdbscm_lazy_string_encoding (SCM self) | |
244 | { | |
245 | SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
246 | lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm); | |
247 | ||
248 | /* An encoding can be set to NULL by the user, so check first. | |
249 | If NULL return #f. */ | |
250 | if (ls_smob != NULL) | |
251 | return gdbscm_scm_from_c_string (ls_smob->encoding); | |
252 | return SCM_BOOL_F; | |
253 | } | |
254 | ||
255 | /* (lazy-string-type <gdb:lazy-string>) -> <gdb:type> */ | |
256 | ||
257 | static SCM | |
258 | gdbscm_lazy_string_type (SCM self) | |
259 | { | |
260 | SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
261 | lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm); | |
262 | ||
a7c0469f | 263 | return ls_smob->type; |
ed3ef339 DE |
264 | } |
265 | ||
266 | /* (lazy-string->value <gdb:lazy-string>) -> <gdb:value> */ | |
267 | ||
268 | static SCM | |
269 | gdbscm_lazy_string_to_value (SCM self) | |
270 | { | |
271 | SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME); | |
a7c0469f DE |
272 | SCM except_scm; |
273 | struct value *value; | |
ed3ef339 | 274 | |
a7c0469f DE |
275 | value = lsscm_safe_lazy_string_to_value (ls_scm, SCM_ARG1, FUNC_NAME, |
276 | &except_scm); | |
277 | if (value == NULL) | |
278 | gdbscm_throw (except_scm); | |
ed3ef339 DE |
279 | return vlscm_scm_from_value (value); |
280 | } | |
281 | ||
282 | /* A "safe" version of gdbscm_lazy_string_to_value for use by | |
283 | vlscm_convert_typed_value_from_scheme. | |
284 | The result, upon success, is the value of <gdb:lazy-string> STRING. | |
285 | ARG_POS is the argument position of STRING in the original Scheme | |
286 | function call, used in exception text. | |
287 | If there's an error, NULL is returned and a <gdb:exception> object | |
288 | is stored in *except_scmp. | |
289 | ||
290 | Note: The result is still "lazy". The caller must call value_fetch_lazy | |
291 | to actually fetch the value. */ | |
292 | ||
293 | struct value * | |
294 | lsscm_safe_lazy_string_to_value (SCM string, int arg_pos, | |
295 | const char *func_name, SCM *except_scmp) | |
296 | { | |
297 | lazy_string_smob *ls_smob; | |
298 | struct value *value = NULL; | |
ed3ef339 DE |
299 | |
300 | gdb_assert (lsscm_is_lazy_string (string)); | |
301 | ||
302 | ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (string); | |
ed3ef339 DE |
303 | |
304 | if (ls_smob->address == 0) | |
305 | { | |
306 | *except_scmp | |
a7c0469f | 307 | = gdbscm_make_out_of_range_error (func_name, arg_pos, string, |
ed3ef339 DE |
308 | _("cannot create a value from NULL")); |
309 | return NULL; | |
310 | } | |
311 | ||
492d29ea | 312 | TRY |
ed3ef339 | 313 | { |
a7c0469f DE |
314 | struct type *type = tyscm_scm_to_type (ls_smob->type); |
315 | struct type *realtype = check_typedef (type); | |
316 | ||
317 | switch (TYPE_CODE (realtype)) | |
318 | { | |
319 | case TYPE_CODE_PTR: | |
320 | /* If a length is specified we need to convert this to an array | |
321 | of the specified size. */ | |
322 | if (ls_smob->length != -1) | |
323 | { | |
324 | /* PR 20786: There's no way to specify an array of length zero. | |
325 | Record a length of [0,-1] which is how Ada does it. Anything | |
326 | we do is broken, but this one possible solution. */ | |
327 | type = lookup_array_range_type (TYPE_TARGET_TYPE (realtype), | |
328 | 0, ls_smob->length - 1); | |
329 | value = value_at_lazy (type, ls_smob->address); | |
330 | } | |
331 | else | |
332 | value = value_from_pointer (type, ls_smob->address); | |
333 | break; | |
334 | default: | |
335 | value = value_at_lazy (type, ls_smob->address); | |
336 | break; | |
337 | } | |
ed3ef339 | 338 | } |
492d29ea | 339 | CATCH (except, RETURN_MASK_ALL) |
ed3ef339 DE |
340 | { |
341 | *except_scmp = gdbscm_scm_from_gdb_exception (except); | |
342 | return NULL; | |
343 | } | |
492d29ea | 344 | END_CATCH |
ed3ef339 DE |
345 | |
346 | return value; | |
347 | } | |
348 | ||
349 | /* Print a lazy string to STREAM using val_print_string. | |
350 | STRING must be a <gdb:lazy-string> object. */ | |
351 | ||
352 | void | |
353 | lsscm_val_print_lazy_string (SCM string, struct ui_file *stream, | |
354 | const struct value_print_options *options) | |
355 | { | |
356 | lazy_string_smob *ls_smob; | |
a7c0469f | 357 | struct type *elt_type; |
ed3ef339 DE |
358 | |
359 | gdb_assert (lsscm_is_lazy_string (string)); | |
360 | ||
361 | ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (string); | |
a7c0469f | 362 | elt_type = lsscm_elt_type (ls_smob); |
ed3ef339 | 363 | |
a7c0469f | 364 | val_print_string (elt_type, ls_smob->encoding, |
ed3ef339 DE |
365 | ls_smob->address, ls_smob->length, |
366 | stream, options); | |
367 | } | |
368 | \f | |
369 | /* Initialize the Scheme lazy-strings code. */ | |
370 | ||
371 | static const scheme_function lazy_string_functions[] = | |
372 | { | |
72e02483 | 373 | { "lazy-string?", 1, 0, 0, as_a_scm_t_subr (gdbscm_lazy_string_p), |
ed3ef339 DE |
374 | "\ |
375 | Return #t if the object is a <gdb:lazy-string> object." }, | |
376 | ||
72e02483 PA |
377 | { "lazy-string-address", 1, 0, 0, |
378 | as_a_scm_t_subr (gdbscm_lazy_string_address), | |
ed3ef339 DE |
379 | "\ |
380 | Return the address of the lazy-string." }, | |
381 | ||
72e02483 | 382 | { "lazy-string-length", 1, 0, 0, as_a_scm_t_subr (gdbscm_lazy_string_length), |
ed3ef339 DE |
383 | "\ |
384 | Return the length of the lazy-string.\n\ | |
385 | If the length is -1 then the length is determined by the first null\n\ | |
386 | of appropriate width." }, | |
387 | ||
72e02483 PA |
388 | { "lazy-string-encoding", 1, 0, 0, |
389 | as_a_scm_t_subr (gdbscm_lazy_string_encoding), | |
ed3ef339 DE |
390 | "\ |
391 | Return the encoding of the lazy-string." }, | |
392 | ||
72e02483 | 393 | { "lazy-string-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_lazy_string_type), |
ed3ef339 DE |
394 | "\ |
395 | Return the <gdb:type> of the lazy-string." }, | |
396 | ||
72e02483 PA |
397 | { "lazy-string->value", 1, 0, 0, |
398 | as_a_scm_t_subr (gdbscm_lazy_string_to_value), | |
ed3ef339 DE |
399 | "\ |
400 | Return the <gdb:value> representation of the lazy-string." }, | |
401 | ||
402 | END_FUNCTIONS | |
403 | }; | |
404 | ||
405 | void | |
406 | gdbscm_initialize_lazy_strings (void) | |
407 | { | |
408 | lazy_string_smob_tag = gdbscm_make_smob_type (lazy_string_smob_name, | |
409 | sizeof (lazy_string_smob)); | |
ed3ef339 DE |
410 | scm_set_smob_free (lazy_string_smob_tag, lsscm_free_lazy_string_smob); |
411 | scm_set_smob_print (lazy_string_smob_tag, lsscm_print_lazy_string_smob); | |
412 | ||
413 | gdbscm_define_functions (lazy_string_functions, 1); | |
414 | } |