gdb/guile/scm-value.c

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