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