gdb/guile/scm-lazy-string.c

   1 /* Scheme interface to lazy strings.
   2
   3    Copyright (C) 2010-2019 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   /* 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
  63 static const char lazy_string_smob_name[] = "gdb:lazy-string";
  64
  65 /* The tag Guile knows the lazy string smob by.  */
  66 static scm_t_bits lazy_string_smob_tag;
  67 \f
  68 /* Administrivia for lazy string smobs.  */
  69
  70 /* The smob "free" function for <gdb:lazy-string>.  */
  71
  72 static size_t
  73 lsscm_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
  84 static int
  85 lsscm_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
 109 static SCM
 110 lsscm_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
 137 int
 138 lsscm_is_lazy_string (SCM scm)
 139 {
 140   return SCM_SMOB_PREDICATE (lazy_string_smob_tag, scm);
 141 }
 142
 143 /* (lazy-string? object) -> boolean */
 144
 145 static SCM
 146 gdbscm_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
 154 SCM
 155 lsscm_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
 185 static SCM
 186 lsscm_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
 196 static struct type *
 197 lsscm_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 (TYPE_CODE (realtype))
 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 \f
 216 /* Lazy string methods.  */
 217
 218 /* (lazy-string-address <gdb:lazy-string>) -> address */
 219
 220 static SCM
 221 gdbscm_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
 231 static SCM
 232 gdbscm_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
 242 static SCM
 243 gdbscm_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
 257 static SCM
 258 gdbscm_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
 268 static SCM
 269 gdbscm_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
 293 struct value *
 294 lsscm_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 (TYPE_CODE (realtype))
 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 (except, RETURN_MASK_ALL)
 340     {
 341       *except_scmp = gdbscm_scm_from_gdb_exception (except);
 342       return NULL;
 343     }
 344   END_CATCH
 345
 346   return value;
 347 }
 348
 349 /* Print a lazy string to STREAM using val_print_string.
 350    STRING must be a <gdb:lazy-string> object.  */
 351
 352 void
 353 lsscm_val_print_lazy_string (SCM string, struct ui_file *stream,
 354                              const struct value_print_options *options)
 355 {
 356   lazy_string_smob *ls_smob;
 357   struct type *elt_type;
 358
 359   gdb_assert (lsscm_is_lazy_string (string));
 360
 361   ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (string);
 362   elt_type = lsscm_elt_type (ls_smob);
 363
 364   val_print_string (elt_type, ls_smob->encoding,
 365                     ls_smob->address, ls_smob->length,
 366                     stream, options);
 367 }
 368 \f
 369 /* Initialize the Scheme lazy-strings code.  */
 370
 371 static const scheme_function lazy_string_functions[] =
 372 {
 373   { "lazy-string?", 1, 0, 0, as_a_scm_t_subr (gdbscm_lazy_string_p),
 374     "\
 375 Return #t if the object is a <gdb:lazy-string> object." },
 376
 377   { "lazy-string-address", 1, 0, 0,
 378     as_a_scm_t_subr (gdbscm_lazy_string_address),
 379     "\
 380 Return the address of the lazy-string." },
 381
 382   { "lazy-string-length", 1, 0, 0, as_a_scm_t_subr (gdbscm_lazy_string_length),
 383     "\
 384 Return the length of the lazy-string.\n\
 385 If the length is -1 then the length is determined by the first null\n\
 386 of appropriate width." },
 387
 388   { "lazy-string-encoding", 1, 0, 0,
 389     as_a_scm_t_subr (gdbscm_lazy_string_encoding),
 390     "\
 391 Return the encoding of the lazy-string." },
 392
 393   { "lazy-string-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_lazy_string_type),
 394     "\
 395 Return the <gdb:type> of the lazy-string." },
 396
 397   { "lazy-string->value", 1, 0, 0,
 398     as_a_scm_t_subr (gdbscm_lazy_string_to_value),
 399     "\
 400 Return the <gdb:value> representation of the lazy-string." },
 401
 402   END_FUNCTIONS
 403 };
 404
 405 void
 406 gdbscm_initialize_lazy_strings (void)
 407 {
 408   lazy_string_smob_tag = gdbscm_make_smob_type (lazy_string_smob_name,
 409                                                 sizeof (lazy_string_smob));
 410   scm_set_smob_free (lazy_string_smob_tag, lsscm_free_lazy_string_smob);
 411   scm_set_smob_print (lazy_string_smob_tag, lsscm_print_lazy_string_smob);
 412
 413   gdbscm_define_functions (lazy_string_functions, 1);
 414 }