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