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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gdb-6.8/] [gdb/] [scm-valprint.c] - Blame information for rev 247

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 24 jeremybenn
/* Scheme/Guile language support routines for GDB, the GNU debugger.
2
 
3
   Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2005, 2007, 2008
4
   Free Software Foundation, Inc.
5
 
6
   This file is part of GDB.
7
 
8
   This program is free software; you can redistribute it and/or modify
9
   it under the terms of the GNU General Public License as published by
10
   the Free Software Foundation; either version 3 of the License, or
11
   (at your option) any later version.
12
 
13
   This program is distributed in the hope that it will be useful,
14
   but WITHOUT ANY WARRANTY; without even the implied warranty of
15
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16
   GNU General Public License for more details.
17
 
18
   You should have received a copy of the GNU General Public License
19
   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
20
 
21
#include "defs.h"
22
#include "symtab.h"
23
#include "gdbtypes.h"
24
#include "expression.h"
25
#include "parser-defs.h"
26
#include "language.h"
27
#include "value.h"
28
#include "scm-lang.h"
29
#include "valprint.h"
30
#include "gdbcore.h"
31
#include "c-lang.h"
32
#include "infcall.h"
33
 
34
static void scm_ipruk (char *, LONGEST, struct ui_file *);
35
static void scm_scmlist_print (LONGEST, struct ui_file *, int, int,
36
                               int, enum val_prettyprint);
37
static int scm_inferior_print (LONGEST, struct ui_file *, int, int,
38
                               int, enum val_prettyprint);
39
 
40
/* Prints the SCM value VALUE by invoking the inferior, if appropraite.
41
   Returns >= 0 on success;  return -1 if the inferior cannot/should not
42
   print VALUE. */
43
 
44
static int
45
scm_inferior_print (LONGEST value, struct ui_file *stream, int format,
46
                    int deref_ref, int recurse, enum val_prettyprint pretty)
47
{
48
  struct value *func, *arg, *result;
49
  struct symbol *gdb_output_sym, *gdb_output_len_sym;
50
  char *output;
51
  int ret, output_len;
52
 
53
  func = find_function_in_inferior ("gdb_print");
54
  arg = value_from_longest (builtin_type_CORE_ADDR, value);
55
 
56
  result = call_function_by_hand (func, 1, &arg);
57
  ret = (int) value_as_long (result);
58
  if (ret == 0)
59
    {
60
      /* XXX: Should we cache these symbols?  */
61
      gdb_output_sym =
62
        lookup_symbol_global ("gdb_output", NULL, NULL,
63
                              VAR_DOMAIN,
64
                              (struct symtab **) NULL);
65
      gdb_output_len_sym =
66
        lookup_symbol_global ("gdb_output_length", NULL, NULL,
67
                              VAR_DOMAIN,
68
                              (struct symtab **) NULL);
69
 
70
      if ((gdb_output_sym == NULL) || (gdb_output_len_sym == NULL))
71
        ret = -1;
72
      else
73
        {
74
          struct value *remote_buffer;
75
 
76
          read_memory (SYMBOL_VALUE_ADDRESS (gdb_output_len_sym),
77
                       (char *) &output_len, sizeof (output_len));
78
 
79
          output = (char *) alloca (output_len);
80
          remote_buffer = value_at (builtin_type_CORE_ADDR,
81
                                    SYMBOL_VALUE_ADDRESS (gdb_output_sym));
82
          read_memory (value_as_address (remote_buffer),
83
                       output, output_len);
84
 
85
          ui_file_write (stream, output, output_len);
86
        }
87
    }
88
 
89
  return ret;
90
}
91
 
92
/* {Names of immediate symbols}
93
 * This table must agree with the declarations in scm.h: {Immediate Symbols}.*/
94
 
95
static char *scm_isymnames[] =
96
{
97
  /* This table must agree with the declarations */
98
  "and",
99
  "begin",
100
  "case",
101
  "cond",
102
  "do",
103
  "if",
104
  "lambda",
105
  "let",
106
  "let*",
107
  "letrec",
108
  "or",
109
  "quote",
110
  "set!",
111
  "define",
112
#if 0
113
  "literal-variable-ref",
114
  "literal-variable-set!",
115
#endif
116
  "apply",
117
  "call-with-current-continuation",
118
 
119
 /* user visible ISYMS */
120
 /* other keywords */
121
 /* Flags */
122
 
123
  "#f",
124
  "#t",
125
  "#<undefined>",
126
  "#<eof>",
127
  "()",
128
  "#<unspecified>"
129
};
130
 
131
static void
132
scm_scmlist_print (LONGEST svalue, struct ui_file *stream, int format,
133
                   int deref_ref, int recurse, enum val_prettyprint pretty)
134
{
135
  unsigned int more = print_max;
136
  if (recurse > 6)
137
    {
138
      fputs_filtered ("...", stream);
139
      return;
140
    }
141
  scm_scmval_print (SCM_CAR (svalue), stream, format,
142
                    deref_ref, recurse + 1, pretty);
143
  svalue = SCM_CDR (svalue);
144
  for (; SCM_NIMP (svalue); svalue = SCM_CDR (svalue))
145
    {
146
      if (SCM_NECONSP (svalue))
147
        break;
148
      fputs_filtered (" ", stream);
149
      if (--more == 0)
150
        {
151
          fputs_filtered ("...", stream);
152
          return;
153
        }
154
      scm_scmval_print (SCM_CAR (svalue), stream, format,
155
                        deref_ref, recurse + 1, pretty);
156
    }
157
  if (SCM_NNULLP (svalue))
158
    {
159
      fputs_filtered (" . ", stream);
160
      scm_scmval_print (svalue, stream, format,
161
                        deref_ref, recurse + 1, pretty);
162
    }
163
}
164
 
165
static void
166
scm_ipruk (char *hdr, LONGEST ptr, struct ui_file *stream)
167
{
168
  fprintf_filtered (stream, "#<unknown-%s", hdr);
169
#define SCM_SIZE TYPE_LENGTH (builtin_type_scm)
170
  if (SCM_CELLP (ptr))
171
    fprintf_filtered (stream, " (0x%lx . 0x%lx) @",
172
                      (long) SCM_CAR (ptr), (long) SCM_CDR (ptr));
173
  fprintf_filtered (stream, " 0x%s>", paddr_nz (ptr));
174
}
175
 
176
void
177
scm_scmval_print (LONGEST svalue, struct ui_file *stream, int format,
178
                  int deref_ref, int recurse, enum val_prettyprint pretty)
179
{
180
taloop:
181
  switch (7 & (int) svalue)
182
    {
183
    case 2:
184
    case 6:
185
      print_longest (stream, format ? format : 'd', 1, svalue >> 2);
186
      break;
187
    case 4:
188
      if (SCM_ICHRP (svalue))
189
        {
190
          svalue = SCM_ICHR (svalue);
191
          scm_printchar (svalue, stream);
192
          break;
193
        }
194
      else if (SCM_IFLAGP (svalue)
195
               && (SCM_ISYMNUM (svalue)
196
                   < (sizeof scm_isymnames / sizeof (char *))))
197
        {
198
          fputs_filtered (SCM_ISYMCHARS (svalue), stream);
199
          break;
200
        }
201
      else if (SCM_ILOCP (svalue))
202
        {
203
          fprintf_filtered (stream, "#@%ld%c%ld",
204
                            (long) SCM_IFRAME (svalue),
205
                            SCM_ICDRP (svalue) ? '-' : '+',
206
                            (long) SCM_IDIST (svalue));
207
          break;
208
        }
209
      else
210
        goto idef;
211
      break;
212
    case 1:
213
      /* gloc */
214
      svalue = SCM_CAR (svalue - 1);
215
      goto taloop;
216
    default:
217
    idef:
218
      scm_ipruk ("immediate", svalue, stream);
219
      break;
220
    case 0:
221
 
222
      switch (SCM_TYP7 (svalue))
223
        {
224
        case scm_tcs_cons_gloc:
225
          if (SCM_CDR (SCM_CAR (svalue) - 1L) == 0)
226
            {
227
#if 0
228
              SCM name;
229
#endif
230
              fputs_filtered ("#<latte ", stream);
231
#if 1
232
              fputs_filtered ("???", stream);
233
#else
234
              name = ((SCM n *) (STRUCT_TYPE (exp)))[struct_i_name];
235
              scm_lfwrite (CHARS (name),
236
                           (sizet) sizeof (char),
237
                             (sizet) LENGTH (name),
238
                           port);
239
#endif
240
              fprintf_filtered (stream, " #X%s>", paddr_nz (svalue));
241
              break;
242
            }
243
        case scm_tcs_cons_imcar:
244
        case scm_tcs_cons_nimcar:
245
          fputs_filtered ("(", stream);
246
          scm_scmlist_print (svalue, stream, format,
247
                             deref_ref, recurse + 1, pretty);
248
          fputs_filtered (")", stream);
249
          break;
250
        case scm_tcs_closures:
251
          fputs_filtered ("#<CLOSURE ", stream);
252
          scm_scmlist_print (SCM_CODE (svalue), stream, format,
253
                             deref_ref, recurse + 1, pretty);
254
          fputs_filtered (">", stream);
255
          break;
256
        case scm_tc7_string:
257
          {
258
            int len = SCM_LENGTH (svalue);
259
            CORE_ADDR addr = (CORE_ADDR) SCM_CDR (svalue);
260
            int i;
261
            int done = 0;
262
            int buf_size;
263
            gdb_byte buffer[64];
264
            int truncate = print_max && len > (int) print_max;
265
            if (truncate)
266
              len = print_max;
267
            fputs_filtered ("\"", stream);
268
            for (; done < len; done += buf_size)
269
              {
270
                buf_size = min (len - done, 64);
271
                read_memory (addr + done, buffer, buf_size);
272
 
273
                for (i = 0; i < buf_size; ++i)
274
                  switch (buffer[i])
275
                    {
276
                    case '\"':
277
                    case '\\':
278
                      fputs_filtered ("\\", stream);
279
                    default:
280
                      fprintf_filtered (stream, "%c", buffer[i]);
281
                    }
282
              }
283
            fputs_filtered (truncate ? "...\"" : "\"", stream);
284
            break;
285
          }
286
          break;
287
        case scm_tcs_symbols:
288
          {
289
            int len = SCM_LENGTH (svalue);
290
 
291
            char *str = alloca (len);
292
            read_memory (SCM_CDR (svalue), (gdb_byte *) str, len + 1);
293
            /* Should handle weird characters FIXME */
294
            str[len] = '\0';
295
            fputs_filtered (str, stream);
296
            break;
297
          }
298
        case scm_tc7_vector:
299
          {
300
            int len = SCM_LENGTH (svalue);
301
            int i;
302
            LONGEST elements = SCM_CDR (svalue);
303
            fputs_filtered ("#(", stream);
304
            for (i = 0; i < len; ++i)
305
              {
306
                if (i > 0)
307
                  fputs_filtered (" ", stream);
308
                scm_scmval_print (scm_get_field (elements, i), stream, format,
309
                                  deref_ref, recurse + 1, pretty);
310
              }
311
            fputs_filtered (")", stream);
312
          }
313
          break;
314
#if 0
315
        case tc7_lvector:
316
          {
317
            SCM result;
318
            SCM hook;
319
            hook = scm_get_lvector_hook (exp, LV_PRINT_FN);
320
            if (hook == BOOL_F)
321
              {
322
                scm_puts ("#<locked-vector ", port);
323
                scm_intprint (CDR (exp), 16, port);
324
                scm_puts (">", port);
325
              }
326
            else
327
              {
328
                result
329
                  = scm_apply (hook,
330
                               scm_listify (exp, port,
331
                                            (writing ? BOOL_T : BOOL_F),
332
                                            SCM_UNDEFINED),
333
                               EOL);
334
                if (result == BOOL_F)
335
                  goto punk;
336
              }
337
            break;
338
          }
339
          break;
340
        case tc7_bvect:
341
        case tc7_ivect:
342
        case tc7_uvect:
343
        case tc7_fvect:
344
        case tc7_dvect:
345
        case tc7_cvect:
346
          scm_raprin1 (exp, port, writing);
347
          break;
348
#endif
349
        case scm_tcs_subrs:
350
          {
351
            int index = SCM_CAR (svalue) >> 8;
352
#if 1
353
            char str[20];
354
            sprintf (str, "#%d", index);
355
#else
356
            char *str = index ? SCM_CHARS (scm_heap_org + index) : "";
357
#define SCM_CHARS(x) ((char *)(SCM_CDR(x)))
358
            char *str = CHARS (SNAME (exp));
359
#endif
360
            fprintf_filtered (stream, "#<primitive-procedure %s>",
361
                              str);
362
          }
363
          break;
364
#if 0
365
#ifdef CCLO
366
        case tc7_cclo:
367
          scm_puts ("#<compiled-closure ", port);
368
          scm_iprin1 (CCLO_SUBR (exp), port, writing);
369
          scm_putc ('>', port);
370
          break;
371
#endif
372
        case tc7_contin:
373
          fprintf_filtered (stream, "#<continuation %d @ #X%lx >",
374
                            LENGTH (svalue),
375
                            (long) CHARS (svalue));
376
          break;
377
        case tc7_port:
378
          i = PTOBNUM (exp);
379
          if (i < scm_numptob
380
              && scm_ptobs[i].print
381
              && (scm_ptobs[i].print) (exp, port, writing))
382
            break;
383
          goto punk;
384
        case tc7_smob:
385
          i = SMOBNUM (exp);
386
          if (i < scm_numsmob && scm_smobs[i].print
387
              && (scm_smobs[i].print) (exp, port, writing))
388
            break;
389
          goto punk;
390
#endif
391
        default:
392
#if 0
393
        punk:
394
#endif
395
          scm_ipruk ("type", svalue, stream);
396
        }
397
      break;
398
    }
399
}
400
 
401
int
402
scm_val_print (struct type *type, const gdb_byte *valaddr,
403
               int embedded_offset, CORE_ADDR address,
404
               struct ui_file *stream, int format, int deref_ref,
405
               int recurse, enum val_prettyprint pretty)
406
{
407
  if (is_scmvalue_type (type))
408
    {
409
      LONGEST svalue = extract_signed_integer (valaddr, TYPE_LENGTH (type));
410
 
411
      if (scm_inferior_print (svalue, stream, format,
412
                              deref_ref, recurse, pretty) >= 0)
413
        {
414
        }
415
      else
416
        {
417
          scm_scmval_print (svalue, stream, format,
418
                            deref_ref, recurse, pretty);
419
        }
420
 
421
      gdb_flush (stream);
422
      return (0);
423
    }
424
  else
425
    {
426
      return c_val_print (type, valaddr, 0, address, stream, format,
427
                          deref_ref, recurse, pretty);
428
    }
429
}
430
 
431
int
432
scm_value_print (struct value *val, struct ui_file *stream, int format,
433
                 enum val_prettyprint pretty)
434
{
435
  return (common_val_print (val, stream, format, 1, 0, pretty));
436
}

powered by: WebSVN 2.1.0

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