1/* Scheme interface to lazy strings. 2 3 Copyright (C) 2010-2020 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 32typedef 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 /* 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. */ 52 int length; 53 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; 61} lazy_string_smob; 62 63static const char lazy_string_smob_name[] = "gdb:lazy-string"; 64 65/* The tag Guile knows the lazy string smob by. */ 66static scm_t_bits lazy_string_smob_tag; 67 68/* Administrivia for lazy string smobs. */ 69 70/* The smob "free" function for <gdb:lazy-string>. */ 71 72static size_t 73lsscm_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 84static int 85lsscm_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. 104 The caller must verify: 105 - length >= -1 106 - !(address == 0 && length != 0) 107 - type != NULL */ 108 109static SCM 110lsscm_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 117 gdb_assert (length >= -1); 118 gdb_assert (!(address == 0 && length != 0)); 119 gdb_assert (type != NULL); 120 121 ls_smob->address = address; 122 ls_smob->length = length; 123 if (encoding == NULL || strcmp (encoding, "") == 0) 124 ls_smob->encoding = NULL; 125 else 126 ls_smob->encoding = xstrdup (encoding); 127 ls_smob->type = tyscm_scm_from_type (type); 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 137int 138lsscm_is_lazy_string (SCM scm) 139{ 140 return SCM_SMOB_PREDICATE (lazy_string_smob_tag, scm); 141} 142 143/* (lazy-string? object) -> boolean */ 144 145static SCM 146gdbscm_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 154SCM 155lsscm_make_lazy_string (CORE_ADDR address, int length, 156 const char *encoding, struct type *type) 157{ 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 165 if (address == 0 && length != 0) 166 { 167 return gdbscm_make_out_of_range_error 168 (NULL, 0, scm_from_int (length), 169 _("cannot create a lazy string with address 0x0," 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 185static SCM 186lsscm_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} 193 194/* Return the type of a character in lazy string LS_SMOB. */ 195 196static struct type * 197lsscm_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 (realtype->code ()) 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} 215 216/* Lazy string methods. */ 217 218/* (lazy-string-address <gdb:lazy-string>) -> address */ 219 220static SCM 221gdbscm_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 231static SCM 232gdbscm_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 242static SCM 243gdbscm_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 257static SCM 258gdbscm_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 263 return ls_smob->type; 264} 265 266/* (lazy-string->value <gdb:lazy-string>) -> <gdb:value> */ 267 268static SCM 269gdbscm_lazy_string_to_value (SCM self) 270{ 271 SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME); 272 SCM except_scm; 273 struct value *value; 274 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); 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 293struct value * 294lsscm_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; 299 300 gdb_assert (lsscm_is_lazy_string (string)); 301 302 ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (string); 303 304 if (ls_smob->address == 0) 305 { 306 *except_scmp 307 = gdbscm_make_out_of_range_error (func_name, arg_pos, string, 308 _("cannot create a value from NULL")); 309 return NULL; 310 } 311 312 try 313 { 314 struct type *type = tyscm_scm_to_type (ls_smob->type); 315 struct type *realtype = check_typedef (type); 316 317 switch (realtype->code ()) 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 } 338 } 339 catch (const gdb_exception &except) 340 { 341 *except_scmp = gdbscm_scm_from_gdb_exception (unpack (except)); 342 return NULL; 343 } 344 345 return value; 346} 347 348/* Print a lazy string to STREAM using val_print_string. 349 STRING must be a <gdb:lazy-string> object. */ 350 351void 352lsscm_val_print_lazy_string (SCM string, struct ui_file *stream, 353 const struct value_print_options *options) 354{ 355 lazy_string_smob *ls_smob; 356 struct type *elt_type; 357 358 gdb_assert (lsscm_is_lazy_string (string)); 359 360 ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (string); 361 elt_type = lsscm_elt_type (ls_smob); 362 363 val_print_string (elt_type, ls_smob->encoding, 364 ls_smob->address, ls_smob->length, 365 stream, options); 366} 367 368/* Initialize the Scheme lazy-strings code. */ 369 370static const scheme_function lazy_string_functions[] = 371{ 372 { "lazy-string?", 1, 0, 0, as_a_scm_t_subr (gdbscm_lazy_string_p), 373 "\ 374Return #t if the object is a <gdb:lazy-string> object." }, 375 376 { "lazy-string-address", 1, 0, 0, 377 as_a_scm_t_subr (gdbscm_lazy_string_address), 378 "\ 379Return the address of the lazy-string." }, 380 381 { "lazy-string-length", 1, 0, 0, as_a_scm_t_subr (gdbscm_lazy_string_length), 382 "\ 383Return the length of the lazy-string.\n\ 384If the length is -1 then the length is determined by the first null\n\ 385of appropriate width." }, 386 387 { "lazy-string-encoding", 1, 0, 0, 388 as_a_scm_t_subr (gdbscm_lazy_string_encoding), 389 "\ 390Return the encoding of the lazy-string." }, 391 392 { "lazy-string-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_lazy_string_type), 393 "\ 394Return the <gdb:type> of the lazy-string." }, 395 396 { "lazy-string->value", 1, 0, 0, 397 as_a_scm_t_subr (gdbscm_lazy_string_to_value), 398 "\ 399Return the <gdb:value> representation of the lazy-string." }, 400 401 END_FUNCTIONS 402}; 403 404void 405gdbscm_initialize_lazy_strings (void) 406{ 407 lazy_string_smob_tag = gdbscm_make_smob_type (lazy_string_smob_name, 408 sizeof (lazy_string_smob)); 409 scm_set_smob_free (lazy_string_smob_tag, lsscm_free_lazy_string_smob); 410 scm_set_smob_print (lazy_string_smob_tag, lsscm_print_lazy_string_smob); 411 412 gdbscm_define_functions (lazy_string_functions, 1); 413} 414