1 /* Scheme interface to lazy strings. 2 3 Copyright (C) 2010-2015 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 "valprint.h" 27 #include "language.h" 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 62 /* Administrivia for lazy string smobs. */ 63 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 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 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)); 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 } 360