OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [gdb-5.0/] [gdb/] [scm-valprint.c] - Diff between revs 105 and 1765

Go to most recent revision | Only display areas with differences | Details | Blame | View Log

Rev 105 Rev 1765
/* Scheme/Guile language support routines for GDB, the GNU debugger.
/* Scheme/Guile language support routines for GDB, the GNU debugger.
   Copyright 1995, 2000 Free Software Foundation, Inc.
   Copyright 1995, 2000 Free Software Foundation, Inc.
 
 
   This file is part of GDB.
   This file is part of GDB.
 
 
   This program is free software; you can redistribute it and/or modify
   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
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2 of the License, or
   the Free Software Foundation; either version 2 of the License, or
   (at your option) any later version.
   (at your option) any later version.
 
 
   This program is distributed in the hope that it will be useful,
   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.
   GNU General Public License for more details.
 
 
   You should have received a copy of the GNU General Public License
   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   along with this program; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place - Suite 330,
   Foundation, Inc., 59 Temple Place - Suite 330,
   Boston, MA 02111-1307, USA.  */
   Boston, MA 02111-1307, USA.  */
 
 
#include "defs.h"
#include "defs.h"
#include "symtab.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "gdbtypes.h"
#include "expression.h"
#include "expression.h"
#include "parser-defs.h"
#include "parser-defs.h"
#include "language.h"
#include "language.h"
#include "value.h"
#include "value.h"
#include "scm-lang.h"
#include "scm-lang.h"
#include "valprint.h"
#include "valprint.h"
#include "gdbcore.h"
#include "gdbcore.h"
 
 
/* FIXME: Should be in a header file that we import. */
/* FIXME: Should be in a header file that we import. */
extern int c_val_print (struct type *, char *, int, CORE_ADDR,
extern int c_val_print (struct type *, char *, int, CORE_ADDR,
                        struct ui_file *, int, int, int,
                        struct ui_file *, int, int, int,
                        enum val_prettyprint);
                        enum val_prettyprint);
 
 
static void scm_ipruk (char *, LONGEST, struct ui_file *);
static void scm_ipruk (char *, LONGEST, struct ui_file *);
static void scm_scmlist_print (LONGEST, struct ui_file *, int, int,
static void scm_scmlist_print (LONGEST, struct ui_file *, int, int,
                               int, enum val_prettyprint);
                               int, enum val_prettyprint);
static int scm_inferior_print (LONGEST, struct ui_file *, int, int,
static int scm_inferior_print (LONGEST, struct ui_file *, int, int,
                               int, enum val_prettyprint);
                               int, enum val_prettyprint);
 
 
/* Prints the SCM value VALUE by invoking the inferior, if appropraite.
/* Prints the SCM value VALUE by invoking the inferior, if appropraite.
   Returns >= 0 on succes;  retunr -1 if the inferior cannot/should not
   Returns >= 0 on succes;  retunr -1 if the inferior cannot/should not
   print VALUE. */
   print VALUE. */
 
 
static int
static int
scm_inferior_print (value, stream, format, deref_ref, recurse, pretty)
scm_inferior_print (value, stream, format, deref_ref, recurse, pretty)
     LONGEST value;
     LONGEST value;
     struct ui_file *stream;
     struct ui_file *stream;
     int format;
     int format;
     int deref_ref;
     int deref_ref;
     int recurse;
     int recurse;
     enum val_prettyprint pretty;
     enum val_prettyprint pretty;
{
{
  return -1;
  return -1;
}
}
 
 
/* {Names of immediate symbols}
/* {Names of immediate symbols}
 * This table must agree with the declarations in scm.h: {Immediate Symbols}.*/
 * This table must agree with the declarations in scm.h: {Immediate Symbols}.*/
 
 
static char *scm_isymnames[] =
static char *scm_isymnames[] =
{
{
  /* This table must agree with the declarations */
  /* This table must agree with the declarations */
  "and",
  "and",
  "begin",
  "begin",
  "case",
  "case",
  "cond",
  "cond",
  "do",
  "do",
  "if",
  "if",
  "lambda",
  "lambda",
  "let",
  "let",
  "let*",
  "let*",
  "letrec",
  "letrec",
  "or",
  "or",
  "quote",
  "quote",
  "set!",
  "set!",
  "define",
  "define",
#if 0
#if 0
  "literal-variable-ref",
  "literal-variable-ref",
  "literal-variable-set!",
  "literal-variable-set!",
#endif
#endif
  "apply",
  "apply",
  "call-with-current-continuation",
  "call-with-current-continuation",
 
 
 /* user visible ISYMS */
 /* user visible ISYMS */
 /* other keywords */
 /* other keywords */
 /* Flags */
 /* Flags */
 
 
  "#f",
  "#f",
  "#t",
  "#t",
  "#<undefined>",
  "#<undefined>",
  "#<eof>",
  "#<eof>",
  "()",
  "()",
  "#<unspecified>"
  "#<unspecified>"
};
};
 
 
static void
static void
scm_scmlist_print (svalue, stream, format, deref_ref, recurse, pretty)
scm_scmlist_print (svalue, stream, format, deref_ref, recurse, pretty)
     LONGEST svalue;
     LONGEST svalue;
     struct ui_file *stream;
     struct ui_file *stream;
     int format;
     int format;
     int deref_ref;
     int deref_ref;
     int recurse;
     int recurse;
     enum val_prettyprint pretty;
     enum val_prettyprint pretty;
{
{
  unsigned int more = print_max;
  unsigned int more = print_max;
  if (recurse > 6)
  if (recurse > 6)
    {
    {
      fputs_filtered ("...", stream);
      fputs_filtered ("...", stream);
      return;
      return;
    }
    }
  scm_scmval_print (SCM_CAR (svalue), stream, format,
  scm_scmval_print (SCM_CAR (svalue), stream, format,
                    deref_ref, recurse + 1, pretty);
                    deref_ref, recurse + 1, pretty);
  svalue = SCM_CDR (svalue);
  svalue = SCM_CDR (svalue);
  for (; SCM_NIMP (svalue); svalue = SCM_CDR (svalue))
  for (; SCM_NIMP (svalue); svalue = SCM_CDR (svalue))
    {
    {
      if (SCM_NECONSP (svalue))
      if (SCM_NECONSP (svalue))
        break;
        break;
      fputs_filtered (" ", stream);
      fputs_filtered (" ", stream);
      if (--more == 0)
      if (--more == 0)
        {
        {
          fputs_filtered ("...", stream);
          fputs_filtered ("...", stream);
          return;
          return;
        }
        }
      scm_scmval_print (SCM_CAR (svalue), stream, format,
      scm_scmval_print (SCM_CAR (svalue), stream, format,
                        deref_ref, recurse + 1, pretty);
                        deref_ref, recurse + 1, pretty);
    }
    }
  if (SCM_NNULLP (svalue))
  if (SCM_NNULLP (svalue))
    {
    {
      fputs_filtered (" . ", stream);
      fputs_filtered (" . ", stream);
      scm_scmval_print (svalue, stream, format,
      scm_scmval_print (svalue, stream, format,
                        deref_ref, recurse + 1, pretty);
                        deref_ref, recurse + 1, pretty);
    }
    }
}
}
 
 
static void
static void
scm_ipruk (hdr, ptr, stream)
scm_ipruk (hdr, ptr, stream)
     char *hdr;
     char *hdr;
     LONGEST ptr;
     LONGEST ptr;
     struct ui_file *stream;
     struct ui_file *stream;
{
{
  fprintf_filtered (stream, "#<unknown-%s", hdr);
  fprintf_filtered (stream, "#<unknown-%s", hdr);
#define SCM_SIZE TYPE_LENGTH (builtin_type_scm)
#define SCM_SIZE TYPE_LENGTH (builtin_type_scm)
  if (SCM_CELLP (ptr))
  if (SCM_CELLP (ptr))
    fprintf_filtered (stream, " (0x%lx . 0x%lx) @",
    fprintf_filtered (stream, " (0x%lx . 0x%lx) @",
                      (long) SCM_CAR (ptr), (long) SCM_CDR (ptr));
                      (long) SCM_CAR (ptr), (long) SCM_CDR (ptr));
  fprintf_filtered (stream, " 0x%s>", paddr_nz (ptr));
  fprintf_filtered (stream, " 0x%s>", paddr_nz (ptr));
}
}
 
 
void
void
scm_scmval_print (svalue, stream, format, deref_ref, recurse, pretty)
scm_scmval_print (svalue, stream, format, deref_ref, recurse, pretty)
     LONGEST svalue;
     LONGEST svalue;
     struct ui_file *stream;
     struct ui_file *stream;
     int format;
     int format;
     int deref_ref;
     int deref_ref;
     int recurse;
     int recurse;
     enum val_prettyprint pretty;
     enum val_prettyprint pretty;
{
{
taloop:
taloop:
  switch (7 & (int) svalue)
  switch (7 & (int) svalue)
    {
    {
    case 2:
    case 2:
    case 6:
    case 6:
      print_longest (stream, format ? format : 'd', 1, svalue >> 2);
      print_longest (stream, format ? format : 'd', 1, svalue >> 2);
      break;
      break;
    case 4:
    case 4:
      if (SCM_ICHRP (svalue))
      if (SCM_ICHRP (svalue))
        {
        {
          svalue = SCM_ICHR (svalue);
          svalue = SCM_ICHR (svalue);
          scm_printchar (svalue, stream);
          scm_printchar (svalue, stream);
          break;
          break;
        }
        }
      else if (SCM_IFLAGP (svalue)
      else if (SCM_IFLAGP (svalue)
               && (SCM_ISYMNUM (svalue)
               && (SCM_ISYMNUM (svalue)
                   < (sizeof scm_isymnames / sizeof (char *))))
                   < (sizeof scm_isymnames / sizeof (char *))))
        {
        {
          fputs_filtered (SCM_ISYMCHARS (svalue), stream);
          fputs_filtered (SCM_ISYMCHARS (svalue), stream);
          break;
          break;
        }
        }
      else if (SCM_ILOCP (svalue))
      else if (SCM_ILOCP (svalue))
        {
        {
          fprintf_filtered (stream, "#@%ld%c%ld",
          fprintf_filtered (stream, "#@%ld%c%ld",
                            (long) SCM_IFRAME (svalue),
                            (long) SCM_IFRAME (svalue),
                            SCM_ICDRP (svalue) ? '-' : '+',
                            SCM_ICDRP (svalue) ? '-' : '+',
                            (long) SCM_IDIST (svalue));
                            (long) SCM_IDIST (svalue));
          break;
          break;
        }
        }
      else
      else
        goto idef;
        goto idef;
      break;
      break;
    case 1:
    case 1:
      /* gloc */
      /* gloc */
      svalue = SCM_CAR (svalue - 1);
      svalue = SCM_CAR (svalue - 1);
      goto taloop;
      goto taloop;
    default:
    default:
    idef:
    idef:
      scm_ipruk ("immediate", svalue, stream);
      scm_ipruk ("immediate", svalue, stream);
      break;
      break;
    case 0:
    case 0:
 
 
      switch (SCM_TYP7 (svalue))
      switch (SCM_TYP7 (svalue))
        {
        {
        case scm_tcs_cons_gloc:
        case scm_tcs_cons_gloc:
          if (SCM_CDR (SCM_CAR (svalue) - 1L) == 0)
          if (SCM_CDR (SCM_CAR (svalue) - 1L) == 0)
            {
            {
#if 0
#if 0
              SCM name;
              SCM name;
#endif
#endif
              fputs_filtered ("#<latte ", stream);
              fputs_filtered ("#<latte ", stream);
#if 1
#if 1
              fputs_filtered ("???", stream);
              fputs_filtered ("???", stream);
#else
#else
              name = ((SCM n *) (STRUCT_TYPE (exp)))[struct_i_name];
              name = ((SCM n *) (STRUCT_TYPE (exp)))[struct_i_name];
              scm_lfwrite (CHARS (name),
              scm_lfwrite (CHARS (name),
                           (sizet) sizeof (char),
                           (sizet) sizeof (char),
                             (sizet) LENGTH (name),
                             (sizet) LENGTH (name),
                           port);
                           port);
#endif
#endif
              fprintf_filtered (stream, " #X%s>", paddr_nz (svalue));
              fprintf_filtered (stream, " #X%s>", paddr_nz (svalue));
              break;
              break;
            }
            }
        case scm_tcs_cons_imcar:
        case scm_tcs_cons_imcar:
        case scm_tcs_cons_nimcar:
        case scm_tcs_cons_nimcar:
          fputs_filtered ("(", stream);
          fputs_filtered ("(", stream);
          scm_scmlist_print (svalue, stream, format,
          scm_scmlist_print (svalue, stream, format,
                             deref_ref, recurse + 1, pretty);
                             deref_ref, recurse + 1, pretty);
          fputs_filtered (")", stream);
          fputs_filtered (")", stream);
          break;
          break;
        case scm_tcs_closures:
        case scm_tcs_closures:
          fputs_filtered ("#<CLOSURE ", stream);
          fputs_filtered ("#<CLOSURE ", stream);
          scm_scmlist_print (SCM_CODE (svalue), stream, format,
          scm_scmlist_print (SCM_CODE (svalue), stream, format,
                             deref_ref, recurse + 1, pretty);
                             deref_ref, recurse + 1, pretty);
          fputs_filtered (">", stream);
          fputs_filtered (">", stream);
          break;
          break;
        case scm_tc7_string:
        case scm_tc7_string:
          {
          {
            int len = SCM_LENGTH (svalue);
            int len = SCM_LENGTH (svalue);
            CORE_ADDR addr = (CORE_ADDR) SCM_CDR (svalue);
            CORE_ADDR addr = (CORE_ADDR) SCM_CDR (svalue);
            int i;
            int i;
            int done = 0;
            int done = 0;
            int buf_size;
            int buf_size;
            char buffer[64];
            char buffer[64];
            int truncate = print_max && len > (int) print_max;
            int truncate = print_max && len > (int) print_max;
            if (truncate)
            if (truncate)
              len = print_max;
              len = print_max;
            fputs_filtered ("\"", stream);
            fputs_filtered ("\"", stream);
            for (; done < len; done += buf_size)
            for (; done < len; done += buf_size)
              {
              {
                buf_size = min (len - done, 64);
                buf_size = min (len - done, 64);
                read_memory (addr + done, buffer, buf_size);
                read_memory (addr + done, buffer, buf_size);
 
 
                for (i = 0; i < buf_size; ++i)
                for (i = 0; i < buf_size; ++i)
                  switch (buffer[i])
                  switch (buffer[i])
                    {
                    {
                    case '\"':
                    case '\"':
                    case '\\':
                    case '\\':
                      fputs_filtered ("\\", stream);
                      fputs_filtered ("\\", stream);
                    default:
                    default:
                      fprintf_filtered (stream, "%c", buffer[i]);
                      fprintf_filtered (stream, "%c", buffer[i]);
                    }
                    }
              }
              }
            fputs_filtered (truncate ? "...\"" : "\"", stream);
            fputs_filtered (truncate ? "...\"" : "\"", stream);
            break;
            break;
          }
          }
          break;
          break;
        case scm_tcs_symbols:
        case scm_tcs_symbols:
          {
          {
            int len = SCM_LENGTH (svalue);
            int len = SCM_LENGTH (svalue);
 
 
            char *str = (char *) alloca (len);
            char *str = (char *) alloca (len);
            read_memory (SCM_CDR (svalue), str, len + 1);
            read_memory (SCM_CDR (svalue), str, len + 1);
            /* Should handle weird characters FIXME */
            /* Should handle weird characters FIXME */
            str[len] = '\0';
            str[len] = '\0';
            fputs_filtered (str, stream);
            fputs_filtered (str, stream);
            break;
            break;
          }
          }
        case scm_tc7_vector:
        case scm_tc7_vector:
          {
          {
            int len = SCM_LENGTH (svalue);
            int len = SCM_LENGTH (svalue);
            int i;
            int i;
            LONGEST elements = SCM_CDR (svalue);
            LONGEST elements = SCM_CDR (svalue);
            fputs_filtered ("#(", stream);
            fputs_filtered ("#(", stream);
            for (i = 0; i < len; ++i)
            for (i = 0; i < len; ++i)
              {
              {
                if (i > 0)
                if (i > 0)
                  fputs_filtered (" ", stream);
                  fputs_filtered (" ", stream);
                scm_scmval_print (scm_get_field (elements, i), stream, format,
                scm_scmval_print (scm_get_field (elements, i), stream, format,
                                  deref_ref, recurse + 1, pretty);
                                  deref_ref, recurse + 1, pretty);
              }
              }
            fputs_filtered (")", stream);
            fputs_filtered (")", stream);
          }
          }
          break;
          break;
#if 0
#if 0
        case tc7_lvector:
        case tc7_lvector:
          {
          {
            SCM result;
            SCM result;
            SCM hook;
            SCM hook;
            hook = scm_get_lvector_hook (exp, LV_PRINT_FN);
            hook = scm_get_lvector_hook (exp, LV_PRINT_FN);
            if (hook == BOOL_F)
            if (hook == BOOL_F)
              {
              {
                scm_puts ("#<locked-vector ", port);
                scm_puts ("#<locked-vector ", port);
                scm_intprint (CDR (exp), 16, port);
                scm_intprint (CDR (exp), 16, port);
                scm_puts (">", port);
                scm_puts (">", port);
              }
              }
            else
            else
              {
              {
                result
                result
                  = scm_apply (hook,
                  = scm_apply (hook,
                        scm_listify (exp, port, (writing ? BOOL_T : BOOL_F),
                        scm_listify (exp, port, (writing ? BOOL_T : BOOL_F),
                                     SCM_UNDEFINED),
                                     SCM_UNDEFINED),
                               EOL);
                               EOL);
                if (result == BOOL_F)
                if (result == BOOL_F)
                  goto punk;
                  goto punk;
              }
              }
            break;
            break;
          }
          }
          break;
          break;
        case tc7_bvect:
        case tc7_bvect:
        case tc7_ivect:
        case tc7_ivect:
        case tc7_uvect:
        case tc7_uvect:
        case tc7_fvect:
        case tc7_fvect:
        case tc7_dvect:
        case tc7_dvect:
        case tc7_cvect:
        case tc7_cvect:
          scm_raprin1 (exp, port, writing);
          scm_raprin1 (exp, port, writing);
          break;
          break;
#endif
#endif
        case scm_tcs_subrs:
        case scm_tcs_subrs:
          {
          {
            int index = SCM_CAR (svalue) >> 8;
            int index = SCM_CAR (svalue) >> 8;
#if 1
#if 1
            char str[20];
            char str[20];
            sprintf (str, "#%d", index);
            sprintf (str, "#%d", index);
#else
#else
            char *str = index ? SCM_CHARS (scm_heap_org + index) : "";
            char *str = index ? SCM_CHARS (scm_heap_org + index) : "";
#define SCM_CHARS(x) ((char *)(SCM_CDR(x)))
#define SCM_CHARS(x) ((char *)(SCM_CDR(x)))
            char *str = CHARS (SNAME (exp));
            char *str = CHARS (SNAME (exp));
#endif
#endif
            fprintf_filtered (stream, "#<primitive-procedure %s>",
            fprintf_filtered (stream, "#<primitive-procedure %s>",
                              str);
                              str);
          }
          }
          break;
          break;
#if 0
#if 0
#ifdef CCLO
#ifdef CCLO
        case tc7_cclo:
        case tc7_cclo:
          scm_puts ("#<compiled-closure ", port);
          scm_puts ("#<compiled-closure ", port);
          scm_iprin1 (CCLO_SUBR (exp), port, writing);
          scm_iprin1 (CCLO_SUBR (exp), port, writing);
          scm_putc ('>', port);
          scm_putc ('>', port);
          break;
          break;
#endif
#endif
        case tc7_contin:
        case tc7_contin:
          fprintf_filtered (stream, "#<continuation %d @ #X%lx >",
          fprintf_filtered (stream, "#<continuation %d @ #X%lx >",
                            LENGTH (svalue),
                            LENGTH (svalue),
                            (long) CHARS (svalue));
                            (long) CHARS (svalue));
          break;
          break;
        case tc7_port:
        case tc7_port:
          i = PTOBNUM (exp);
          i = PTOBNUM (exp);
          if (i < scm_numptob && scm_ptobs[i].print && (scm_ptobs[i].print) (exp, port, writing))
          if (i < scm_numptob && scm_ptobs[i].print && (scm_ptobs[i].print) (exp, port, writing))
            break;
            break;
          goto punk;
          goto punk;
        case tc7_smob:
        case tc7_smob:
          i = SMOBNUM (exp);
          i = SMOBNUM (exp);
          if (i < scm_numsmob && scm_smobs[i].print
          if (i < scm_numsmob && scm_smobs[i].print
              && (scm_smobs[i].print) (exp, port, writing))
              && (scm_smobs[i].print) (exp, port, writing))
            break;
            break;
          goto punk;
          goto punk;
#endif
#endif
        default:
        default:
#if 0
#if 0
        punk:
        punk:
#endif
#endif
          scm_ipruk ("type", svalue, stream);
          scm_ipruk ("type", svalue, stream);
        }
        }
      break;
      break;
    }
    }
}
}
 
 
int
int
scm_val_print (type, valaddr, embedded_offset, address,
scm_val_print (type, valaddr, embedded_offset, address,
               stream, format, deref_ref, recurse, pretty)
               stream, format, deref_ref, recurse, pretty)
     struct type *type;
     struct type *type;
     char *valaddr;
     char *valaddr;
     int embedded_offset;
     int embedded_offset;
     CORE_ADDR address;
     CORE_ADDR address;
     struct ui_file *stream;
     struct ui_file *stream;
     int format;
     int format;
     int deref_ref;
     int deref_ref;
     int recurse;
     int recurse;
     enum val_prettyprint pretty;
     enum val_prettyprint pretty;
{
{
  if (is_scmvalue_type (type))
  if (is_scmvalue_type (type))
    {
    {
      LONGEST svalue = extract_signed_integer (valaddr, TYPE_LENGTH (type));
      LONGEST svalue = extract_signed_integer (valaddr, TYPE_LENGTH (type));
      if (scm_inferior_print (svalue, stream, format,
      if (scm_inferior_print (svalue, stream, format,
                              deref_ref, recurse, pretty) >= 0)
                              deref_ref, recurse, pretty) >= 0)
        {
        {
        }
        }
      else
      else
        {
        {
          scm_scmval_print (svalue, stream, format,
          scm_scmval_print (svalue, stream, format,
                            deref_ref, recurse, pretty);
                            deref_ref, recurse, pretty);
        }
        }
 
 
      gdb_flush (stream);
      gdb_flush (stream);
      return (0);
      return (0);
    }
    }
  else
  else
    {
    {
      return c_val_print (type, valaddr, 0, address, stream, format,
      return c_val_print (type, valaddr, 0, address, stream, format,
                          deref_ref, recurse, pretty);
                          deref_ref, recurse, pretty);
    }
    }
}
}
 
 
int
int
scm_value_print (val, stream, format, pretty)
scm_value_print (val, stream, format, pretty)
     value_ptr val;
     value_ptr val;
     struct ui_file *stream;
     struct ui_file *stream;
     int format;
     int format;
     enum val_prettyprint pretty;
     enum val_prettyprint pretty;
{
{
  return (val_print (VALUE_TYPE (val), VALUE_CONTENTS (val), 0,
  return (val_print (VALUE_TYPE (val), VALUE_CONTENTS (val), 0,
                     VALUE_ADDRESS (val), stream, format, 1, 0, pretty));
                     VALUE_ADDRESS (val), stream, format, 1, 0, pretty));
}
}
 
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.