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