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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [gdb-5.0/] [gdb/] [scm-valprint.c] - Blame information for rev 105

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

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

powered by: WebSVN 2.1.0

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