gdb/guile/scm-lazy-string.c

   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"
  26 #include "exceptions.h"
  27 #include "valprint.h"
  28 #include "language.h"
  29 #include "guile-internal.h"
  30
  31 /* The <gdb:lazy-string> smob.  */
  32
  33 typedef struct
  34 {
  35   /* This always appears first.  */
  36   gdb_smob base;
  37
  38   /*  Holds the address of the lazy string.  */
  39   CORE_ADDR address;
  40
  41   /*  Holds the encoding that will be applied to the string when the string
  42       is printed by GDB.  If the encoding is set to NULL then GDB will select
  43       the most appropriate encoding when the sting is printed.
  44       Space for this is malloc'd and will be freed when the object is
  45       freed.  */
  46   char *encoding;
  47
  48   /* Holds the length of the string in characters.  If the length is -1,
  49      then the string will be fetched and encoded up to the first null of
  50      appropriate width.  */
  51   int length;
  52
  53   /*  This attribute holds the type that is represented by the lazy
  54       string's type.  */
  55   struct type *type;
  56 } lazy_string_smob;
  57
  58 static const char lazy_string_smob_name[] = "gdb:lazy-string";
  59
  60 /* The tag Guile knows the lazy string smob by.  */
  61 static scm_t_bits lazy_string_smob_tag;
  62 \f
  63 /* Administrivia for lazy string smobs.  */
  64
  65 /* The smob "free" function for <gdb:lazy-string>.  */
  66
  67 static size_t
  68 lsscm_free_lazy_string_smob (SCM self)
  69 {
  70   lazy_string_smob *v_smob = (lazy_string_smob *) SCM_SMOB_DATA (self);
  71
  72   xfree (v_smob->encoding);
  73
  74   return 0;
  75 }
  76
  77 /* The smob "print" function for <gdb:lazy-string>.  */
  78
  79 static int
  80 lsscm_print_lazy_string_smob (SCM self, SCM port, scm_print_state *pstate)
  81 {
  82   lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (self);
  83
  84   gdbscm_printf (port, "#<%s", lazy_string_smob_name);
  85   gdbscm_printf (port, " @%s", hex_string (ls_smob->address));
  86   if (ls_smob->length >= 0)
  87     gdbscm_printf (port, " length %d", ls_smob->length);
  88   if (ls_smob->encoding != NULL)
  89     gdbscm_printf (port, " encoding %s", ls_smob->encoding);
  90   scm_puts (">", port);
  91
  92   scm_remember_upto_here_1 (self);
  93
  94   /* Non-zero means success.  */
  95   return 1;
  96 }
  97
  98 /* Low level routine to create a <gdb:lazy-string> object.
  99    The caller must verify !(address == 0 && length != 0).  */
 100
 101 static SCM
 102 lsscm_make_lazy_string_smob (CORE_ADDR address, int length,
 103                              const char *encoding, struct type *type)
 104 {
 105   lazy_string_smob *ls_smob = (lazy_string_smob *)
 106     scm_gc_malloc (sizeof (lazy_string_smob), lazy_string_smob_name);
 107   SCM ls_scm;
 108
 109   /* Caller must verify this.  */
 110   gdb_assert (!(address == 0 && length != 0));
 111   gdb_assert (type != NULL);
 112
 113   ls_smob->address = address;
 114   /* Coerce all values < 0 to -1.  */
 115   ls_smob->length = length < 0 ? -1 : length;
 116   if (encoding == NULL || strcmp (encoding, "") == 0)
 117     ls_smob->encoding = NULL;
 118   else
 119     ls_smob->encoding = xstrdup (encoding);
 120   ls_smob->type = type;
 121
 122   ls_scm = scm_new_smob (lazy_string_smob_tag, (scm_t_bits) ls_smob);
 123   gdbscm_init_gsmob (&ls_smob->base);
 124
 125   return ls_scm;
 126 }
 127
 128 /* Return non-zero if SCM is a <gdb:lazy-string> object.  */
 129
 130 int
 131 lsscm_is_lazy_string (SCM scm)
 132 {
 133   return SCM_SMOB_PREDICATE (lazy_string_smob_tag, scm);
 134 }
 135
 136 /* (lazy-string? object) -> boolean */
 137
 138 static SCM
 139 gdbscm_lazy_string_p (SCM scm)
 140 {
 141   return scm_from_bool (lsscm_is_lazy_string (scm));
 142 }
 143
 144 /* Main entry point to create a <gdb:lazy-string> object.
 145    If there's an error a <gdb:exception> object is returned.  */
 146
 147 SCM
 148 lsscm_make_lazy_string (CORE_ADDR address, int length,
 149                         const char *encoding, struct type *type)
 150 {
 151   if (address == 0 && length != 0)
 152     {
 153       return gdbscm_make_out_of_range_error
 154         (NULL, 0, scm_from_int (length),
 155          _("cannot create a lazy string with address 0x0"
 156            " and a non-zero length"));
 157     }
 158
 159   if (type == NULL)
 160     {
 161       return gdbscm_make_out_of_range_error
 162         (NULL, 0, scm_from_int (0), _("a lazy string's type cannot be NULL"));
 163     }
 164
 165   return lsscm_make_lazy_string_smob (address, length, encoding, type);
 166 }
 167
 168 /* Returns the <gdb:lazy-string> smob in SELF.
 169    Throws an exception if SELF is not a <gdb:lazy-string> object.  */
 170
 171 static SCM
 172 lsscm_get_lazy_string_arg_unsafe (SCM self, int arg_pos, const char *func_name)
 173 {
 174   SCM_ASSERT_TYPE (lsscm_is_lazy_string (self), self, arg_pos, func_name,
 175                    lazy_string_smob_name);
 176
 177   return self;
 178 }
 179 \f
 180 /* Lazy string methods.  */
 181
 182 /* (lazy-string-address <gdb:lazy-string>) -> address */
 183
 184 static SCM
 185 gdbscm_lazy_string_address (SCM self)
 186 {
 187   SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 188   lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
 189
 190   return gdbscm_scm_from_ulongest (ls_smob->address);
 191 }
 192
 193 /* (lazy-string-length <gdb:lazy-string>) -> integer */
 194
 195 static SCM
 196 gdbscm_lazy_string_length (SCM self)
 197 {
 198   SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 199   lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
 200
 201   return scm_from_int (ls_smob->length);
 202 }
 203
 204 /* (lazy-string-encoding <gdb:lazy-string>) -> string */
 205
 206 static SCM
 207 gdbscm_lazy_string_encoding (SCM self)
 208 {
 209   SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 210   lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
 211
 212   /* An encoding can be set to NULL by the user, so check first.
 213      If NULL return #f.  */
 214   if (ls_smob != NULL)
 215     return gdbscm_scm_from_c_string (ls_smob->encoding);
 216   return SCM_BOOL_F;
 217 }
 218
 219 /* (lazy-string-type <gdb:lazy-string>) -> <gdb:type> */
 220
 221 static SCM
 222 gdbscm_lazy_string_type (SCM self)
 223 {
 224   SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 225   lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
 226
 227   return tyscm_scm_from_type (ls_smob->type);
 228 }
 229
 230 /* (lazy-string->value <gdb:lazy-string>) -> <gdb:value> */
 231
 232 static SCM
 233 gdbscm_lazy_string_to_value (SCM self)
 234 {
 235   SCM ls_scm = lsscm_get_lazy_string_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 236   lazy_string_smob *ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (ls_scm);
 237   struct value *value = NULL;
 238   volatile struct gdb_exception except;
 239
 240   if (ls_smob->address == 0)
 241     {
 242       gdbscm_throw (gdbscm_make_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
 243                                 _("cannot create a value from NULL")));
 244     }
 245
 246   TRY_CATCH (except, RETURN_MASK_ALL)
 247     {
 248       value = value_at_lazy (ls_smob->type, ls_smob->address);
 249     }
 250   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 251
 252   return vlscm_scm_from_value (value);
 253 }
 254
 255 /* A "safe" version of gdbscm_lazy_string_to_value for use by
 256    vlscm_convert_typed_value_from_scheme.
 257    The result, upon success, is the value of <gdb:lazy-string> STRING.
 258    ARG_POS is the argument position of STRING in the original Scheme
 259    function call, used in exception text.
 260    If there's an error, NULL is returned and a <gdb:exception> object
 261    is stored in *except_scmp.
 262
 263    Note: The result is still "lazy".  The caller must call value_fetch_lazy
 264    to actually fetch the value.  */
 265
 266 struct value *
 267 lsscm_safe_lazy_string_to_value (SCM string, int arg_pos,
 268                                  const char *func_name, SCM *except_scmp)
 269 {
 270   lazy_string_smob *ls_smob;
 271   struct value *value = NULL;
 272   volatile struct gdb_exception except;
 273
 274   gdb_assert (lsscm_is_lazy_string (string));
 275
 276   ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (string);
 277   *except_scmp = SCM_BOOL_F;
 278
 279   if (ls_smob->address == 0)
 280     {
 281       *except_scmp
 282         = gdbscm_make_out_of_range_error (FUNC_NAME, SCM_ARG1, string,
 283                                          _("cannot create a value from NULL"));
 284       return NULL;
 285     }
 286
 287   TRY_CATCH (except, RETURN_MASK_ALL)
 288     {
 289       value = value_at_lazy (ls_smob->type, ls_smob->address);
 290     }
 291   if (except.reason < 0)
 292     {
 293       *except_scmp = gdbscm_scm_from_gdb_exception (except);
 294       return NULL;
 295     }
 296
 297   return value;
 298 }
 299
 300 /* Print a lazy string to STREAM using val_print_string.
 301    STRING must be a <gdb:lazy-string> object.  */
 302
 303 void
 304 lsscm_val_print_lazy_string (SCM string, struct ui_file *stream,
 305                              const struct value_print_options *options)
 306 {
 307   lazy_string_smob *ls_smob;
 308
 309   gdb_assert (lsscm_is_lazy_string (string));
 310
 311   ls_smob = (lazy_string_smob *) SCM_SMOB_DATA (string);
 312
 313   val_print_string (ls_smob->type, ls_smob->encoding,
 314                     ls_smob->address, ls_smob->length,
 315                     stream, options);
 316 }
 317 \f
 318 /* Initialize the Scheme lazy-strings code.  */
 319
 320 static const scheme_function lazy_string_functions[] =
 321 {
 322   { "lazy-string?", 1, 0, 0, gdbscm_lazy_string_p,
 323     "\
 324 Return #t if the object is a <gdb:lazy-string> object." },
 325
 326   { "lazy-string-address", 1, 0, 0, gdbscm_lazy_string_address,
 327     "\
 328 Return the address of the lazy-string." },
 329
 330   { "lazy-string-length", 1, 0, 0, gdbscm_lazy_string_length,
 331     "\
 332 Return the length of the lazy-string.\n\
 333 If the length is -1 then the length is determined by the first null\n\
 334 of appropriate width." },
 335
 336   { "lazy-string-encoding", 1, 0, 0, gdbscm_lazy_string_encoding,
 337     "\
 338 Return the encoding of the lazy-string." },
 339
 340   { "lazy-string-type", 1, 0, 0, gdbscm_lazy_string_type,
 341     "\
 342 Return the <gdb:type> of the lazy-string." },
 343
 344   { "lazy-string->value", 1, 0, 0, gdbscm_lazy_string_to_value,
 345     "\
 346 Return the <gdb:value> representation of the lazy-string." },
 347
 348   END_FUNCTIONS
 349 };
 350
 351 void
 352 gdbscm_initialize_lazy_strings (void)
 353 {
 354   lazy_string_smob_tag = gdbscm_make_smob_type (lazy_string_smob_name,
 355                                                 sizeof (lazy_string_smob));
 356   scm_set_smob_free (lazy_string_smob_tag, lsscm_free_lazy_string_smob);
 357   scm_set_smob_print (lazy_string_smob_tag, lsscm_print_lazy_string_smob);
 358
 359   gdbscm_define_functions (lazy_string_functions, 1);
 360 }