Subversion Repositories openrisc_2011-10-31

/* Scheme/Guile language support routines for GDB, the GNU debugger.

   Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2005, 2007, 2008

   Free Software Foundation, Inc.

   This file is part of GDB.

   This program is free software; you can redistribute it and/or modify

   it under the terms of the GNU General Public License as published by

   the Free Software Foundation; either version 3 of the License, or

   (at your option) any later version.

   This program is distributed in the hope that it will be useful,

   but WITHOUT ANY WARRANTY; without even the implied warranty of

   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License

   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */

#include "defs.h"

#include "symtab.h"

#include "gdbtypes.h"

#include "expression.h"

#include "parser-defs.h"

#include "language.h"

#include "value.h"

#include "scm-lang.h"

#include "valprint.h"

#include "gdbcore.h"

#include "c-lang.h"

#include "infcall.h"

static void scm_ipruk (char *, LONGEST, struct ui_file *);

static void scm_scmlist_print (LONGEST, struct ui_file *, int, int,

                               int, enum val_prettyprint);

static int scm_inferior_print (LONGEST, struct ui_file *, int, int,

                               int, enum val_prettyprint);

/* Prints the SCM value VALUE by invoking the inferior, if appropraite.

   Returns >= 0 on success;  return -1 if the inferior cannot/should not

   print VALUE. */

static int

scm_inferior_print (LONGEST value, struct ui_file *stream, int format,

                    int deref_ref, int recurse, enum val_prettyprint pretty)

{

  struct value *func, *arg, *result;

  struct symbol *gdb_output_sym, *gdb_output_len_sym;

  char *output;

  int ret, output_len;

  func = find_function_in_inferior ("gdb_print");

  arg = value_from_longest (builtin_type_CORE_ADDR, value);

  result = call_function_by_hand (func, 1, &arg);

  ret = (int) value_as_long (result);

  if (ret == 0)

    {

      /* XXX: Should we cache these symbols?  */

      gdb_output_sym =

        lookup_symbol_global ("gdb_output", NULL, NULL,

                              VAR_DOMAIN,

                              (struct symtab **) NULL);

      gdb_output_len_sym =

        lookup_symbol_global ("gdb_output_length", NULL, NULL,

                              VAR_DOMAIN,

                              (struct symtab **) NULL);

      if ((gdb_output_sym == NULL) || (gdb_output_len_sym == NULL))

        ret = -1;

      else

        {

          struct value *remote_buffer;

          read_memory (SYMBOL_VALUE_ADDRESS (gdb_output_len_sym),

                       (char *) &output_len, sizeof (output_len));

          output = (char *) alloca (output_len);

          remote_buffer = value_at (builtin_type_CORE_ADDR,

                                    SYMBOL_VALUE_ADDRESS (gdb_output_sym));

          read_memory (value_as_address (remote_buffer),

                       output, output_len);

          ui_file_write (stream, output, output_len);

        }

    }

  return ret;

}

/* {Names of immediate symbols}

 * This table must agree with the declarations in scm.h: {Immediate Symbols}.*/

static char *scm_isymnames[] =

{

  /* This table must agree with the declarations */

  "and",

  "begin",

  "case",

  "cond",

  "do",

  "if",

  "lambda",

  "let",

  "let*",

  "letrec",

  "or",

  "quote",

  "set!",

  "define",

#if 0

  "literal-variable-ref",

  "literal-variable-set!",

#endif

  "apply",

  "call-with-current-continuation",

 /* user visible ISYMS */

 /* other keywords */

 /* Flags */

  "#f",

  "#t",

  "#<undefined>",

  "#<eof>",

  "()",

  "#<unspecified>"

};

static void

scm_scmlist_print (LONGEST svalue, struct ui_file *stream, int format,

                   int deref_ref, int recurse, enum val_prettyprint pretty)

{

  unsigned int more = print_max;

  if (recurse > 6)

    {

      fputs_filtered ("...", stream);

      return;

    }

  scm_scmval_print (SCM_CAR (svalue), stream, format,

                    deref_ref, recurse + 1, pretty);

  svalue = SCM_CDR (svalue);

  for (; SCM_NIMP (svalue); svalue = SCM_CDR (svalue))

    {

      if (SCM_NECONSP (svalue))

        break;

      fputs_filtered (" ", stream);

      if (--more == 0)

        {

          fputs_filtered ("...", stream);

          return;

        }

      scm_scmval_print (SCM_CAR (svalue), stream, format,

                        deref_ref, recurse + 1, pretty);

    }

  if (SCM_NNULLP (svalue))

    {

      fputs_filtered (" . ", stream);

      scm_scmval_print (svalue, stream, format,

                        deref_ref, recurse + 1, pretty);

    }

}

static void

scm_ipruk (char *hdr, LONGEST ptr, struct ui_file *stream)

{

  fprintf_filtered (stream, "#<unknown-%s", hdr);

#define SCM_SIZE TYPE_LENGTH (builtin_type_scm)

  if (SCM_CELLP (ptr))

    fprintf_filtered (stream, " (0x%lx . 0x%lx) @",

                      (long) SCM_CAR (ptr), (long) SCM_CDR (ptr));

  fprintf_filtered (stream, " 0x%s>", paddr_nz (ptr));

}

void

scm_scmval_print (LONGEST svalue, struct ui_file *stream, int format,

                  int deref_ref, int recurse, enum val_prettyprint pretty)

{

taloop:

  switch (7 & (int) svalue)

    {

    case 2:

    case 6:

      print_longest (stream, format ? format : 'd', 1, svalue >> 2);

      break;

    case 4:

      if (SCM_ICHRP (svalue))

        {

          svalue = SCM_ICHR (svalue);

          scm_printchar (svalue, stream);

          break;

        }

      else if (SCM_IFLAGP (svalue)

               && (SCM_ISYMNUM (svalue)

                   < (sizeof scm_isymnames / sizeof (char *))))

        {

          fputs_filtered (SCM_ISYMCHARS (svalue), stream);

          break;

        }

      else if (SCM_ILOCP (svalue))

        {

          fprintf_filtered (stream, "#@%ld%c%ld",

                            (long) SCM_IFRAME (svalue),

                            SCM_ICDRP (svalue) ? '-' : '+',

                            (long) SCM_IDIST (svalue));

          break;

        }

      else

        goto idef;

      break;

    case 1:

      /* gloc */

      svalue = SCM_CAR (svalue - 1);

      goto taloop;

    default:

    idef:

      scm_ipruk ("immediate", svalue, stream);

      break;

    case 0:

      switch (SCM_TYP7 (svalue))

        {

        case scm_tcs_cons_gloc:

          if (SCM_CDR (SCM_CAR (svalue) - 1L) == 0)

            {

#if 0

              SCM name;

#endif

              fputs_filtered ("#<latte ", stream);

#if 1

              fputs_filtered ("???", stream);

#else

              name = ((SCM n *) (STRUCT_TYPE (exp)))[struct_i_name];

              scm_lfwrite (CHARS (name),

                           (sizet) sizeof (char),

                             (sizet) LENGTH (name),

                           port);

#endif

              fprintf_filtered (stream, " #X%s>", paddr_nz (svalue));

              break;

            }

        case scm_tcs_cons_imcar:

        case scm_tcs_cons_nimcar:

          fputs_filtered ("(", stream);

          scm_scmlist_print (svalue, stream, format,

                             deref_ref, recurse + 1, pretty);

          fputs_filtered (")", stream);

          break;

        case scm_tcs_closures:

          fputs_filtered ("#<CLOSURE ", stream);

          scm_scmlist_print (SCM_CODE (svalue), stream, format,

                             deref_ref, recurse + 1, pretty);

          fputs_filtered (">", stream);

          break;

        case scm_tc7_string:

          {

            int len = SCM_LENGTH (svalue);

            CORE_ADDR addr = (CORE_ADDR) SCM_CDR (svalue);

            int i;

            int done = 0;

            int buf_size;

            gdb_byte buffer[64];

            int truncate = print_max && len > (int) print_max;

            if (truncate)

              len = print_max;

            fputs_filtered ("\"", stream);

            for (; done < len; done += buf_size)

              {

                buf_size = min (len - done, 64);

                read_memory (addr + done, buffer, buf_size);

                for (i = 0; i < buf_size; ++i)

                  switch (buffer[i])

                    {

                    case '\"':

                    case '\\':

                      fputs_filtered ("\\", stream);

                    default:

                      fprintf_filtered (stream, "%c", buffer[i]);

                    }

              }

            fputs_filtered (truncate ? "...\"" : "\"", stream);

            break;

          }

          break;

        case scm_tcs_symbols:

          {

            int len = SCM_LENGTH (svalue);

            char *str = alloca (len);

            read_memory (SCM_CDR (svalue), (gdb_byte *) str, len + 1);

            /* Should handle weird characters FIXME */

            str[len] = '\0';

            fputs_filtered (str, stream);

            break;

          }

        case scm_tc7_vector:

          {

            int len = SCM_LENGTH (svalue);

            int i;

            LONGEST elements = SCM_CDR (svalue);

            fputs_filtered ("#(", stream);

            for (i = 0; i < len; ++i)

              {

                if (i > 0)

                  fputs_filtered (" ", stream);

                scm_scmval_print (scm_get_field (elements, i), stream, format,

                                  deref_ref, recurse + 1, pretty);

              }

            fputs_filtered (")", stream);

          }

          break;

#if 0

        case tc7_lvector:

          {

            SCM result;

            SCM hook;

            hook = scm_get_lvector_hook (exp, LV_PRINT_FN);

            if (hook == BOOL_F)

              {

                scm_puts ("#<locked-vector ", port);

                scm_intprint (CDR (exp), 16, port);

                scm_puts (">", port);

              }

            else

              {

                result

                  = scm_apply (hook,

                               scm_listify (exp, port,

                                            (writing ? BOOL_T : BOOL_F),

                                            SCM_UNDEFINED),

                               EOL);

                if (result == BOOL_F)

                  goto punk;

              }

            break;

          }

          break;

        case tc7_bvect:

        case tc7_ivect:

        case tc7_uvect:

        case tc7_fvect:

        case tc7_dvect:

        case tc7_cvect:

          scm_raprin1 (exp, port, writing);

          break;

#endif

        case scm_tcs_subrs:

          {

            int index = SCM_CAR (svalue) >> 8;

#if 1

            char str[20];

            sprintf (str, "#%d", index);

#else

            char *str = index ? SCM_CHARS (scm_heap_org + index) : "";

#define SCM_CHARS(x) ((char *)(SCM_CDR(x)))

            char *str = CHARS (SNAME (exp));

#endif

            fprintf_filtered (stream, "#<primitive-procedure %s>",

                              str);

          }

          break;

#if 0

#ifdef CCLO

        case tc7_cclo:

          scm_puts ("#<compiled-closure ", port);

          scm_iprin1 (CCLO_SUBR (exp), port, writing);

          scm_putc ('>', port);

          break;

#endif

        case tc7_contin:

          fprintf_filtered (stream, "#<continuation %d @ #X%lx >",

                            LENGTH (svalue),

                            (long) CHARS (svalue));

          break;

        case tc7_port:

          i = PTOBNUM (exp);

          if (i < scm_numptob

              && scm_ptobs[i].print

              && (scm_ptobs[i].print) (exp, port, writing))

            break;

          goto punk;

        case tc7_smob:

          i = SMOBNUM (exp);

          if (i < scm_numsmob && scm_smobs[i].print

              && (scm_smobs[i].print) (exp, port, writing))

            break;

          goto punk;

#endif

        default:

#if 0

        punk:

#endif

          scm_ipruk ("type", svalue, stream);

        }

      break;

    }

}

int

scm_val_print (struct type *type, const gdb_byte *valaddr,

               int embedded_offset, CORE_ADDR address,

               struct ui_file *stream, int format, int deref_ref,

               int recurse, enum val_prettyprint pretty)

{

  if (is_scmvalue_type (type))

    {

      LONGEST svalue = extract_signed_integer (valaddr, TYPE_LENGTH (type));

      if (scm_inferior_print (svalue, stream, format,

                              deref_ref, recurse, pretty) >= 0)

        {

        }

      else

        {

          scm_scmval_print (svalue, stream, format,

                            deref_ref, recurse, pretty);

        }

      gdb_flush (stream);

      return (0);

    }

  else

    {

      return c_val_print (type, valaddr, 0, address, stream, format,

                          deref_ref, recurse, pretty);

    }

}

int

scm_value_print (struct value *val, struct ui_file *stream, int format,

                 enum val_prettyprint pretty)

{

  return (common_val_print (val, stream, format, 1, 0, pretty));

}