common-lisp.net / projects/cmucl/cmucl.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Clean up RCS ids
[projects/cmucl/cmucl.git] / src / lisp / print.c
CommitLineData
eeab7066
RT		 1/*
2
3 This code was written as part of the CMU Common Lisp project at
4 Carnegie Mellon University, and has been placed in the public domain.
5
6*/
62957726 7
34b793ce 8#include <stdio.h>
9#include <string.h>
1dbce14c 10#include <stdint.h>
62957726 11#include "print.h"
12#include "lisp.h"
13#include "internals.h"
14#include "monitor.h"
15#include "vars.h"
16#include "os.h"
17
18static int max_lines = 20, cur_lines = 0;
19static int max_depth = 5, brief_depth = 2, cur_depth = 0;
20static int max_length = 5;
21static boolean dont_decend = FALSE, skip_newline = FALSE;
371167e2 22static int cur_clock = 0;
62957726 23
24static void print_obj(char *prefix, lispobj obj);
25
26#define NEWLINE if (continue_p(TRUE)) newline(NULL); else return;
27
28char *lowtag_Names[] = {
29 "even fixnum",
30 "function pointer",
31 "other immediate [0]",
32 "list pointer",
33 "odd fixnum",
15602773 34 "instance pointer",
62957726 35 "other immediate [1]",
36 "other pointer"
37};
38
39char *subtype_Names[] = {
40 "unused 0",
41 "unused 1",
42 "bignum",
43 "ratio",
44 "single float",
45 "double float",
8de15dca 46#ifdef type_LongFloat
47 "long float",
48#endif
3a0053bb 49#ifdef type_DoubleDoubleFloat
50 "double-double float",
51#endif
62957726 52 "complex",
a5e333d2 53#ifdef type_ComplexSingleFloat
54 "complex single float",
55#endif
56#ifdef type_ComplexDoubleFloat
57 "complex double float",
58#endif
8de15dca 59#ifdef type_ComplexLongFloat
60 "complex long float",
61#endif
3a0053bb 62#ifdef type_ComplexDoubleDoubleFloat
63 "complex double-double float",
64#endif
62957726 65 "simple-array",
66 "simple-string",
67 "simple-bit-vector",
68 "simple-vector",
69 "(simple-array (unsigned-byte 2) (*))",
70 "(simple-array (unsigned-byte 4) (*))",
71 "(simple-array (unsigned-byte 8) (*))",
72 "(simple-array (unsigned-byte 16) (*))",
73 "(simple-array (unsigned-byte 32) (*))",
a5e333d2 74#ifdef type_SimpleArraySignedByte8
75 "(simple-array (signed-byte 8) (*))",
76#endif
77#ifdef type_SimpleArraySignedByte16
78 "(simple-array (signed-byte 16) (*))",
79#endif
80#ifdef type_SimpleArraySignedByte30
81 "(simple-array fixnum (*))",
82#endif
83#ifdef type_SimpleArraySignedByte32
84 "(simple-array (signed-byte 32) (*))",
85#endif
62957726 86 "(simple-array single-float (*))",
87 "(simple-array double-float (*))",
8de15dca 88#ifdef type_SimpleArrayLongFloat
89 "(simple-array long-float (*))",
90#endif
3a0053bb 91#ifdef type_SimpleArrayDoubleDoubleFloat
92 "(simple-array double-double-float (*))",
93#endif
a5e333d2 94#ifdef type_SimpleArrayComplexSingleFloat
95 "(simple-array (complex single-float) (*))",
96#endif
97#ifdef type_SimpleArrayComplexDoubleFloat
98 "(simple-array (complex double-float) (*))",
99#endif
8de15dca 100#ifdef type_SimpleArrayComplexLongFloat
101 "(simple-array (complex long-float) (*))",
102#endif
3a0053bb 103#ifdef type_SimpleArrayComplexDoubleDoubleFloat
104 "(simple-array (complex double-double-float) (*))",
105#endif
62957726 106 "complex-string",
107 "complex-bit-vector",
108 "(array * (*))",
109 "array",
110 "code header",
111 "function header",
112 "closure header",
113 "funcallable-instance header",
8932f44e 114 "byte code function",
115 "byte code closure",
116/* "unused function header 3",*/
62957726 117 "closure function header",
118 "return PC header",
119 "value cell header",
120 "symbol header",
121 "character",
122 "SAP",
123 "unbound marker",
124 "weak pointer",
15602773 125 "instance header",
62957726 126 "fdefn"
a5e333d2 127#ifdef type_ScavengerHook
9a8c1c2f 128 , "scavenger hook"
a5e333d2 129#endif
62957726 130};
131
9a8c1c2f 132static void
133indent(int in)
62957726 134{
9a8c1c2f 135 static char *spaces =
136
137 " ";
62957726 138
139 while (in > 64) {
9a8c1c2f 140 fputs(spaces, stdout);
141 in -= 64;
62957726 142 }
143 if (in != 0)
9a8c1c2f 144 fputs(spaces + 64 - in, stdout);
62957726 145}
146
9a8c1c2f 147static boolean
148continue_p(boolean newline)
62957726 149{
150 char buffer[256];
151
152 if (cur_depth >= max_depth || dont_decend)
9a8c1c2f 153 return FALSE;
62957726 154
155 if (newline) {
9a8c1c2f 156 if (skip_newline)
157 skip_newline = FALSE;
158 else
159 putchar('\n');
160
161 if (cur_lines >= max_lines) {
9f4256ad 162 char *result;
9a8c1c2f 163 printf("More? [y] ");
164 fflush(stdout);
165
9f4256ad 166 result = fgets(buffer, sizeof(buffer), stdin);
9a8c1c2f 167
9f4256ad 168 if (result == NULL || buffer[0] == 'n' || buffer[0] == 'N')
9a8c1c2f 169 throw_to_monitor();
170 else
171 cur_lines = 0;
172 }
62957726 173 }
174
175 return TRUE;
176}
177
9a8c1c2f 178static void
179newline(char *label)
62957726 180{
181 cur_lines++;
182 if (label != NULL)
9a8c1c2f 183 fputs(label, stdout);
62957726 184 putchar('\t');
185 indent(cur_depth * 2);
186}
187
188
9a8c1c2f 189static void
190brief_fixnum(lispobj obj)
62957726 191{
6f4a04e5 192#ifndef alpha
9a8c1c2f 193 printf("%ld", ((long) obj) >> 2);
6f4a04e5 194#else
9a8c1c2f 195 printf("%d", ((s32) obj) >> 2);
6f4a04e5 196#endif
62957726 197}
198
9a8c1c2f 199static void
200print_fixnum(lispobj obj)
62957726 201{
6f4a04e5 202#ifndef alpha
9a8c1c2f 203 printf(": %ld", ((long) obj) >> 2);
6f4a04e5 204#else
9a8c1c2f 205 printf(": %d", ((s32) obj) >> 2);
6f4a04e5 206#endif
62957726 207}
208
9a8c1c2f 209static void
210brief_otherimm(lispobj obj)
62957726 211{
212 int type, c, idx;
213 char buffer[10];
214
215 type = TypeOf(obj);
216 switch (type) {
9a8c1c2f 217 case type_BaseChar:
218 c = (obj >> 8) & 0xff;
219 switch (c) {
220 case '\0':
221 printf("#\\Null");
222 break;
223 case '\n':
224 printf("#\\Newline");
225 break;
226 case '\b':
227 printf("#\\Backspace");
228 break;
229 case '\177':
230 printf("#\\Delete");
231 break;
232 default:
233 strcpy(buffer, "#\\");
234 if (c >= 128) {
235 strcat(buffer, "m-");
236 c -= 128;
237 }
238 if (c < 32) {
239 strcat(buffer, "c-");
240 c += '@';
241 }
242 printf("%s%c", buffer, c);
243 break;
244 }
245 break;
246
247 case type_UnboundMarker:
248 printf("<unbound marker>");
249 break;
250
251 default:
252 idx = type >> 2;
253 if (idx < (sizeof(subtype_Names) / sizeof(char *)))
254 printf("%s", subtype_Names[idx]);
255
256 else
257 printf("unknown type (0x%0x)", type);
258 break;
62957726 259 }
260}
261
9a8c1c2f 262static void
263print_otherimm(lispobj obj)
62957726 264{
265 int type, idx;
266
267 type = TypeOf(obj);
268 idx = type >> 2;
269
270 if (idx < (sizeof(subtype_Names) / sizeof(char *)))
9a8c1c2f 271 printf(", %s", subtype_Names[idx]);
272
62957726 273 else
9a8c1c2f 274 printf(", unknown type (0x%0x)", type);
62957726 275
276 switch (TypeOf(obj)) {
9a8c1c2f 277 case type_BaseChar:
278 printf(": ");
279 brief_otherimm(obj);
280 break;
281
282 case type_Sap:
283 case type_UnboundMarker:
284 break;
285
286 default:
287 printf(": data=%ld", (obj >> 8) & 0xffffff);
288 break;
62957726 289 }
290}
291
9a8c1c2f 292static void
293brief_list(lispobj obj)
62957726 294{
295 int space = FALSE;
296 int length = 0;
297
9a8c1c2f 298 if (!valid_addr((os_vm_address_t) obj))
299 printf("(invalid address)");
62957726 300 else if (obj == NIL)
9a8c1c2f 301 printf("NIL");
62957726 302 else {
9a8c1c2f 303 putchar('(');
304 while (LowtagOf(obj) == type_ListPointer) {
305 struct cons *cons = (struct cons *) PTR(obj);
306
307 if (space)
308 putchar(' ');
309 if (++length >= max_length) {
310 printf("...");
311 obj = NIL;
312 break;
313 }
314 print_obj(NULL, cons->car);
315 obj = cons->cdr;
316 space = TRUE;
317 if (obj == NIL)
318 break;
319 }
320 if (obj != NIL) {
321 printf(" . ");
322 print_obj(NULL, obj);
323 }
324 putchar(')');
62957726 325 }
326}
327
9a8c1c2f 328static void
329print_list(lispobj obj)
62957726 330{
9a8c1c2f 331 if (!valid_addr((os_vm_address_t) obj))
332 printf("(invalid address)");
62957726 333 else if (obj == NIL)
9a8c1c2f 334 printf(" (NIL)");
62957726 335 else {
9a8c1c2f 336 struct cons *cons = (struct cons *) PTR(obj);
62957726 337
9a8c1c2f 338 print_obj("car: ", cons->car);
339 print_obj("cdr: ", cons->cdr);
62957726 340 }
341}
342
9a8c1c2f 343static void
344brief_struct(lispobj obj)
62957726 345{
5ced0fdf 346 printf("#<ptr to 0x%08lx instance>",
9a8c1c2f 347 ((struct instance *) PTR(obj))->slots[0]);
62957726 348}
349
9a8c1c2f 350static void
351print_struct(lispobj obj)
62957726 352{
9a8c1c2f 353 struct instance *instance = (struct instance *) PTR(obj);
62957726 354 int i;
355 char buffer[16];
9a8c1c2f 356
357 print_obj("type: ", ((struct instance *) PTR(obj))->slots[0]);
15602773 358 for (i = 1; i < HeaderValue(instance->header); i++) {
62957726 359 sprintf(buffer, "slot %d: ", i);
15602773 360 print_obj(buffer, instance->slots[i]);
62957726 361 }
362}
363
9a8c1c2f 364static void
a2efb646 365print_string(struct vector* vector)
366{
367#ifndef UNICODE
368 char *charptr;
369
370 for (charptr = (char *) vector->data; *charptr != '\0'; charptr++) {
371 if (*charptr == '"')
372 putchar('\\');
373 putchar(*charptr);
374 }
375#else
376 uint16_t *charptr = (uint16_t *) vector->data;
377 int len = fixnum_value(vector->length);
378
379 while (len-- > 0) {
2e958dba 380 if (*charptr == '"') {
a2efb646 381 putchar('\\');
382 }
383 /* Just dump out the UTF-16 data */
2e958dba 384 fwrite(charptr, sizeof(*charptr), 1, stdout);
a2efb646 385 charptr++;
386 }
387#endif
388}
389
390static void
9a8c1c2f 391brief_otherptr(lispobj obj)
62957726 392{
393 lispobj *ptr, header;
394 int type;
395 struct symbol *symbol;
396 struct vector *vector;
62957726 397
398 ptr = (lispobj *) PTR(obj);
399
9a8c1c2f 400 if (!valid_addr((os_vm_address_t) obj)) {
401 printf("(invalid address)");
402 return;
62957726 403 }
404
405 header = *ptr;
406 type = TypeOf(header);
407 switch (type) {
9a8c1c2f 408 case type_SymbolHeader:
409 symbol = (struct symbol *) ptr;
410 vector = (struct vector *) PTR(symbol->name);
a2efb646 411 print_string(vector);
9a8c1c2f 412 break;
413
414 case type_SimpleString:
415 vector = (struct vector *) ptr;
416 putchar('"');
a2efb646 417 print_string(vector);
9a8c1c2f 418 putchar('"');
419 break;
420
421 default:
422 printf("#<ptr to ");
423 brief_otherimm(header);
424 putchar('>');
62957726 425 }
426}
427
9a8c1c2f 428static void
429print_slots(char **slots, int count, lispobj * ptr)
62957726 430{
431 while (count-- > 0)
9a8c1c2f 432 if (*slots)
433 print_obj(*slots++, *ptr++);
434 else
435 print_obj("???: ", *ptr++);
62957726 436}
437
9a8c1c2f 438static char *symbol_slots[] = { "value: ", "hash: ",
439 "plist: ", "name: ", "package: ", NULL
440};
441static char *ratio_slots[] = { "numer: ", "denom: ", NULL };
442static char *complex_slots[] = { "real: ", "imag: ", NULL };
443static char *code_slots[] = { "words: ", "entry: ", "debug: ", NULL };
444static char *array_slots[] = { "fill-pointer: ",
445 "fill-pointer-p: ",
446 "elements: ",
447 "data: ",
448 "displacement: ",
449 "displaced-p: ",
450 /* Some reasonable number of dimensions */
451 "dimension 1: ",
452 "dimension 2: ",
453 "dimension 3: ",
454 "dimension 4: ",
455 "dimension 5: ",
456 "dimension 6: ",
457 "dimension 7: ",
458 NULL
459};
fb89e8de 460
38938011 461static char *simple_array_slots[] = { "length: ",
462 NULL
463};
88d1bf04 464
465#if (defined(i386) || defined(__x86_64))
9a8c1c2f 466static char *fn_slots[] =
467 { "inst start: ", "next: ", "name: ", "arglist: ", "type: ", NULL };
88d1bf04 468#else
9a8c1c2f 469static char *fn_slots[] =
470 { "self: ", "next: ", "name: ", "arglist: ", "type: ", NULL };
88d1bf04 471#endif
472
9a8c1c2f 473static char *closure_slots[] = { "fn: ", NULL };
474static char *funcallable_instance_slots[] =
475 { "fn: ", "lexenv: ", "layout: ", NULL };
476static char *weak_pointer_slots[] = { "value: ", "broken: ",
a7a7489b 477#ifdef GENCGC
9a8c1c2f 478 "mark-bit: ",
a7a7489b 479#endif
9a8c1c2f 480 NULL
481};
482static char *fdefn_slots[] = { "name: ", "function: ", "raw_addr: ", NULL };
483static char *value_cell_slots[] = { "value: ", NULL };
484
a5e333d2 485#ifdef type_ScavengerHook
9a8c1c2f 486static char *scavenger_hook_slots[] =
487
488 { "value: ", "function: ", "next: ", NULL };
a5e333d2 489#endif
62957726 490
9a8c1c2f 491static void
492print_otherptr(lispobj obj)
62957726 493{
9a8c1c2f 494 if (!valid_addr((os_vm_address_t) obj))
495 printf("(invalid address)");
62957726 496 else {
6f4a04e5 497#ifndef alpha
9a8c1c2f 498 unsigned long *ptr;
499 unsigned long header;
500 unsigned long length;
6f4a04e5 501#else
9a8c1c2f 502 u32 *ptr;
503 u32 header;
504 u32 length;
6f4a04e5 505#endif
9a8c1c2f 506 int count, type, index;
a2efb646 507 char buffer[16];
62957726 508
25b808fb 509#ifndef alpha
62957726 510 ptr = (unsigned long *) PTR(obj);
511 if (ptr == (unsigned long *) NULL) {
25b808fb 512#else
513 ptr = (u32 *) PTR(obj);
514 if (ptr == (u32 *) NULL) {
515#endif
9a8c1c2f 516 printf(" (NULL Pointer)");
517 return;
62957726 518 }
519
520 header = *ptr++;
a2efb646 521 length = fixnum_value(*ptr);
9a8c1c2f 522 count = header >> 8;
62957726 523 type = TypeOf(header);
524
9a8c1c2f 525 print_obj("header: ", header);
526 if (LowtagOf(header) != type_OtherImmediate0
527 && LowtagOf(header) != type_OtherImmediate1) {
528 NEWLINE;
529 printf("(invalid header object)");
530 return;
531 }
532
533 switch (type) {
534 case type_Bignum:
535 ptr += count;
536 NEWLINE;
537 printf("0x");
538 while (count-- > 0)
539 printf("%08lx", *--ptr);
540 break;
541
542 case type_Ratio:
543 print_slots(ratio_slots, count, ptr);
544 break;
545
546 case type_Complex:
547 print_slots(complex_slots, count, ptr);
548 break;
549
550 case type_SymbolHeader:
551 print_slots(symbol_slots, count, ptr);
552 break;
553
554 case type_SingleFloat:
555 NEWLINE;
556 printf("%g", ((struct single_float *) PTR(obj))->value);
557 break;
558
559 case type_DoubleFloat:
560 NEWLINE;
2326ebcf 561 printf("%.15lg", ((struct double_float *) PTR(obj))->value);
9a8c1c2f 562 break;
62957726 563
8de15dca 564#ifdef type_LongFloat
9a8c1c2f 565 case type_LongFloat:
566 NEWLINE;
567 printf("%Lg", ((struct long_float *) PTR(obj))->value);
568 break;
8de15dca 569#endif
570
3a0053bb 571#ifdef type_DoubleDoubleFloat
572 case type_DoubleDoubleFloat:
573 NEWLINE;
2326ebcf 574 printf("%.15lg %.15lg", ((struct double_double_float *) PTR(obj))->hi,
3a0053bb 575 ((struct double_double_float *) PTR(obj))->lo);
576 break;
577#endif
578
a5e333d2 579#ifdef type_ComplexSingleFloat
9a8c1c2f 580 case type_ComplexSingleFloat:
581 NEWLINE;
582 printf("%g", ((struct complex_single_float *) PTR(obj))->real);
583 NEWLINE;
584 printf("%g", ((struct complex_single_float *) PTR(obj))->imag);
585 break;
a5e333d2 586#endif
587
588#ifdef type_ComplexDoubleFloat
9a8c1c2f 589 case type_ComplexDoubleFloat:
590 NEWLINE;
2326ebcf 591 printf("%.15lg", ((struct complex_double_float *) PTR(obj))->real);
9a8c1c2f 592 NEWLINE;
2326ebcf 593 printf("%.15lg", ((struct complex_double_float *) PTR(obj))->imag);
9a8c1c2f 594 break;
a5e333d2 595#endif
596
8de15dca 597#ifdef type_ComplexLongFloat
9a8c1c2f 598 case type_ComplexLongFloat:
599 NEWLINE;
600 printf("%Lg", ((struct complex_long_float *) PTR(obj))->real);
601 NEWLINE;
602 printf("%Lg", ((struct complex_long_float *) PTR(obj))->imag);
603 break;
604#endif
605
3a0053bb 606#ifdef type_ComplexDoubleDoubleFloat
607 case type_ComplexDoubleDoubleFloat:
608 NEWLINE;
2326ebcf 609 printf("%.15lg %.15lg", ((struct complex_double_double_float *) PTR(obj))->real_hi,
3a0053bb 610 ((struct complex_double_double_float *) PTR(obj))->real_lo);
611 NEWLINE;
2326ebcf 612 printf("%.15lg %.15lg", ((struct complex_double_double_float *) PTR(obj))->imag_hi,
3a0053bb 613 ((struct complex_double_double_float *) PTR(obj))->imag_lo);
614 break;
615#endif
616
617
9a8c1c2f 618 case type_SimpleString:
619 NEWLINE;
9a8c1c2f 620 putchar('\"');
a2efb646 621 /* Need to back up one to get the start of the vector */
622 print_string((struct vector*) (ptr - 1));
623 putchar('\"');
9a8c1c2f 624 break;
625
626 case type_SimpleVector:
627 NEWLINE;
628 printf("length = %ld", length);
629 ptr++;
630 index = 0;
631 while (length-- > 0) {
632 sprintf(buffer, "%d: ", index++);
633 print_obj(buffer, *ptr++);
634 }
635 break;
636
637 case type_InstanceHeader:
638 NEWLINE;
639 printf("length = %d", count);
640 index = 0;
641 while (count-- > 0) {
642 sprintf(buffer, "%d: ", index++);
643 print_obj(buffer, *ptr++);
644 }
645 break;
646
647 case type_SimpleArray:
648 case type_SimpleBitVector:
649 case type_SimpleArrayUnsignedByte2:
650 case type_SimpleArrayUnsignedByte4:
651 case type_SimpleArrayUnsignedByte8:
652 case type_SimpleArrayUnsignedByte16:
653 case type_SimpleArrayUnsignedByte32:
a5e333d2 654#ifdef type_SimpleArraySignedByte8
9a8c1c2f 655 case type_SimpleArraySignedByte8:
a5e333d2 656#endif
657#ifdef type_SimpleArraySignedByte16
9a8c1c2f 658 case type_SimpleArraySignedByte16:
a5e333d2 659#endif
660#ifdef type_SimpleArraySignedByte30
9a8c1c2f 661 case type_SimpleArraySignedByte30:
a5e333d2 662#endif
663#ifdef type_SimpleArraySignedByte32
9a8c1c2f 664 case type_SimpleArraySignedByte32:
a5e333d2 665#endif
9a8c1c2f 666 case type_SimpleArraySingleFloat:
667 case type_SimpleArrayDoubleFloat:
8de15dca 668#ifdef type_SimpleArrayLongFloat
9a8c1c2f 669 case type_SimpleArrayLongFloat:
8de15dca 670#endif
3a0053bb 671#ifdef type_SimpleArrayDoubleDoubleFloat
672 case type_SimpleArrayDoubleDoubleFloat:
673#endif
a5e333d2 674#ifdef type_SimpleArrayComplexSingleFloat
9a8c1c2f 675 case type_SimpleArrayComplexSingleFloat:
a5e333d2 676#endif
677#ifdef type_SimpleArrayComplexDoubleFloat
9a8c1c2f 678 case type_SimpleArrayComplexDoubleFloat:
a5e333d2 679#endif
8de15dca 680#ifdef type_SimpleArrayComplexLongFloat
9a8c1c2f 681 case type_SimpleArrayComplexLongFloat:
682#endif
3a0053bb 683#ifdef type_SimpleArrayComplexDoubleDoubleFloat
684 case type_SimpleArrayComplexDoubleDoubleFloat:
685#endif
38938011 686 print_slots(simple_array_slots, 1, ptr);
687 break;
9a8c1c2f 688 case type_ComplexString:
689 case type_ComplexBitVector:
690 case type_ComplexVector:
691 case type_ComplexArray:
692 print_slots(array_slots, count, ptr);
693 break;
694
695 case type_CodeHeader:
696 print_slots(code_slots, count - 1, ptr);
697 break;
698
699 case type_FunctionHeader:
700 case type_ClosureFunctionHeader:
701 print_slots(fn_slots, 5, ptr);
702 break;
703
704 case type_ReturnPcHeader:
705 print_obj("code: ", obj - (count * 4));
706 break;
707
708 case type_ClosureHeader:
709 print_slots(closure_slots, count, ptr);
710 break;
711
712 case type_FuncallableInstanceHeader:
713 print_slots(funcallable_instance_slots, count, ptr);
714 break;
715
716 case type_ValueCellHeader:
717 print_slots(value_cell_slots, 1, ptr);
718 break;
719
720 case type_Sap:
721 NEWLINE;
6f4a04e5 722#ifndef alpha
9a8c1c2f 723 printf("0x%08lx", *ptr);
6f4a04e5 724#else
9a8c1c2f 725 printf("0x%016lx", *(long *) (ptr + 1));
6f4a04e5 726#endif
9a8c1c2f 727 break;
62957726 728
9a8c1c2f 729 case type_WeakPointer:
730 print_slots(weak_pointer_slots, 3, ptr);
731 break;
62957726 732
9a8c1c2f 733 case type_BaseChar:
734 case type_UnboundMarker:
735 NEWLINE;
736 printf("pointer to an immediate?");
737 break;
738
739 case type_Fdefn:
740 print_slots(fdefn_slots, count, ptr);
741 break;
62957726 742
a5e333d2 743#ifdef type_ScavengerHook
9a8c1c2f 744 case type_ScavengerHook:
745 print_slots(scavenger_hook_slots, count, ptr);
746 break;
a5e333d2 747#endif
748
9a8c1c2f 749 default:
750 NEWLINE;
751 printf("Unknown header object?");
752 break;
753 }
62957726 754 }
755}
756
9a8c1c2f 757static void
758print_obj(char *prefix, lispobj obj)
62957726 759{
9a8c1c2f 760 static void (*verbose_fns[]) (lispobj obj)
761 = { print_fixnum, print_otherptr, print_otherimm, print_list,
762 print_fixnum, print_struct, print_otherimm, print_otherptr
763 };
764 static void (*brief_fns[]) (lispobj obj)
765 = { brief_fixnum, brief_otherptr, brief_otherimm, brief_list,
766 brief_fixnum, brief_struct, brief_otherimm, brief_otherptr
767 };
62957726 768 int type = LowtagOf(obj);
769 struct var *var = lookup_by_obj(obj);
770 char buffer[256];
771 boolean verbose = cur_depth < brief_depth;
772
9a8c1c2f 773
62957726 774 if (!continue_p(verbose))
9a8c1c2f 775 return;
62957726 776
777 if (var != NULL && var_clock(var) == cur_clock)
9a8c1c2f 778 dont_decend = TRUE;
62957726 779
9a8c1c2f 780 if (var == NULL
781 && (obj & type_FunctionPointer & type_ListPointer & type_InstancePointer
782 & type_OtherPointer) != 0)
783 var = define_var(NULL, obj, FALSE);
62957726 784
785 if (var != NULL)
9a8c1c2f 786 var_setclock(var, cur_clock);
62957726 787
788 cur_depth++;
789 if (verbose) {
9a8c1c2f 790 if (var != NULL) {
791 sprintf(buffer, "$%s=", var_name(var));
792 newline(buffer);
793 } else
794 newline(NULL);
795 printf("%s0x%08lx: ", prefix, obj);
796 if (cur_depth < brief_depth) {
797 fputs(lowtag_Names[type], stdout);
798 (*verbose_fns[type]) (obj);
799 } else
800 (*brief_fns[type]) (obj);
801 } else {
802 if (dont_decend)
803 printf("$%s", var_name(var));
804 else {
805 if (var != NULL)
806 printf("$%s=", var_name(var));
807 (*brief_fns[type]) (obj);
808 }
62957726 809 }
810 cur_depth--;
811 dont_decend = FALSE;
812}
813
9a8c1c2f 814void
b8d0dfaf 815reset_printer(void)
62957726 816{
817 cur_clock++;
818 cur_lines = 0;
819 dont_decend = FALSE;
820}
821
9a8c1c2f 822void
823print(lispobj obj)
62957726 824{
825 skip_newline = TRUE;
826 cur_depth = 0;
827 max_depth = 5;
828 max_lines = 20;
829
830 print_obj("", obj);
831
832 putchar('\n');
833}
834
9a8c1c2f 835void
836brief_print(lispobj obj)
62957726 837{
838 skip_newline = TRUE;
e5dd4682 839 cur_depth = 0;
62957726 840 max_depth = 1;
841 max_lines = 5000;
842
843 print_obj("", obj);
844 putchar('\n');
845}
CMU Common Lisp