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