gdb/guile/scm-lazy-string.c

   1 /* Scheme interface to lazy strings.
   2
   3    Copyright (C) 2010-2017 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 \f
  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 \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
 238   if (ls_smob->address == 0)
 239     {
 240       gdbscm_throw (gdbscm_make_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
 241                                 _("cannot create a value from NULL")));
 242     }
 243
 244   TRY
 245     {
 246       value = value_at_lazy (ls_smob->type, ls_smob->address);
 247     }
 248   CATCH (except, RETURN_MASK_ALL)
 249     {
 250       GDBSCM_HANDLE_GDB_EXCEPTION (except);
 251     }
 252   END_CATCH
 253
 254   return vlscm_scm_from_value (value);
 255 }
 256
 257 /* A "safe" version of gdbscm_lazy_string_to_value for use by
 258    vlscm_convert_typed_value_from_scheme.
 259    The result, upon success, is the value of <gdb:lazy-string> STRING.
 260    ARG_POS is the argument position of STRING in the original Scheme
 261    function call, used in exception text.
 262    If there's an error, NULL is returned and a <gdb:exception> object
 263    is stored in *except_scmp.
 264
 265    Note: The result is still "lazy".  The caller must call value_fetch_lazy
 266    to actually fetch the value.  */
 267
 268 struct value *
 269 lsscm_safe_lazy_string_to_value (SCM string, int arg_pos,
 270                                  const char *func_name, SCM *except_scmp)
 271 {
 272   lazy_string_smob *ls_smob;
 273   struct value *value = NULL;
 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
 289     {
 290       value = value_at_lazy (ls_smob->type, ls_smob->address);
 291     }
 292   CATCH (except, RETURN_MASK_ALL)
 293     {
 294       *except_scmp = gdbscm_scm_from_gdb_exception (except);
 295       return NULL;
 296     }
 297   END_CATCH
 298
 299   return value;
 300 }
 301
 302 /* Print a lazy string to STREAM using val_print_string.
 303    STRING must be a <gdb:lazy-string> object.  */
 304
 305 void
 306 lsscm_val_print_lazy_string (SCM string, struct ui_file *stream,
 307                              const struct value_print_options *options)
 308 {
 309   lazy_string_smob *ls_smob;
 310
 311   gdb_assert (lsscm_is_lazy_string (string));
 312
 313   ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (string);
 314
 315   val_print_string (ls_smob->type, ls_smob->encoding,
 316                     ls_smob->address, ls_smob->length,
 317                     stream, options);
 318 }
 319 \f
 320 /* Initialize the Scheme lazy-strings code.  */
 321
 322 static const scheme_function lazy_string_functions[] =
 323 {
 324   { "lazy-string?", 1, 0, 0, as_a_scm_t_subr (gdbscm_lazy_string_p),
 325     "\
 326 Return #t if the object is a <gdb:lazy-string> object." },
 327
 328   { "lazy-string-address", 1, 0, 0,
 329     as_a_scm_t_subr (gdbscm_lazy_string_address),
 330     "\
 331 Return the address of the lazy-string." },
 332
 333   { "lazy-string-length", 1, 0, 0, as_a_scm_t_subr (gdbscm_lazy_string_length),
 334     "\
 335 Return the length of the lazy-string.\n\
 336 If the length is -1 then the length is determined by the first null\n\
 337 of appropriate width." },
 338
 339   { "lazy-string-encoding", 1, 0, 0,
 340     as_a_scm_t_subr (gdbscm_lazy_string_encoding),
 341     "\
 342 Return the encoding of the lazy-string." },
 343
 344   { "lazy-string-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_lazy_string_type),
 345     "\
 346 Return the <gdb:type> of the lazy-string." },
 347
 348   { "lazy-string->value", 1, 0, 0,
 349     as_a_scm_t_subr (gdbscm_lazy_string_to_value),
 350     "\
 351 Return the <gdb:value> representation of the lazy-string." },
 352
 353   END_FUNCTIONS
 354 };
 355
 356 void
 357 gdbscm_initialize_lazy_strings (void)
 358 {
 359   lazy_string_smob_tag = gdbscm_make_smob_type (lazy_string_smob_name,
 360                                                 sizeof (lazy_string_smob));
 361   scm_set_smob_free (lazy_string_smob_tag, lsscm_free_lazy_string_smob);
 362   scm_set_smob_print (lazy_string_smob_tag, lsscm_print_lazy_string_smob);
 363
 364   gdbscm_define_functions (lazy_string_functions, 1);
 365 }