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" | |
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 | ||
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 | ||
57 | static const char lazy_string_smob_name[] = "gdb:lazy-string"; | |
58 | ||
59 | /* The tag Guile knows the lazy string smob by. */ | |
60 | static 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 | ||
66 | static size_t | |
67 | lsscm_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 | ||
78 | static int | |
79 | lsscm_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 | ||
100 | static SCM | |
101 | lsscm_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 | ||
129 | int | |
130 | lsscm_is_lazy_string (SCM scm) | |
131 | { | |
132 | return SCM_SMOB_PREDICATE (lazy_string_smob_tag, scm); | |
133 | } | |
134 | ||
135 | /* (lazy-string? object) -> boolean */ | |
136 | ||
137 | static SCM | |
138 | gdbscm_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 | ||
146 | SCM | |
147 | lsscm_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 | ||
170 | static SCM | |
171 | lsscm_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 | ||
183 | static SCM | |
184 | gdbscm_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 | ||
194 | static SCM | |
195 | gdbscm_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 | ||
205 | static SCM | |
206 | gdbscm_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 | ||
220 | static SCM | |
221 | gdbscm_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 | ||
231 | static SCM | |
232 | gdbscm_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; | |
237 | volatile struct gdb_exception except; | |
238 | ||
239 | if (ls_smob->address == 0) | |
240 | { | |
241 | gdbscm_throw (gdbscm_make_out_of_range_error (FUNC_NAME, SCM_ARG1, self, | |
242 | _("cannot create a value from NULL"))); | |
243 | } | |
244 | ||
245 | TRY_CATCH (except, RETURN_MASK_ALL) | |
246 | { | |
247 | value = value_at_lazy (ls_smob->type, ls_smob->address); | |
248 | } | |
249 | GDBSCM_HANDLE_GDB_EXCEPTION (except); | |
250 | ||
251 | return vlscm_scm_from_value (value); | |
252 | } | |
253 | ||
254 | /* A "safe" version of gdbscm_lazy_string_to_value for use by | |
255 | vlscm_convert_typed_value_from_scheme. | |
256 | The result, upon success, is the value of <gdb:lazy-string> STRING. | |
257 | ARG_POS is the argument position of STRING in the original Scheme | |
258 | function call, used in exception text. | |
259 | If there's an error, NULL is returned and a <gdb:exception> object | |
260 | is stored in *except_scmp. | |
261 | ||
262 | Note: The result is still "lazy". The caller must call value_fetch_lazy | |
263 | to actually fetch the value. */ | |
264 | ||
265 | struct value * | |
266 | lsscm_safe_lazy_string_to_value (SCM string, int arg_pos, | |
267 | const char *func_name, SCM *except_scmp) | |
268 | { | |
269 | lazy_string_smob *ls_smob; | |
270 | struct value *value = NULL; | |
271 | volatile struct gdb_exception except; | |
272 | ||
273 | gdb_assert (lsscm_is_lazy_string (string)); | |
274 | ||
275 | ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (string); | |
276 | *except_scmp = SCM_BOOL_F; | |
277 | ||
278 | if (ls_smob->address == 0) | |
279 | { | |
280 | *except_scmp | |
281 | = gdbscm_make_out_of_range_error (FUNC_NAME, SCM_ARG1, string, | |
282 | _("cannot create a value from NULL")); | |
283 | return NULL; | |
284 | } | |
285 | ||
286 | TRY_CATCH (except, RETURN_MASK_ALL) | |
287 | { | |
288 | value = value_at_lazy (ls_smob->type, ls_smob->address); | |
289 | } | |
290 | if (except.reason < 0) | |
291 | { | |
292 | *except_scmp = gdbscm_scm_from_gdb_exception (except); | |
293 | return NULL; | |
294 | } | |
295 | ||
296 | return value; | |
297 | } | |
298 | ||
299 | /* Print a lazy string to STREAM using val_print_string. | |
300 | STRING must be a <gdb:lazy-string> object. */ | |
301 | ||
302 | void | |
303 | lsscm_val_print_lazy_string (SCM string, struct ui_file *stream, | |
304 | const struct value_print_options *options) | |
305 | { | |
306 | lazy_string_smob *ls_smob; | |
307 | ||
308 | gdb_assert (lsscm_is_lazy_string (string)); | |
309 | ||
310 | ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (string); | |
311 | ||
312 | val_print_string (ls_smob->type, ls_smob->encoding, | |
313 | ls_smob->address, ls_smob->length, | |
314 | stream, options); | |
315 | } | |
316 | \f | |
317 | /* Initialize the Scheme lazy-strings code. */ | |
318 | ||
319 | static const scheme_function lazy_string_functions[] = | |
320 | { | |
321 | { "lazy-string?", 1, 0, 0, gdbscm_lazy_string_p, | |
322 | "\ | |
323 | Return #t if the object is a <gdb:lazy-string> object." }, | |
324 | ||
325 | { "lazy-string-address", 1, 0, 0, gdbscm_lazy_string_address, | |
326 | "\ | |
327 | Return the address of the lazy-string." }, | |
328 | ||
329 | { "lazy-string-length", 1, 0, 0, gdbscm_lazy_string_length, | |
330 | "\ | |
331 | Return the length of the lazy-string.\n\ | |
332 | If the length is -1 then the length is determined by the first null\n\ | |
333 | of appropriate width." }, | |
334 | ||
335 | { "lazy-string-encoding", 1, 0, 0, gdbscm_lazy_string_encoding, | |
336 | "\ | |
337 | Return the encoding of the lazy-string." }, | |
338 | ||
339 | { "lazy-string-type", 1, 0, 0, gdbscm_lazy_string_type, | |
340 | "\ | |
341 | Return the <gdb:type> of the lazy-string." }, | |
342 | ||
343 | { "lazy-string->value", 1, 0, 0, gdbscm_lazy_string_to_value, | |
344 | "\ | |
345 | Return the <gdb:value> representation of the lazy-string." }, | |
346 | ||
347 | END_FUNCTIONS | |
348 | }; | |
349 | ||
350 | void | |
351 | gdbscm_initialize_lazy_strings (void) | |
352 | { | |
353 | lazy_string_smob_tag = gdbscm_make_smob_type (lazy_string_smob_name, | |
354 | sizeof (lazy_string_smob)); | |
ed3ef339 DE |
355 | scm_set_smob_free (lazy_string_smob_tag, lsscm_free_lazy_string_smob); |
356 | scm_set_smob_print (lazy_string_smob_tag, lsscm_print_lazy_string_smob); | |
357 | ||
358 | gdbscm_define_functions (lazy_string_functions, 1); | |
359 | } |