common-lisp.net / projects/cmucl/cmucl.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Output lisp strings in utf8 format in ldb print.
[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
eb7aef5b 379 utf16_output(charptr, len);
a2efb646 380#endif
381}
382
383static void
9a8c1c2f 384brief_otherptr(lispobj obj)
62957726 385{
386 lispobj *ptr, header;
387 int type;
388 struct symbol *symbol;
389 struct vector *vector;
62957726 390
391 ptr = (lispobj *) PTR(obj);
392
9a8c1c2f 393 if (!valid_addr((os_vm_address_t) obj)) {
394 printf("(invalid address)");
395 return;
62957726 396 }
397
398 header = *ptr;
399 type = TypeOf(header);
400 switch (type) {
9a8c1c2f 401 case type_SymbolHeader:
402 symbol = (struct symbol *) ptr;
403 vector = (struct vector *) PTR(symbol->name);
a2efb646 404 print_string(vector);
9a8c1c2f 405 break;
406
407 case type_SimpleString:
408 vector = (struct vector *) ptr;
409 putchar('"');
a2efb646 410 print_string(vector);
9a8c1c2f 411 putchar('"');
412 break;
413
414 default:
415 printf("#<ptr to ");
416 brief_otherimm(header);
417 putchar('>');
62957726 418 }
419}
420
9a8c1c2f 421static void
422print_slots(char **slots, int count, lispobj * ptr)
62957726 423{
424 while (count-- > 0)
9a8c1c2f 425 if (*slots)
426 print_obj(*slots++, *ptr++);
427 else
428 print_obj("???: ", *ptr++);
62957726 429}
430
9a8c1c2f 431static char *symbol_slots[] = { "value: ", "hash: ",
432 "plist: ", "name: ", "package: ", NULL
433};
434static char *ratio_slots[] = { "numer: ", "denom: ", NULL };
435static char *complex_slots[] = { "real: ", "imag: ", NULL };
436static char *code_slots[] = { "words: ", "entry: ", "debug: ", NULL };
437static char *array_slots[] = { "fill-pointer: ",
438 "fill-pointer-p: ",
439 "elements: ",
440 "data: ",
441 "displacement: ",
442 "displaced-p: ",
443 /* Some reasonable number of dimensions */
444 "dimension 1: ",
445 "dimension 2: ",
446 "dimension 3: ",
447 "dimension 4: ",
448 "dimension 5: ",
449 "dimension 6: ",
450 "dimension 7: ",
451 NULL
452};
fb89e8de 453
38938011 454static char *simple_array_slots[] = { "length: ",
455 NULL
456};
88d1bf04 457
458#if (defined(i386) || defined(__x86_64))
9a8c1c2f 459static char *fn_slots[] =
460 { "inst start: ", "next: ", "name: ", "arglist: ", "type: ", NULL };
88d1bf04 461#else
9a8c1c2f 462static char *fn_slots[] =
463 { "self: ", "next: ", "name: ", "arglist: ", "type: ", NULL };
88d1bf04 464#endif
465
9a8c1c2f 466static char *closure_slots[] = { "fn: ", NULL };
467static char *funcallable_instance_slots[] =
468 { "fn: ", "lexenv: ", "layout: ", NULL };
469static char *weak_pointer_slots[] = { "value: ", "broken: ",
a7a7489b 470#ifdef GENCGC
9a8c1c2f 471 "mark-bit: ",
a7a7489b 472#endif
9a8c1c2f 473 NULL
474};
475static char *fdefn_slots[] = { "name: ", "function: ", "raw_addr: ", NULL };
476static char *value_cell_slots[] = { "value: ", NULL };
477
a5e333d2 478#ifdef type_ScavengerHook
9a8c1c2f 479static char *scavenger_hook_slots[] =
480
481 { "value: ", "function: ", "next: ", NULL };
a5e333d2 482#endif
62957726 483
9a8c1c2f 484static void
485print_otherptr(lispobj obj)
62957726 486{
9a8c1c2f 487 if (!valid_addr((os_vm_address_t) obj))
488 printf("(invalid address)");
62957726 489 else {
6f4a04e5 490#ifndef alpha
9a8c1c2f 491 unsigned long *ptr;
492 unsigned long header;
493 unsigned long length;
6f4a04e5 494#else
9a8c1c2f 495 u32 *ptr;
496 u32 header;
497 u32 length;
6f4a04e5 498#endif
9a8c1c2f 499 int count, type, index;
a2efb646 500 char buffer[16];
62957726 501
25b808fb 502#ifndef alpha
62957726 503 ptr = (unsigned long *) PTR(obj);
504 if (ptr == (unsigned long *) NULL) {
25b808fb 505#else
506 ptr = (u32 *) PTR(obj);
507 if (ptr == (u32 *) NULL) {
508#endif
9a8c1c2f 509 printf(" (NULL Pointer)");
510 return;
62957726 511 }
512
513 header = *ptr++;
a2efb646 514 length = fixnum_value(*ptr);
9a8c1c2f 515 count = header >> 8;
62957726 516 type = TypeOf(header);
517
9a8c1c2f 518 print_obj("header: ", header);
519 if (LowtagOf(header) != type_OtherImmediate0
520 && LowtagOf(header) != type_OtherImmediate1) {
521 NEWLINE;
522 printf("(invalid header object)");
523 return;
524 }
525
526 switch (type) {
527 case type_Bignum:
528 ptr += count;
529 NEWLINE;
530 printf("0x");
531 while (count-- > 0)
532 printf("%08lx", *--ptr);
533 break;
534
535 case type_Ratio:
536 print_slots(ratio_slots, count, ptr);
537 break;
538
539 case type_Complex:
540 print_slots(complex_slots, count, ptr);
541 break;
542
543 case type_SymbolHeader:
544 print_slots(symbol_slots, count, ptr);
545 break;
546
547 case type_SingleFloat:
548 NEWLINE;
549 printf("%g", ((struct single_float *) PTR(obj))->value);
550 break;
551
552 case type_DoubleFloat:
553 NEWLINE;
2326ebcf 554 printf("%.15lg", ((struct double_float *) PTR(obj))->value);
9a8c1c2f 555 break;
62957726 556
8de15dca 557#ifdef type_LongFloat
9a8c1c2f 558 case type_LongFloat:
559 NEWLINE;
560 printf("%Lg", ((struct long_float *) PTR(obj))->value);
561 break;
8de15dca 562#endif
563
3a0053bb 564#ifdef type_DoubleDoubleFloat
565 case type_DoubleDoubleFloat:
566 NEWLINE;
2326ebcf 567 printf("%.15lg %.15lg", ((struct double_double_float *) PTR(obj))->hi,
3a0053bb 568 ((struct double_double_float *) PTR(obj))->lo);
569 break;
570#endif
571
a5e333d2 572#ifdef type_ComplexSingleFloat
9a8c1c2f 573 case type_ComplexSingleFloat:
574 NEWLINE;
575 printf("%g", ((struct complex_single_float *) PTR(obj))->real);
576 NEWLINE;
577 printf("%g", ((struct complex_single_float *) PTR(obj))->imag);
578 break;
a5e333d2 579#endif
580
581#ifdef type_ComplexDoubleFloat
9a8c1c2f 582 case type_ComplexDoubleFloat:
583 NEWLINE;
2326ebcf 584 printf("%.15lg", ((struct complex_double_float *) PTR(obj))->real);
9a8c1c2f 585 NEWLINE;
2326ebcf 586 printf("%.15lg", ((struct complex_double_float *) PTR(obj))->imag);
9a8c1c2f 587 break;
a5e333d2 588#endif
589
8de15dca 590#ifdef type_ComplexLongFloat
9a8c1c2f 591 case type_ComplexLongFloat:
592 NEWLINE;
593 printf("%Lg", ((struct complex_long_float *) PTR(obj))->real);
594 NEWLINE;
595 printf("%Lg", ((struct complex_long_float *) PTR(obj))->imag);
596 break;
597#endif
598
3a0053bb 599#ifdef type_ComplexDoubleDoubleFloat
600 case type_ComplexDoubleDoubleFloat:
601 NEWLINE;
2326ebcf 602 printf("%.15lg %.15lg", ((struct complex_double_double_float *) PTR(obj))->real_hi,
3a0053bb 603 ((struct complex_double_double_float *) PTR(obj))->real_lo);
604 NEWLINE;
2326ebcf 605 printf("%.15lg %.15lg", ((struct complex_double_double_float *) PTR(obj))->imag_hi,
3a0053bb 606 ((struct complex_double_double_float *) PTR(obj))->imag_lo);
607 break;
608#endif
609
610
9a8c1c2f 611 case type_SimpleString:
612 NEWLINE;
9a8c1c2f 613 putchar('\"');
a2efb646 614 /* Need to back up one to get the start of the vector */
615 print_string((struct vector*) (ptr - 1));
616 putchar('\"');
9a8c1c2f 617 break;
618
619 case type_SimpleVector:
620 NEWLINE;
621 printf("length = %ld", length);
622 ptr++;
623 index = 0;
624 while (length-- > 0) {
625 sprintf(buffer, "%d: ", index++);
626 print_obj(buffer, *ptr++);
627 }
628 break;
629
630 case type_InstanceHeader:
631 NEWLINE;
632 printf("length = %d", count);
633 index = 0;
634 while (count-- > 0) {
635 sprintf(buffer, "%d: ", index++);
636 print_obj(buffer, *ptr++);
637 }
638 break;
639
640 case type_SimpleArray:
641 case type_SimpleBitVector:
642 case type_SimpleArrayUnsignedByte2:
643 case type_SimpleArrayUnsignedByte4:
644 case type_SimpleArrayUnsignedByte8:
645 case type_SimpleArrayUnsignedByte16:
646 case type_SimpleArrayUnsignedByte32:
a5e333d2 647#ifdef type_SimpleArraySignedByte8
9a8c1c2f 648 case type_SimpleArraySignedByte8:
a5e333d2 649#endif
650#ifdef type_SimpleArraySignedByte16
9a8c1c2f 651 case type_SimpleArraySignedByte16:
a5e333d2 652#endif
653#ifdef type_SimpleArraySignedByte30
9a8c1c2f 654 case type_SimpleArraySignedByte30:
a5e333d2 655#endif
656#ifdef type_SimpleArraySignedByte32
9a8c1c2f 657 case type_SimpleArraySignedByte32:
a5e333d2 658#endif
9a8c1c2f 659 case type_SimpleArraySingleFloat:
660 case type_SimpleArrayDoubleFloat:
8de15dca 661#ifdef type_SimpleArrayLongFloat
9a8c1c2f 662 case type_SimpleArrayLongFloat:
8de15dca 663#endif
3a0053bb 664#ifdef type_SimpleArrayDoubleDoubleFloat
665 case type_SimpleArrayDoubleDoubleFloat:
666#endif
a5e333d2 667#ifdef type_SimpleArrayComplexSingleFloat
9a8c1c2f 668 case type_SimpleArrayComplexSingleFloat:
a5e333d2 669#endif
670#ifdef type_SimpleArrayComplexDoubleFloat
9a8c1c2f 671 case type_SimpleArrayComplexDoubleFloat:
a5e333d2 672#endif
8de15dca 673#ifdef type_SimpleArrayComplexLongFloat
9a8c1c2f 674 case type_SimpleArrayComplexLongFloat:
675#endif
3a0053bb 676#ifdef type_SimpleArrayComplexDoubleDoubleFloat
677 case type_SimpleArrayComplexDoubleDoubleFloat:
678#endif
38938011 679 print_slots(simple_array_slots, 1, ptr);
680 break;
9a8c1c2f 681 case type_ComplexString:
682 case type_ComplexBitVector:
683 case type_ComplexVector:
684 case type_ComplexArray:
685 print_slots(array_slots, count, ptr);
686 break;
687
688 case type_CodeHeader:
689 print_slots(code_slots, count - 1, ptr);
690 break;
691
692 case type_FunctionHeader:
693 case type_ClosureFunctionHeader:
694 print_slots(fn_slots, 5, ptr);
695 break;
696
697 case type_ReturnPcHeader:
698 print_obj("code: ", obj - (count * 4));
699 break;
700
701 case type_ClosureHeader:
702 print_slots(closure_slots, count, ptr);
703 break;
704
705 case type_FuncallableInstanceHeader:
706 print_slots(funcallable_instance_slots, count, ptr);
707 break;
708
709 case type_ValueCellHeader:
710 print_slots(value_cell_slots, 1, ptr);
711 break;
712
713 case type_Sap:
714 NEWLINE;
6f4a04e5 715#ifndef alpha
9a8c1c2f 716 printf("0x%08lx", *ptr);
6f4a04e5 717#else
9a8c1c2f 718 printf("0x%016lx", *(long *) (ptr + 1));
6f4a04e5 719#endif
9a8c1c2f 720 break;
62957726 721
9a8c1c2f 722 case type_WeakPointer:
723 print_slots(weak_pointer_slots, 3, ptr);
724 break;
62957726 725
9a8c1c2f 726 case type_BaseChar:
727 case type_UnboundMarker:
728 NEWLINE;
729 printf("pointer to an immediate?");
730 break;
731
732 case type_Fdefn:
733 print_slots(fdefn_slots, count, ptr);
734 break;
62957726 735
a5e333d2 736#ifdef type_ScavengerHook
9a8c1c2f 737 case type_ScavengerHook:
738 print_slots(scavenger_hook_slots, count, ptr);
739 break;
a5e333d2 740#endif
741
9a8c1c2f 742 default:
743 NEWLINE;
744 printf("Unknown header object?");
745 break;
746 }
62957726 747 }
748}
749
9a8c1c2f 750static void
751print_obj(char *prefix, lispobj obj)
62957726 752{
9a8c1c2f 753 static void (*verbose_fns[]) (lispobj obj)
754 = { print_fixnum, print_otherptr, print_otherimm, print_list,
755 print_fixnum, print_struct, print_otherimm, print_otherptr
756 };
757 static void (*brief_fns[]) (lispobj obj)
758 = { brief_fixnum, brief_otherptr, brief_otherimm, brief_list,
759 brief_fixnum, brief_struct, brief_otherimm, brief_otherptr
760 };
62957726 761 int type = LowtagOf(obj);
762 struct var *var = lookup_by_obj(obj);
763 char buffer[256];
764 boolean verbose = cur_depth < brief_depth;
765
9a8c1c2f 766
62957726 767 if (!continue_p(verbose))
9a8c1c2f 768 return;
62957726 769
770 if (var != NULL && var_clock(var) == cur_clock)
9a8c1c2f 771 dont_decend = TRUE;
62957726 772
9a8c1c2f 773 if (var == NULL
774 && (obj & type_FunctionPointer & type_ListPointer & type_InstancePointer
775 & type_OtherPointer) != 0)
776 var = define_var(NULL, obj, FALSE);
62957726 777
778 if (var != NULL)
9a8c1c2f 779 var_setclock(var, cur_clock);
62957726 780
781 cur_depth++;
782 if (verbose) {
9a8c1c2f 783 if (var != NULL) {
784 sprintf(buffer, "$%s=", var_name(var));
785 newline(buffer);
786 } else
787 newline(NULL);
788 printf("%s0x%08lx: ", prefix, obj);
789 if (cur_depth < brief_depth) {
790 fputs(lowtag_Names[type], stdout);
791 (*verbose_fns[type]) (obj);
792 } else
793 (*brief_fns[type]) (obj);
794 } else {
795 if (dont_decend)
796 printf("$%s", var_name(var));
797 else {
798 if (var != NULL)
799 printf("$%s=", var_name(var));
800 (*brief_fns[type]) (obj);
801 }
62957726 802 }
803 cur_depth--;
804 dont_decend = FALSE;
805}
806
9a8c1c2f 807void
b8d0dfaf 808reset_printer(void)
62957726 809{
810 cur_clock++;
811 cur_lines = 0;
812 dont_decend = FALSE;
813}
814
9a8c1c2f 815void
816print(lispobj obj)
62957726 817{
818 skip_newline = TRUE;
819 cur_depth = 0;
820 max_depth = 5;
821 max_lines = 20;
822
823 print_obj("", obj);
824
825 putchar('\n');
826}
827
9a8c1c2f 828void
829brief_print(lispobj obj)
62957726 830{
831 skip_newline = TRUE;
e5dd4682 832 cur_depth = 0;
62957726 833 max_depth = 1;
834 max_lines = 5000;
835
836 print_obj("", obj);
837 putchar('\n');
838}
CMU Common Lisp