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