gdb/guile/scm-value.c

   1 /* Scheme interface to values.
   2
   3    Copyright (C) 2008-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 "arch-utils.h"
  25 #include "charset.h"
  26 #include "cp-abi.h"
  27 #include "gdb_assert.h"
  28 #include "infcall.h"
  29 #include "symtab.h" /* Needed by language.h.  */
  30 #include "language.h"
  31 #include "valprint.h"
  32 #include "value.h"
  33 #include "guile-internal.h"
  34
  35 /* The <gdb:value> smob.  */
  36
  37 typedef struct _value_smob
  38 {
  39   /* This always appears first.  */
  40   gdb_smob base;
  41
  42   /* Doubly linked list of values in values_in_scheme.
  43      IWBN to use a chained_gdb_smob instead, which is doable, it just requires
  44      a bit more casting than normal.  */
  45   struct _value_smob *next;
  46   struct _value_smob *prev;
  47
  48   struct value *value;
  49
  50   /* These are cached here to avoid making multiple copies of them.
  51      Plus computing the dynamic_type can be a bit expensive.
  52      We use #f to indicate that the value doesn't exist (e.g. value doesn't
  53      have an address), so we need another value to indicate that we haven't
  54      computed the value yet.  For this we use SCM_UNDEFINED.  */
  55   SCM address;
  56   SCM type;
  57   SCM dynamic_type;
  58 } value_smob;
  59
  60 static const char value_smob_name[] = "gdb:value";
  61
  62 /* The tag Guile knows the value smob by.  */
  63 static scm_t_bits value_smob_tag;
  64
  65 /* List of all values which are currently exposed to Scheme. It is
  66    maintained so that when an objfile is discarded, preserve_values
  67    can copy the values' types if needed.  */
  68 static value_smob *values_in_scheme;
  69
  70 /* Keywords used by Scheme procedures in this file.  */
  71 static SCM type_keyword;
  72 static SCM encoding_keyword;
  73 static SCM errors_keyword;
  74 static SCM length_keyword;
  75
  76 /* Possible #:errors values.  */
  77 static SCM error_symbol;
  78 static SCM escape_symbol;
  79 static SCM substitute_symbol;
  80 \f
  81 /* Administrivia for value smobs.  */
  82
  83 /* Iterate over all the <gdb:value> objects, calling preserve_one_value on
  84    each.
  85    This is the extension_language_ops.preserve_values "method".  */
  86
  87 void
  88 gdbscm_preserve_values (const struct extension_language_defn *extlang,
  89                         struct objfile *objfile, htab_t copied_types)
  90 {
  91   value_smob *iter;
  92
  93   for (iter = values_in_scheme; iter; iter = iter->next)
  94     preserve_one_value (iter->value, objfile, copied_types);
  95 }
  96
  97 /* Helper to add a value_smob to the global list.  */
  98
  99 static void
 100 vlscm_remember_scheme_value (value_smob *v_smob)
 101 {
 102   v_smob->next = values_in_scheme;
 103   if (v_smob->next)
 104     v_smob->next->prev = v_smob;
 105   v_smob->prev = NULL;
 106   values_in_scheme = v_smob;
 107 }
 108
 109 /* Helper to remove a value_smob from the global list.  */
 110
 111 static void
 112 vlscm_forget_value_smob (value_smob *v_smob)
 113 {
 114   /* Remove SELF from the global list.  */
 115   if (v_smob->prev)
 116     v_smob->prev->next = v_smob->next;
 117   else
 118     {
 119       gdb_assert (values_in_scheme == v_smob);
 120       values_in_scheme = v_smob->next;
 121     }
 122   if (v_smob->next)
 123     v_smob->next->prev = v_smob->prev;
 124 }
 125
 126 /* The smob "mark" function for <gdb:value>.  */
 127
 128 static SCM
 129 vlscm_mark_value_smob (SCM self)
 130 {
 131   value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (self);
 132
 133   scm_gc_mark (v_smob->address);
 134   scm_gc_mark (v_smob->type);
 135   scm_gc_mark (v_smob->dynamic_type);
 136   /* Do this last.  */
 137   return gdbscm_mark_gsmob (&v_smob->base);
 138 }
 139
 140 /* The smob "free" function for <gdb:value>.  */
 141
 142 static size_t
 143 vlscm_free_value_smob (SCM self)
 144 {
 145   value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (self);
 146
 147   vlscm_forget_value_smob (v_smob);
 148   value_free (v_smob->value);
 149
 150   return 0;
 151 }
 152
 153 /* The smob "print" function for <gdb:value>.  */
 154
 155 static int
 156 vlscm_print_value_smob (SCM self, SCM port, scm_print_state *pstate)
 157 {
 158   value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (self);
 159   char *s = NULL;
 160   struct value_print_options opts;
 161   volatile struct gdb_exception except;
 162
 163   if (pstate->writingp)
 164     gdbscm_printf (port, "#<%s ", value_smob_name);
 165
 166   get_user_print_options (&opts);
 167   opts.deref_ref = 0;
 168
 169   /* pstate->writingp = zero if invoked by display/~A, and nonzero if
 170      invoked by write/~S.  What to do here may need to evolve.
 171      IWBN if we could pass an argument to format that would we could use
 172      instead of writingp.  */
 173   opts.raw = !!pstate->writingp;
 174
 175   TRY_CATCH (except, RETURN_MASK_ALL)
 176     {
 177       struct ui_file *stb = mem_fileopen ();
 178       struct cleanup *old_chain = make_cleanup_ui_file_delete (stb);
 179
 180       common_val_print (v_smob->value, stb, 0, &opts, current_language);
 181       s = ui_file_xstrdup (stb, NULL);
 182
 183       do_cleanups (old_chain);
 184     }
 185   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 186
 187   if (s != NULL)
 188     {
 189       scm_puts (s, port);
 190       xfree (s);
 191     }
 192
 193   if (pstate->writingp)
 194     scm_puts (">", port);
 195
 196   scm_remember_upto_here_1 (self);
 197
 198   /* Non-zero means success.  */
 199   return 1;
 200 }
 201
 202 /* The smob "equalp" function for <gdb:value>.  */
 203
 204 static SCM
 205 vlscm_equal_p_value_smob (SCM v1, SCM v2)
 206 {
 207   const value_smob *v1_smob = (value_smob *) SCM_SMOB_DATA (v1);
 208   const value_smob *v2_smob = (value_smob *) SCM_SMOB_DATA (v2);
 209   int result = 0;
 210   volatile struct gdb_exception except;
 211
 212   TRY_CATCH (except, RETURN_MASK_ALL)
 213     {
 214       result = value_equal (v1_smob->value, v2_smob->value);
 215     }
 216   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 217
 218   return scm_from_bool (result);
 219 }
 220
 221 /* Low level routine to create a <gdb:value> object.  */
 222
 223 static SCM
 224 vlscm_make_value_smob (void)
 225 {
 226   value_smob *v_smob = (value_smob *)
 227     scm_gc_malloc (sizeof (value_smob), value_smob_name);
 228   SCM v_scm;
 229
 230   /* These must be filled in by the caller.  */
 231   v_smob->value = NULL;
 232   v_smob->prev = NULL;
 233   v_smob->next = NULL;
 234
 235   /* These are lazily computed.  */
 236   v_smob->address = SCM_UNDEFINED;
 237   v_smob->type = SCM_UNDEFINED;
 238   v_smob->dynamic_type = SCM_UNDEFINED;
 239
 240   v_scm = scm_new_smob (value_smob_tag, (scm_t_bits) v_smob);
 241   gdbscm_init_gsmob (&v_smob->base);
 242
 243   return v_scm;
 244 }
 245
 246 /* Return non-zero if SCM is a <gdb:value> object.  */
 247
 248 int
 249 vlscm_is_value (SCM scm)
 250 {
 251   return SCM_SMOB_PREDICATE (value_smob_tag, scm);
 252 }
 253
 254 /* (value? object) -> boolean */
 255
 256 static SCM
 257 gdbscm_value_p (SCM scm)
 258 {
 259   return scm_from_bool (vlscm_is_value (scm));
 260 }
 261
 262 /* Create a new <gdb:value> object that encapsulates VALUE.
 263    The value is released from the all_values chain so its lifetime is not
 264    bound to the execution of a command.  */
 265
 266 SCM
 267 vlscm_scm_from_value (struct value *value)
 268 {
 269   /* N.B. It's important to not cause any side-effects until we know the
 270      conversion worked.  */
 271   SCM v_scm = vlscm_make_value_smob ();
 272   value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (v_scm);
 273
 274   v_smob->value = value;
 275   release_value_or_incref (value);
 276   vlscm_remember_scheme_value (v_smob);
 277
 278   return v_scm;
 279 }
 280
 281 /* Returns the <gdb:value> object in SELF.
 282    Throws an exception if SELF is not a <gdb:value> object.  */
 283
 284 static SCM
 285 vlscm_get_value_arg_unsafe (SCM self, int arg_pos, const char *func_name)
 286 {
 287   SCM_ASSERT_TYPE (vlscm_is_value (self), self, arg_pos, func_name,
 288                    value_smob_name);
 289
 290   return self;
 291 }
 292
 293 /* Returns a pointer to the value smob of SELF.
 294    Throws an exception if SELF is not a <gdb:value> object.  */
 295
 296 static value_smob *
 297 vlscm_get_value_smob_arg_unsafe (SCM self, int arg_pos, const char *func_name)
 298 {
 299   SCM v_scm = vlscm_get_value_arg_unsafe (self, arg_pos, func_name);
 300   value_smob *v_smob = (value_smob *) SCM_SMOB_DATA (v_scm);
 301
 302   return v_smob;
 303 }
 304
 305 /* Return the value field of V_SCM, an object of type <gdb:value>.
 306    This exists so that we don't have to export the struct's contents.  */
 307
 308 struct value *
 309 vlscm_scm_to_value (SCM v_scm)
 310 {
 311   value_smob *v_smob;
 312
 313   gdb_assert (vlscm_is_value (v_scm));
 314   v_smob = (value_smob *) SCM_SMOB_DATA (v_scm);
 315   return v_smob->value;
 316 }
 317 \f
 318 /* Value methods.  */
 319
 320 /* (make-value x [#:type type]) -> <gdb:value> */
 321
 322 static SCM
 323 gdbscm_make_value (SCM x, SCM rest)
 324 {
 325   struct gdbarch *gdbarch = get_current_arch ();
 326   const struct language_defn *language = current_language;
 327   const SCM keywords[] = { type_keyword, SCM_BOOL_F };
 328   int type_arg_pos = -1;
 329   SCM type_scm = SCM_UNDEFINED;
 330   SCM except_scm, result;
 331   type_smob *t_smob;
 332   struct type *type = NULL;
 333   struct value *value;
 334   struct cleanup *cleanups;
 335
 336   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#O", rest,
 337                               &type_arg_pos, &type_scm);
 338
 339   if (type_arg_pos > 0)
 340     {
 341       t_smob = tyscm_get_type_smob_arg_unsafe (type_scm, type_arg_pos,
 342                                                FUNC_NAME);
 343       type = tyscm_type_smob_type (t_smob);
 344     }
 345
 346   cleanups = make_cleanup_value_free_to_mark (value_mark ());
 347
 348   value = vlscm_convert_typed_value_from_scheme (FUNC_NAME, SCM_ARG1, x,
 349                                                  type_arg_pos, type_scm, type,
 350                                                  &except_scm,
 351                                                  gdbarch, language);
 352   if (value == NULL)
 353     {
 354       do_cleanups (cleanups);
 355       gdbscm_throw (except_scm);
 356     }
 357
 358   result = vlscm_scm_from_value (value);
 359
 360   do_cleanups (cleanups);
 361
 362   if (gdbscm_is_exception (result))
 363     gdbscm_throw (result);
 364   return result;
 365 }
 366
 367 /* (make-lazy-value <gdb:type> address) -> <gdb:value> */
 368
 369 static SCM
 370 gdbscm_make_lazy_value (SCM type_scm, SCM address_scm)
 371 {
 372   type_smob *t_smob;
 373   struct type *type;
 374   ULONGEST address;
 375   struct value *value = NULL;
 376   SCM result;
 377   struct cleanup *cleanups;
 378   volatile struct gdb_exception except;
 379
 380   t_smob = tyscm_get_type_smob_arg_unsafe (type_scm, SCM_ARG1, FUNC_NAME);
 381   type = tyscm_type_smob_type (t_smob);
 382
 383   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, NULL, "U",
 384                               address_scm, &address);
 385
 386   cleanups = make_cleanup_value_free_to_mark (value_mark ());
 387
 388   /* There's no (current) need to wrap this in a TRY_CATCH, but for consistency
 389      and future-proofing we do.  */
 390   TRY_CATCH (except, RETURN_MASK_ALL)
 391   {
 392     value = value_from_contents_and_address (type, NULL, address);
 393   }
 394   GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
 395
 396   result = vlscm_scm_from_value (value);
 397
 398   do_cleanups (cleanups);
 399
 400   if (gdbscm_is_exception (result))
 401     gdbscm_throw (result);
 402   return result;
 403 }
 404
 405 /* (value-optimized-out? <gdb:value>) -> boolean */
 406
 407 static SCM
 408 gdbscm_value_optimized_out_p (SCM self)
 409 {
 410   value_smob *v_smob
 411     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 412   struct value *value = v_smob->value;
 413   int opt = 0;
 414   volatile struct gdb_exception except;
 415
 416   TRY_CATCH (except, RETURN_MASK_ALL)
 417     {
 418       opt = value_optimized_out (value);
 419     }
 420   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 421
 422   return scm_from_bool (opt);
 423 }
 424
 425 /* (value-address <gdb:value>) -> integer
 426    Returns #f if the value doesn't have one.  */
 427
 428 static SCM
 429 gdbscm_value_address (SCM self)
 430 {
 431   value_smob *v_smob
 432     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 433   struct value *value = v_smob->value;
 434
 435   if (SCM_UNBNDP (v_smob->address))
 436     {
 437       struct value *res_val = NULL;
 438       struct cleanup *cleanup
 439         = make_cleanup_value_free_to_mark (value_mark ());
 440       SCM address;
 441       volatile struct gdb_exception except;
 442
 443       TRY_CATCH (except, RETURN_MASK_ALL)
 444         {
 445           res_val = value_addr (value);
 446         }
 447       if (except.reason < 0)
 448         address = SCM_BOOL_F;
 449       else
 450         address = vlscm_scm_from_value (res_val);
 451
 452       do_cleanups (cleanup);
 453
 454       if (gdbscm_is_exception (address))
 455         gdbscm_throw (address);
 456
 457       v_smob->address = address;
 458     }
 459
 460   return v_smob->address;
 461 }
 462
 463 /* (value-dereference <gdb:value>) -> <gdb:value>
 464    Given a value of a pointer type, apply the C unary * operator to it.  */
 465
 466 static SCM
 467 gdbscm_value_dereference (SCM self)
 468 {
 469   value_smob *v_smob
 470     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 471   struct value *value = v_smob->value;
 472   SCM result;
 473   struct value *res_val = NULL;
 474   struct cleanup *cleanups;
 475   volatile struct gdb_exception except;
 476
 477   cleanups = make_cleanup_value_free_to_mark (value_mark ());
 478
 479   TRY_CATCH (except, RETURN_MASK_ALL)
 480     {
 481       res_val = value_ind (value);
 482     }
 483   GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
 484
 485   result = vlscm_scm_from_value (res_val);
 486
 487   do_cleanups (cleanups);
 488
 489   if (gdbscm_is_exception (result))
 490     gdbscm_throw (result);
 491
 492   return result;
 493 }
 494
 495 /* (value-referenced-value <gdb:value>) -> <gdb:value>
 496    Given a value of a reference type, return the value referenced.
 497    The difference between this function and gdbscm_value_dereference is that
 498    the latter applies * unary operator to a value, which need not always
 499    result in the value referenced.
 500    For example, for a value which is a reference to an 'int' pointer ('int *'),
 501    gdbscm_value_dereference will result in a value of type 'int' while
 502    gdbscm_value_referenced_value will result in a value of type 'int *'.  */
 503
 504 static SCM
 505 gdbscm_value_referenced_value (SCM self)
 506 {
 507   value_smob *v_smob
 508     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 509   struct value *value = v_smob->value;
 510   SCM result;
 511   struct value *res_val = NULL;
 512   struct cleanup *cleanups;
 513   volatile struct gdb_exception except;
 514
 515   cleanups = make_cleanup_value_free_to_mark (value_mark ());
 516
 517   TRY_CATCH (except, RETURN_MASK_ALL)
 518     {
 519       switch (TYPE_CODE (check_typedef (value_type (value))))
 520         {
 521         case TYPE_CODE_PTR:
 522           res_val = value_ind (value);
 523           break;
 524         case TYPE_CODE_REF:
 525           res_val = coerce_ref (value);
 526           break;
 527         default:
 528           error (_("Trying to get the referenced value from a value which is"
 529                    " neither a pointer nor a reference"));
 530         }
 531     }
 532   GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
 533
 534   result = vlscm_scm_from_value (res_val);
 535
 536   do_cleanups (cleanups);
 537
 538   if (gdbscm_is_exception (result))
 539     gdbscm_throw (result);
 540
 541   return result;
 542 }
 543
 544 /* (value-type <gdb:value>) -> <gdb:type> */
 545
 546 static SCM
 547 gdbscm_value_type (SCM self)
 548 {
 549   value_smob *v_smob
 550     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 551   struct value *value = v_smob->value;
 552
 553   if (SCM_UNBNDP (v_smob->type))
 554     v_smob->type = tyscm_scm_from_type (value_type (value));
 555
 556   return v_smob->type;
 557 }
 558
 559 /* (value-dynamic-type <gdb:value>) -> <gdb:type> */
 560
 561 static SCM
 562 gdbscm_value_dynamic_type (SCM self)
 563 {
 564   value_smob *v_smob
 565     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 566   struct value *value = v_smob->value;
 567   struct type *type = NULL;
 568   volatile struct gdb_exception except;
 569
 570   if (! SCM_UNBNDP (v_smob->type))
 571     return v_smob->dynamic_type;
 572
 573   TRY_CATCH (except, RETURN_MASK_ALL)
 574     {
 575       struct cleanup *cleanup
 576         = make_cleanup_value_free_to_mark (value_mark ());
 577
 578       type = value_type (value);
 579       CHECK_TYPEDEF (type);
 580
 581       if (((TYPE_CODE (type) == TYPE_CODE_PTR)
 582            || (TYPE_CODE (type) == TYPE_CODE_REF))
 583           && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_CLASS))
 584         {
 585           struct value *target;
 586           int was_pointer = TYPE_CODE (type) == TYPE_CODE_PTR;
 587
 588           target = value_ind (value);
 589           type = value_rtti_type (target, NULL, NULL, NULL);
 590
 591           if (type)
 592             {
 593               if (was_pointer)
 594                 type = lookup_pointer_type (type);
 595               else
 596                 type = lookup_reference_type (type);
 597             }
 598         }
 599       else if (TYPE_CODE (type) == TYPE_CODE_CLASS)
 600         type = value_rtti_type (value, NULL, NULL, NULL);
 601       else
 602         {
 603           /* Re-use object's static type.  */
 604           type = NULL;
 605         }
 606
 607       do_cleanups (cleanup);
 608     }
 609   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 610
 611   if (type == NULL)
 612     v_smob->dynamic_type = gdbscm_value_type (self);
 613   else
 614     v_smob->dynamic_type = tyscm_scm_from_type (type);
 615
 616   return v_smob->dynamic_type;
 617 }
 618
 619 /* A helper function that implements the various cast operators.  */
 620
 621 static SCM
 622 vlscm_do_cast (SCM self, SCM type_scm, enum exp_opcode op,
 623                const char *func_name)
 624 {
 625   value_smob *v_smob
 626     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 627   struct value *value = v_smob->value;
 628   type_smob *t_smob
 629     = tyscm_get_type_smob_arg_unsafe (type_scm, SCM_ARG2, FUNC_NAME);
 630   struct type *type = tyscm_type_smob_type (t_smob);
 631   SCM result;
 632   struct value *res_val = NULL;
 633   struct cleanup *cleanups;
 634   volatile struct gdb_exception except;
 635
 636   cleanups = make_cleanup_value_free_to_mark (value_mark ());
 637
 638   TRY_CATCH (except, RETURN_MASK_ALL)
 639     {
 640       if (op == UNOP_DYNAMIC_CAST)
 641         res_val = value_dynamic_cast (type, value);
 642       else if (op == UNOP_REINTERPRET_CAST)
 643         res_val = value_reinterpret_cast (type, value);
 644       else
 645         {
 646           gdb_assert (op == UNOP_CAST);
 647           res_val = value_cast (type, value);
 648         }
 649     }
 650   GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
 651
 652   gdb_assert (res_val != NULL);
 653   result = vlscm_scm_from_value (res_val);
 654
 655   do_cleanups (cleanups);
 656
 657   if (gdbscm_is_exception (result))
 658     gdbscm_throw (result);
 659
 660   return result;
 661 }
 662
 663 /* (value-cast <gdb:value> <gdb:type>) -> <gdb:value> */
 664
 665 static SCM
 666 gdbscm_value_cast (SCM self, SCM new_type)
 667 {
 668   return vlscm_do_cast (self, new_type, UNOP_CAST, FUNC_NAME);
 669 }
 670
 671 /* (value-dynamic-cast <gdb:value> <gdb:type>) -> <gdb:value> */
 672
 673 static SCM
 674 gdbscm_value_dynamic_cast (SCM self, SCM new_type)
 675 {
 676   return vlscm_do_cast (self, new_type, UNOP_DYNAMIC_CAST, FUNC_NAME);
 677 }
 678
 679 /* (value-reinterpret-cast <gdb:value> <gdb:type>) -> <gdb:value> */
 680
 681 static SCM
 682 gdbscm_value_reinterpret_cast (SCM self, SCM new_type)
 683 {
 684   return vlscm_do_cast (self, new_type, UNOP_REINTERPRET_CAST, FUNC_NAME);
 685 }
 686
 687 /* (value-field <gdb:value> string) -> <gdb:value>
 688    Given string name of an element inside structure, return its <gdb:value>
 689    object.  */
 690
 691 static SCM
 692 gdbscm_value_field (SCM self, SCM field_scm)
 693 {
 694   value_smob *v_smob
 695     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 696   struct value *value = v_smob->value;
 697   char *field = NULL;
 698   struct value *res_val = NULL;
 699   SCM result;
 700   struct cleanup *cleanups;
 701   volatile struct gdb_exception except;
 702
 703   SCM_ASSERT_TYPE (scm_is_string (field_scm), field_scm, SCM_ARG2, FUNC_NAME,
 704                    _("string"));
 705
 706   cleanups = make_cleanup_value_free_to_mark (value_mark ());
 707
 708   field = gdbscm_scm_to_c_string (field_scm);
 709   make_cleanup (xfree, field);
 710
 711   TRY_CATCH (except, RETURN_MASK_ALL)
 712     {
 713       struct value *tmp = value;
 714
 715       res_val = value_struct_elt (&tmp, NULL, field, NULL, NULL);
 716     }
 717   GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
 718
 719   gdb_assert (res_val != NULL);
 720   result = vlscm_scm_from_value (res_val);
 721
 722   do_cleanups (cleanups);
 723
 724   if (gdbscm_is_exception (result))
 725     gdbscm_throw (result);
 726
 727   return result;
 728 }
 729
 730 /* (value-subscript <gdb:value> integer|<gdb:value>) -> <gdb:value>
 731    Return the specified value in an array.  */
 732
 733 static SCM
 734 gdbscm_value_subscript (SCM self, SCM index_scm)
 735 {
 736   value_smob *v_smob
 737     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 738   struct value *value = v_smob->value;
 739   struct value *index = NULL;
 740   struct value *res_val = NULL;
 741   struct type *type = value_type (value);
 742   struct gdbarch *gdbarch;
 743   SCM result, except_scm;
 744   struct cleanup *cleanups;
 745   volatile struct gdb_exception except;
 746
 747   /* The sequencing here, as everywhere else, is important.
 748      We can't have existing cleanups when a Scheme exception is thrown.  */
 749
 750   SCM_ASSERT (type != NULL, self, SCM_ARG2, FUNC_NAME);
 751   gdbarch = get_type_arch (type);
 752
 753   cleanups = make_cleanup_value_free_to_mark (value_mark ());
 754
 755   index = vlscm_convert_value_from_scheme (FUNC_NAME, SCM_ARG2, index_scm,
 756                                            &except_scm,
 757                                            gdbarch, current_language);
 758   if (index == NULL)
 759     {
 760       do_cleanups (cleanups);
 761       gdbscm_throw (except_scm);
 762     }
 763
 764   TRY_CATCH (except, RETURN_MASK_ALL)
 765     {
 766       struct value *tmp = value;
 767
 768       /* Assume we are attempting an array access, and let the value code
 769          throw an exception if the index has an invalid type.
 770          Check the value's type is something that can be accessed via
 771          a subscript.  */
 772       tmp = coerce_ref (tmp);
 773       type = check_typedef (value_type (tmp));
 774       if (TYPE_CODE (type) != TYPE_CODE_ARRAY
 775           && TYPE_CODE (type) != TYPE_CODE_PTR)
 776         error (_("Cannot subscript requested type"));
 777
 778       res_val = value_subscript (tmp, value_as_long (index));
 779    }
 780   GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
 781
 782   gdb_assert (res_val != NULL);
 783   result = vlscm_scm_from_value (res_val);
 784
 785   do_cleanups (cleanups);
 786
 787   if (gdbscm_is_exception (result))
 788     gdbscm_throw (result);
 789
 790   return result;
 791 }
 792
 793 /* (value-call <gdb:value> arg-list) -> <gdb:value>
 794    Perform an inferior function call on the value.  */
 795
 796 static SCM
 797 gdbscm_value_call (SCM self, SCM args)
 798 {
 799   value_smob *v_smob
 800     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 801   struct value *function = v_smob->value;
 802   struct value *mark = value_mark ();
 803   struct type *ftype = NULL;
 804   long args_count;
 805   struct value **vargs = NULL;
 806   SCM result = SCM_BOOL_F;
 807   volatile struct gdb_exception except;
 808
 809   TRY_CATCH (except, RETURN_MASK_ALL)
 810     {
 811       ftype = check_typedef (value_type (function));
 812     }
 813   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 814
 815   SCM_ASSERT_TYPE (TYPE_CODE (ftype) == TYPE_CODE_FUNC, self,
 816                    SCM_ARG1, FUNC_NAME,
 817                    _("function (value of TYPE_CODE_FUNC)"));
 818
 819   SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (args)), args,
 820                    SCM_ARG2, FUNC_NAME, _("list"));
 821
 822   args_count = scm_ilength (args);
 823   if (args_count > 0)
 824     {
 825       struct gdbarch *gdbarch = get_current_arch ();
 826       const struct language_defn *language = current_language;
 827       SCM except_scm;
 828       long i;
 829
 830       vargs = alloca (sizeof (struct value *) * args_count);
 831       for (i = 0; i < args_count; i++)
 832         {
 833           SCM arg = scm_car (args);
 834
 835           vargs[i] = vlscm_convert_value_from_scheme (FUNC_NAME,
 836                                                       GDBSCM_ARG_NONE, arg,
 837                                                       &except_scm,
 838                                                       gdbarch, language);
 839           if (vargs[i] == NULL)
 840             gdbscm_throw (except_scm);
 841
 842           args = scm_cdr (args);
 843         }
 844       gdb_assert (gdbscm_is_true (scm_null_p (args)));
 845     }
 846
 847   TRY_CATCH (except, RETURN_MASK_ALL)
 848     {
 849       struct cleanup *cleanup = make_cleanup_value_free_to_mark (mark);
 850       struct value *return_value;
 851
 852       return_value = call_function_by_hand (function, args_count, vargs);
 853       result = vlscm_scm_from_value (return_value);
 854       do_cleanups (cleanup);
 855     }
 856   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 857
 858   if (gdbscm_is_exception (result))
 859     gdbscm_throw (result);
 860
 861   return result;
 862 }
 863
 864 /* (value->bytevector <gdb:value>) -> bytevector */
 865
 866 static SCM
 867 gdbscm_value_to_bytevector (SCM self)
 868 {
 869   value_smob *v_smob
 870     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 871   struct value *value = v_smob->value;
 872   struct type *type;
 873   size_t length = 0;
 874   const gdb_byte *contents = NULL;
 875   SCM bv;
 876   volatile struct gdb_exception except;
 877
 878   type = value_type (value);
 879
 880   TRY_CATCH (except, RETURN_MASK_ALL)
 881     {
 882       CHECK_TYPEDEF (type);
 883       length = TYPE_LENGTH (type);
 884       contents = value_contents (value);
 885     }
 886   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 887
 888   bv = scm_c_make_bytevector (length);
 889   memcpy (SCM_BYTEVECTOR_CONTENTS (bv), contents, length);
 890
 891   return bv;
 892 }
 893
 894 /* Helper function to determine if a type is "int-like".  */
 895
 896 static int
 897 is_intlike (struct type *type, int ptr_ok)
 898 {
 899   return (TYPE_CODE (type) == TYPE_CODE_INT
 900           || TYPE_CODE (type) == TYPE_CODE_ENUM
 901           || TYPE_CODE (type) == TYPE_CODE_BOOL
 902           || TYPE_CODE (type) == TYPE_CODE_CHAR
 903           || (ptr_ok && TYPE_CODE (type) == TYPE_CODE_PTR));
 904 }
 905
 906 /* (value->bool <gdb:value>) -> boolean
 907    Throws an error if the value is not integer-like.  */
 908
 909 static SCM
 910 gdbscm_value_to_bool (SCM self)
 911 {
 912   value_smob *v_smob
 913     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 914   struct value *value = v_smob->value;
 915   struct type *type;
 916   LONGEST l = 0;
 917   volatile struct gdb_exception except;
 918
 919   type = value_type (value);
 920
 921   TRY_CATCH (except, RETURN_MASK_ALL)
 922     {
 923       CHECK_TYPEDEF (type);
 924     }
 925   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 926
 927   SCM_ASSERT_TYPE (is_intlike (type, 1), self, SCM_ARG1, FUNC_NAME,
 928                    _("integer-like gdb value"));
 929
 930   TRY_CATCH (except, RETURN_MASK_ALL)
 931     {
 932       if (TYPE_CODE (type) == TYPE_CODE_PTR)
 933         l = value_as_address (value);
 934       else
 935         l = value_as_long (value);
 936     }
 937   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 938
 939   return scm_from_bool (l != 0);
 940 }
 941
 942 /* (value->integer <gdb:value>) -> integer
 943    Throws an error if the value is not integer-like.  */
 944
 945 static SCM
 946 gdbscm_value_to_integer (SCM self)
 947 {
 948   value_smob *v_smob
 949     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 950   struct value *value = v_smob->value;
 951   struct type *type;
 952   LONGEST l = 0;
 953   volatile struct gdb_exception except;
 954
 955   type = value_type (value);
 956
 957   TRY_CATCH (except, RETURN_MASK_ALL)
 958     {
 959       CHECK_TYPEDEF (type);
 960     }
 961   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 962
 963   SCM_ASSERT_TYPE (is_intlike (type, 1), self, SCM_ARG1, FUNC_NAME,
 964                    _("integer-like gdb value"));
 965
 966   TRY_CATCH (except, RETURN_MASK_ALL)
 967     {
 968       if (TYPE_CODE (type) == TYPE_CODE_PTR)
 969         l = value_as_address (value);
 970       else
 971         l = value_as_long (value);
 972     }
 973   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 974
 975   if (TYPE_UNSIGNED (type))
 976     return gdbscm_scm_from_ulongest (l);
 977   else
 978     return gdbscm_scm_from_longest (l);
 979 }
 980
 981 /* (value->real <gdb:value>) -> real
 982    Throws an error if the value is not a number.  */
 983
 984 static SCM
 985 gdbscm_value_to_real (SCM self)
 986 {
 987   value_smob *v_smob
 988     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 989   struct value *value = v_smob->value;
 990   struct type *type;
 991   DOUBLEST d = 0;
 992   volatile struct gdb_exception except;
 993
 994   type = value_type (value);
 995
 996   TRY_CATCH (except, RETURN_MASK_ALL)
 997     {
 998       CHECK_TYPEDEF (type);
 999     }
1000   GDBSCM_HANDLE_GDB_EXCEPTION (except);
1001
1002   SCM_ASSERT_TYPE (is_intlike (type, 0) || TYPE_CODE (type) == TYPE_CODE_FLT,
1003                    self, SCM_ARG1, FUNC_NAME, _("number"));
1004
1005   TRY_CATCH (except, RETURN_MASK_ALL)
1006     {
1007       d = value_as_double (value);
1008     }
1009   GDBSCM_HANDLE_GDB_EXCEPTION (except);
1010
1011   /* TODO: Is there a better way to check if the value fits?  */
1012   if (d != (double) d)
1013     gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self,
1014                                _("number can't be converted to a double"));
1015
1016   return scm_from_double (d);
1017 }
1018
1019 /* (value->string <gdb:value>
1020        [#:encoding encoding]
1021        [#:errors #f | 'error | 'substitute]
1022        [#:length length])
1023      -> string
1024    Return Unicode string with value's contents, which must be a string.
1025
1026    If ENCODING is not given, the string is assumed to be encoded in
1027    the target's charset.
1028
1029    ERRORS is one of #f, 'error or 'substitute.
1030    An error setting of #f means use the default, which is
1031    Guile's %default-port-conversion-strategy.  If the default is not one
1032    of 'error or 'substitute, 'substitute is used.
1033    An error setting of "error" causes an exception to be thrown if there's
1034    a decoding error.  An error setting of "substitute" causes invalid
1035    characters to be replaced with "?".
1036
1037    If LENGTH is provided, only fetch string to the length provided.
1038    LENGTH must be a Scheme integer, it can't be a <gdb:value> integer.  */
1039
1040 static SCM
1041 gdbscm_value_to_string (SCM self, SCM rest)
1042 {
1043   value_smob *v_smob
1044     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1045   struct value *value = v_smob->value;
1046   const SCM keywords[] = {
1047     encoding_keyword, errors_keyword, length_keyword, SCM_BOOL_F
1048   };
1049   int encoding_arg_pos = -1, errors_arg_pos = -1, length_arg_pos = -1;
1050   char *encoding = NULL;
1051   SCM errors = SCM_BOOL_F;
1052   int length = -1;
1053   gdb_byte *buffer = NULL;
1054   const char *la_encoding = NULL;
1055   struct type *char_type = NULL;
1056   SCM result;
1057   struct cleanup *cleanups;
1058   volatile struct gdb_exception except;
1059
1060   /* The sequencing here, as everywhere else, is important.
1061      We can't have existing cleanups when a Scheme exception is thrown.  */
1062
1063   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#sOi", rest,
1064                               &encoding_arg_pos, &encoding,
1065                               &errors_arg_pos, &errors,
1066                               &length_arg_pos, &length);
1067
1068   cleanups = make_cleanup (xfree, encoding);
1069
1070   if (errors_arg_pos > 0
1071       && errors != SCM_BOOL_F
1072       && !scm_is_eq (errors, error_symbol)
1073       && !scm_is_eq (errors, substitute_symbol))
1074     {
1075       SCM excp
1076         = gdbscm_make_out_of_range_error (FUNC_NAME, errors_arg_pos, errors,
1077                                           _("invalid error kind"));
1078
1079       do_cleanups (cleanups);
1080       gdbscm_throw (excp);
1081     }
1082   if (errors == SCM_BOOL_F)
1083     errors = scm_port_conversion_strategy (SCM_BOOL_F);
1084   /* We don't assume anything about the result of scm_port_conversion_strategy.
1085      From this point on, if errors is not 'errors, use 'substitute.  */
1086
1087   TRY_CATCH (except, RETURN_MASK_ALL)
1088     {
1089       LA_GET_STRING (value, &buffer, &length, &char_type, &la_encoding);
1090     }
1091   GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
1092
1093   /* If errors is "error" scm_from_stringn may throw a Scheme exception.
1094      Make sure we don't leak.  This is done via scm_dynwind_begin, et.al.  */
1095   discard_cleanups (cleanups);
1096
1097   scm_dynwind_begin (0);
1098
1099   gdbscm_dynwind_xfree (encoding);
1100   gdbscm_dynwind_xfree (buffer);
1101
1102   result = scm_from_stringn ((const char *) buffer,
1103                              length * TYPE_LENGTH (char_type),
1104                              (encoding != NULL && *encoding != '\0'
1105                               ? encoding
1106                               : la_encoding),
1107                              scm_is_eq (errors, error_symbol)
1108                              ? SCM_FAILED_CONVERSION_ERROR
1109                              : SCM_FAILED_CONVERSION_QUESTION_MARK);
1110
1111   scm_dynwind_end ();
1112
1113   return result;
1114 }
1115
1116 /* (value->lazy-string <gdb:value> [#:encoding encoding] [#:length length])
1117      -> <gdb:lazy-string>
1118    Return a Scheme object representing a lazy_string_object type.
1119    A lazy string is a pointer to a string with an optional encoding and length.
1120    If ENCODING is not given, the target's charset is used.
1121    If LENGTH is provided then the length parameter is set to LENGTH, otherwise
1122    length will be set to -1 (first null of appropriate with).
1123    LENGTH must be a Scheme integer, it can't be a <gdb:value> integer.  */
1124
1125 static SCM
1126 gdbscm_value_to_lazy_string (SCM self, SCM rest)
1127 {
1128   value_smob *v_smob
1129     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1130   struct value *value = v_smob->value;
1131   const SCM keywords[] = { encoding_keyword, length_keyword, SCM_BOOL_F };
1132   int encoding_arg_pos = -1, length_arg_pos = -1;
1133   char *encoding = NULL;
1134   int length = -1;
1135   SCM result = SCM_BOOL_F; /* -Wall */
1136   struct cleanup *cleanups;
1137   volatile struct gdb_exception except;
1138
1139   /* The sequencing here, as everywhere else, is important.
1140      We can't have existing cleanups when a Scheme exception is thrown.  */
1141
1142   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG2, keywords, "#si", rest,
1143                               &encoding_arg_pos, &encoding,
1144                               &length_arg_pos, &length);
1145
1146   cleanups = make_cleanup (xfree, encoding);
1147
1148   TRY_CATCH (except, RETURN_MASK_ALL)
1149     {
1150       struct cleanup *inner_cleanup
1151         = make_cleanup_value_free_to_mark (value_mark ());
1152
1153       if (TYPE_CODE (value_type (value)) == TYPE_CODE_PTR)
1154         value = value_ind (value);
1155
1156       result = lsscm_make_lazy_string (value_address (value), length,
1157                                        encoding, value_type (value));
1158
1159       do_cleanups (inner_cleanup);
1160     }
1161   do_cleanups (cleanups);
1162   GDBSCM_HANDLE_GDB_EXCEPTION (except);
1163
1164   if (gdbscm_is_exception (result))
1165     gdbscm_throw (result);
1166
1167   return result;
1168 }
1169
1170 /* (value-lazy? <gdb:value>) -> boolean */
1171
1172 static SCM
1173 gdbscm_value_lazy_p (SCM self)
1174 {
1175   value_smob *v_smob
1176     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1177   struct value *value = v_smob->value;
1178
1179   return scm_from_bool (value_lazy (value));
1180 }
1181
1182 /* (value-fetch-lazy! <gdb:value>) -> unspecified */
1183
1184 static SCM
1185 gdbscm_value_fetch_lazy_x (SCM self)
1186 {
1187   value_smob *v_smob
1188     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1189   struct value *value = v_smob->value;
1190   volatile struct gdb_exception except;
1191
1192   TRY_CATCH (except, RETURN_MASK_ALL)
1193     {
1194       if (value_lazy (value))
1195         value_fetch_lazy (value);
1196     }
1197   GDBSCM_HANDLE_GDB_EXCEPTION (except);
1198
1199   return SCM_UNSPECIFIED;
1200 }
1201
1202 /* (value-print <gdb:value>) -> string */
1203
1204 static SCM
1205 gdbscm_value_print (SCM self)
1206 {
1207   value_smob *v_smob
1208     = vlscm_get_value_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1209   struct value *value = v_smob->value;
1210   struct value_print_options opts;
1211   char *s = NULL;
1212   SCM result;
1213   volatile struct gdb_exception except;
1214
1215   get_user_print_options (&opts);
1216   opts.deref_ref = 0;
1217
1218   TRY_CATCH (except, RETURN_MASK_ALL)
1219     {
1220       struct ui_file *stb = mem_fileopen ();
1221       struct cleanup *old_chain = make_cleanup_ui_file_delete (stb);
1222
1223       common_val_print (value, stb, 0, &opts, current_language);
1224       s = ui_file_xstrdup (stb, NULL);
1225
1226       do_cleanups (old_chain);
1227     }
1228   GDBSCM_HANDLE_GDB_EXCEPTION (except);
1229
1230   /* Use SCM_FAILED_CONVERSION_QUESTION_MARK to ensure this doesn't
1231      throw an error if the encoding fails.
1232      IWBN to use scm_take_locale_string here, but we'd have to temporarily
1233      override the default port conversion handler because contrary to
1234      documentation it doesn't necessarily free the input string.  */
1235   result = scm_from_stringn (s, strlen (s), host_charset (),
1236                              SCM_FAILED_CONVERSION_QUESTION_MARK);
1237   xfree (s);
1238
1239   return result;
1240 }
1241 \f
1242 /* (parse-and-eval string) -> <gdb:value>
1243    Parse a string and evaluate the string as an expression.  */
1244
1245 static SCM
1246 gdbscm_parse_and_eval (SCM expr_scm)
1247 {
1248   char *expr_str;
1249   struct value *res_val = NULL;
1250   SCM result;
1251   struct cleanup *cleanups;
1252   volatile struct gdb_exception except;
1253
1254   /* The sequencing here, as everywhere else, is important.
1255      We can't have existing cleanups when a Scheme exception is thrown.  */
1256
1257   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "s",
1258                               expr_scm, &expr_str);
1259
1260   cleanups = make_cleanup_value_free_to_mark (value_mark ());
1261   make_cleanup (xfree, expr_str);
1262
1263   TRY_CATCH (except, RETURN_MASK_ALL)
1264     {
1265       res_val = parse_and_eval (expr_str);
1266     }
1267   GDBSCM_HANDLE_GDB_EXCEPTION_WITH_CLEANUPS (except, cleanups);
1268
1269   gdb_assert (res_val != NULL);
1270   result = vlscm_scm_from_value (res_val);
1271
1272   do_cleanups (cleanups);
1273
1274   if (gdbscm_is_exception (result))
1275     gdbscm_throw (result);
1276
1277   return result;
1278 }
1279
1280 /* (history-ref integer) -> <gdb:value>
1281    Return the specified value from GDB's value history.  */
1282
1283 static SCM
1284 gdbscm_history_ref (SCM index)
1285 {
1286   int i;
1287   struct value *res_val = NULL; /* Initialize to appease gcc warning.  */
1288   volatile struct gdb_exception except;
1289
1290   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, NULL, "i", index, &i);
1291
1292   TRY_CATCH (except, RETURN_MASK_ALL)
1293     {
1294       res_val = access_value_history (i);
1295     }
1296   GDBSCM_HANDLE_GDB_EXCEPTION (except);
1297
1298   return vlscm_scm_from_value (res_val);
1299 }
1300 \f
1301 /* Initialize the Scheme value code.  */
1302
1303 static const scheme_function value_functions[] =
1304 {
1305   { "value?", 1, 0, 0, gdbscm_value_p,
1306     "\
1307 Return #t if the object is a <gdb:value> object." },
1308
1309   { "make-value", 1, 0, 1, gdbscm_make_value,
1310     "\
1311 Create a <gdb:value> representing object.\n\
1312 Typically this is used to convert numbers and strings to\n\
1313 <gdb:value> objects.\n\
1314 \n\
1315   Arguments: object [#:type <gdb:type>]" },
1316
1317   { "value-optimized-out?", 1, 0, 0, gdbscm_value_optimized_out_p,
1318     "\
1319 Return #t if the value has been optimizd out." },
1320
1321   { "value-address", 1, 0, 0, gdbscm_value_address,
1322     "\
1323 Return the address of the value." },
1324
1325   { "value-type", 1, 0, 0, gdbscm_value_type,
1326     "\
1327 Return the type of the value." },
1328
1329   { "value-dynamic-type", 1, 0, 0, gdbscm_value_dynamic_type,
1330     "\
1331 Return the dynamic type of the value." },
1332
1333   { "value-cast", 2, 0, 0, gdbscm_value_cast,
1334     "\
1335 Cast the value to the supplied type.\n\
1336 \n\
1337   Arguments: <gdb:value> <gdb:type>" },
1338
1339   { "value-dynamic-cast", 2, 0, 0, gdbscm_value_dynamic_cast,
1340     "\
1341 Cast the value to the supplied type, as if by the C++\n\
1342 dynamic_cast operator.\n\
1343 \n\
1344   Arguments: <gdb:value> <gdb:type>" },
1345
1346   { "value-reinterpret-cast", 2, 0, 0, gdbscm_value_reinterpret_cast,
1347     "\
1348 Cast the value to the supplied type, as if by the C++\n\
1349 reinterpret_cast operator.\n\
1350 \n\
1351   Arguments: <gdb:value> <gdb:type>" },
1352
1353   { "value-dereference", 1, 0, 0, gdbscm_value_dereference,
1354     "\
1355 Return the result of applying the C unary * operator to the value." },
1356
1357   { "value-referenced-value", 1, 0, 0, gdbscm_value_referenced_value,
1358     "\
1359 Given a value of a reference type, return the value referenced.\n\
1360 The difference between this function and value-dereference is that\n\
1361 the latter applies * unary operator to a value, which need not always\n\
1362 result in the value referenced.\n\
1363 For example, for a value which is a reference to an 'int' pointer ('int *'),\n\
1364 value-dereference will result in a value of type 'int' while\n\
1365 value-referenced-value will result in a value of type 'int *'." },
1366
1367   { "value-field", 2, 0, 0, gdbscm_value_field,
1368     "\
1369 Return the specified field of the value.\n\
1370 \n\
1371   Arguments: <gdb:value> string" },
1372
1373   { "value-subscript", 2, 0, 0, gdbscm_value_subscript,
1374     "\
1375 Return the value of the array at the specified index.\n\
1376 \n\
1377   Arguments: <gdb:value> integer" },
1378
1379   { "value-call", 2, 0, 0, gdbscm_value_call,
1380     "\
1381 Perform an inferior function call taking the value as a pointer to the\n\
1382 function to call.\n\
1383 Each element of the argument list must be a <gdb:value> object or an object\n\
1384 that can be converted to one.\n\
1385 The result is the value returned by the function.\n\
1386 \n\
1387   Arguments: <gdb:value> arg-list" },
1388
1389   { "value->bool", 1, 0, 0, gdbscm_value_to_bool,
1390     "\
1391 Return the Scheme boolean representing the GDB value.\n\
1392 The value must be \"integer like\".  Pointers are ok." },
1393
1394   { "value->integer", 1, 0, 0, gdbscm_value_to_integer,
1395     "\
1396 Return the Scheme integer representing the GDB value.\n\
1397 The value must be \"integer like\".  Pointers are ok." },
1398
1399   { "value->real", 1, 0, 0, gdbscm_value_to_real,
1400     "\
1401 Return the Scheme real number representing the GDB value.\n\
1402 The value must be a number." },
1403
1404   { "value->bytevector", 1, 0, 0, gdbscm_value_to_bytevector,
1405     "\
1406 Return a Scheme bytevector with the raw contents of the GDB value.\n\
1407 No transformation, endian or otherwise, is performed." },
1408
1409   { "value->string", 1, 0, 1, gdbscm_value_to_string,
1410     "\
1411 Return the Unicode string of the value's contents.\n\
1412 If ENCODING is not given, the string is assumed to be encoded in\n\
1413 the target's charset.\n\
1414 An error setting \"error\" causes an exception to be thrown if there's\n\
1415 a decoding error.  An error setting of \"substitute\" causes invalid\n\
1416 characters to be replaced with \"?\".  The default is \"error\".\n\
1417 If LENGTH is provided, only fetch string to the length provided.\n\
1418 \n\
1419   Arguments: <gdb:value>\n\
1420              [#:encoding encoding] [#:errors \"error\"|\"substitute\"]\n\
1421              [#:length length]" },
1422
1423   { "value->lazy-string", 1, 0, 1, gdbscm_value_to_lazy_string,
1424     "\
1425 Return a Scheme object representing a lazily fetched Unicode string\n\
1426 of the value's contents.\n\
1427 If ENCODING is not given, the string is assumed to be encoded in\n\
1428 the target's charset.\n\
1429 If LENGTH is provided, only fetch string to the length provided.\n\
1430 \n\
1431   Arguments: <gdb:value> [#:encoding encoding] [#:length length]" },
1432
1433   { "value-lazy?", 1, 0, 0, gdbscm_value_lazy_p,
1434     "\
1435 Return #t if the value is lazy (not fetched yet from the inferior).\n\
1436 A lazy value is fetched when needed, or when the value-fetch-lazy! function\n\
1437 is called." },
1438
1439   { "make-lazy-value", 2, 0, 0, gdbscm_make_lazy_value,
1440     "\
1441 Create a <gdb:value> that will be lazily fetched from the target.\n\
1442 \n\
1443   Arguments: <gdb:type> address" },
1444
1445   { "value-fetch-lazy!", 1, 0, 0, gdbscm_value_fetch_lazy_x,
1446     "\
1447 Fetch the value from the inferior, if it was lazy.\n\
1448 The result is \"unspecified\"." },
1449
1450   { "value-print", 1, 0, 0, gdbscm_value_print,
1451     "\
1452 Return the string representation (print form) of the value." },
1453
1454   { "parse-and-eval", 1, 0, 0, gdbscm_parse_and_eval,
1455     "\
1456 Evaluates string in gdb and returns the result as a <gdb:value> object." },
1457
1458   { "history-ref", 1, 0, 0, gdbscm_history_ref,
1459     "\
1460 Return the specified value from GDB's value history." },
1461
1462   END_FUNCTIONS
1463 };
1464
1465 void
1466 gdbscm_initialize_values (void)
1467 {
1468   value_smob_tag = gdbscm_make_smob_type (value_smob_name,
1469                                           sizeof (value_smob));
1470   scm_set_smob_mark (value_smob_tag, vlscm_mark_value_smob);
1471   scm_set_smob_free (value_smob_tag, vlscm_free_value_smob);
1472   scm_set_smob_print (value_smob_tag, vlscm_print_value_smob);
1473   scm_set_smob_equalp (value_smob_tag, vlscm_equal_p_value_smob);
1474
1475   gdbscm_define_functions (value_functions, 1);
1476
1477   type_keyword = scm_from_latin1_keyword ("type");
1478   encoding_keyword = scm_from_latin1_keyword ("encoding");
1479   errors_keyword = scm_from_latin1_keyword ("errors");
1480   length_keyword = scm_from_latin1_keyword ("length");
1481
1482   error_symbol = scm_from_latin1_symbol ("error");
1483   escape_symbol = scm_from_latin1_symbol ("escape");
1484   substitute_symbol = scm_from_latin1_symbol ("substitute");
1485 }