Fix inline fixnum LDB on PowerPC for certain bytespecs
[sbcl.git] / src / runtime / print.c
1 /* code for low-level debugging/diagnostic output */
2
3 /*
4  * This software is part of the SBCL system. See the README file for
5  * more information.
6  *
7  * This software is derived from the CMU CL system, which was
8  * written at Carnegie Mellon University and released into the
9  * public domain. The software is in the public domain and is
10  * provided with absolutely no warranty. See the COPYING and CREDITS
11  * files for more information.
12  */
13
14 /*
15  * FIXME:
16  *   Some of the code in here (the various
17  *   foo_slots[], at least) is deeply broken, depending on guessing
18  *   already out-of-date values instead of getting them from sbcl.h.
19  */
20
21 #include <stdio.h>
22 #include <string.h>
23
24 #include "sbcl.h"
25 #include "print.h"
26 #include "runtime.h"
27
28 /* This file can be skipped if we're not supporting LDB. */
29 #if defined(LISP_FEATURE_SB_LDB)
30
31 #include "monitor.h"
32 #include "vars.h"
33 #include "os.h"
34 #ifdef LISP_FEATURE_GENCGC
35 #include "gencgc-alloc-region.h" /* genesis/thread.h needs this */
36 #endif
37 #include "genesis/static-symbols.h"
38 #include "thread.h"              /* genesis/primitive-objects.h needs this */
39 #include "genesis/primitive-objects.h"
40 #include "genesis/static-symbols.h"
41 #include "genesis/tagnames.h"
42
43 static int max_lines = 20, cur_lines = 0;
44 static int max_depth = 5, brief_depth = 2, cur_depth = 0;
45 static int max_length = 5;
46 static boolean dont_descend = 0, skip_newline = 0;
47 static int cur_clock = 0;
48
49 static void print_obj(char *prefix, lispobj obj);
50
51 #define NEWLINE_OR_RETURN if (continue_p(1)) newline(NULL); else return;
52
53 static void indent(int in)
54 {
55     static char *spaces = "                                                                ";
56
57     while (in > 64) {
58         fputs(spaces, stdout);
59         in -= 64;
60     }
61     if (in != 0)
62         fputs(spaces + 64 - in, stdout);
63 }
64
65 static boolean continue_p(boolean newline)
66 {
67     char buffer[256];
68
69     if (cur_depth >= max_depth || dont_descend)
70         return 0;
71
72     if (newline) {
73         if (skip_newline)
74             skip_newline = 0;
75         else
76             putchar('\n');
77
78         if (cur_lines >= max_lines) {
79             printf("More? [y] ");
80             fflush(stdout);
81
82             if (fgets(buffer, sizeof(buffer), stdin)) {
83                 if (buffer[0] == 'n' || buffer[0] == 'N')
84                     throw_to_monitor();
85                 else
86                     cur_lines = 0;
87             } else {
88                 printf("\nUnable to read response, assuming y.\n");
89                 cur_lines = 0;
90             }
91         }
92     }
93
94     return 1;
95 }
96
97 static void newline(char *label)
98 {
99     cur_lines++;
100     if (label != NULL)
101         fputs(label, stdout);
102     putchar('\t');
103     indent(cur_depth * 2);
104 }
105
106
107 static void print_unknown(lispobj obj)
108 {
109   printf("unknown object: %p", (void *)obj);
110 }
111
112 static void brief_fixnum(lispobj obj)
113 {
114     /* KLUDGE: Rather than update the tables in print_obj(), we
115        declare all fixnum-or-unknown tags to be fixnums and sort it
116        out here with a guard clause. */
117     if (!fixnump(obj)) return print_unknown(obj);
118
119 #ifndef LISP_FEATURE_ALPHA
120     printf("%ld", ((long)obj)>>2);
121 #else
122     printf("%d", ((s32)obj)>>2);
123 #endif
124 }
125
126 static void print_fixnum(lispobj obj)
127 {
128     /* KLUDGE: Rather than update the tables in print_obj(), we
129        declare all fixnum-or-unknown tags to be fixnums and sort it
130        out here with a guard clause. */
131     if (!fixnump(obj)) return print_unknown(obj);
132
133 #ifndef LISP_FEATURE_ALPHA
134     printf(": %ld", ((long)obj)>>2);
135 #else
136     printf(": %d", ((s32)obj)>>2);
137 #endif
138 }
139
140 static void brief_otherimm(lispobj obj)
141 {
142     int type, c;
143     char buffer[10];
144
145     type = widetag_of(obj);
146     switch (type) {
147         case CHARACTER_WIDETAG:
148             c = (obj>>8)&0xff;
149             switch (c) {
150                 case '\0':
151                     printf("#\\Null");
152                     break;
153                 case '\n':
154                     printf("#\\Newline");
155                     break;
156                 case '\b':
157                     printf("#\\Backspace");
158                     break;
159                 case '\177':
160                     printf("#\\Delete");
161                     break;
162                 default:
163                     strcpy(buffer, "#\\");
164                     if (c >= 128) {
165                         strcat(buffer, "m-");
166                         c -= 128;
167                     }
168                     if (c < 32) {
169                         strcat(buffer, "c-");
170                         c += '@';
171                     }
172                     printf("%s%c", buffer, c);
173                     break;
174             }
175             break;
176
177         case UNBOUND_MARKER_WIDETAG:
178             printf("<unbound marker>");
179             break;
180
181         default:
182             printf("%s", widetag_names[type >> 2]);
183             break;
184     }
185 }
186
187 static void print_otherimm(lispobj obj)
188 {
189     printf(", %s", widetag_names[widetag_of(obj) >> 2]);
190
191     switch (widetag_of(obj)) {
192         case CHARACTER_WIDETAG:
193             printf(": ");
194             brief_otherimm(obj);
195             break;
196
197         case SAP_WIDETAG:
198         case UNBOUND_MARKER_WIDETAG:
199             break;
200
201         default:
202             printf(": data=%ld", (long) (obj>>8)&0xffffff);
203             break;
204     }
205 }
206
207 static void brief_list(lispobj obj)
208 {
209     int space = 0;
210     int length = 0;
211
212     if (!is_valid_lisp_addr((os_vm_address_t)native_pointer(obj)))
213         printf("(invalid Lisp-level address)");
214     else if (obj == NIL)
215         printf("NIL");
216     else {
217         putchar('(');
218         while (lowtag_of(obj) == LIST_POINTER_LOWTAG) {
219             struct cons *cons = (struct cons *)native_pointer(obj);
220
221             if (space)
222                 putchar(' ');
223             if (++length >= max_length) {
224                 printf("...");
225                 obj = NIL;
226                 break;
227             }
228             print_obj("", cons->car);
229             obj = cons->cdr;
230             space = 1;
231             if (obj == NIL)
232                 break;
233         }
234         if (obj != NIL) {
235             printf(" . ");
236             print_obj("", obj);
237         }
238         putchar(')');
239     }
240 }
241
242 static void print_list(lispobj obj)
243 {
244     if (!is_valid_lisp_addr((os_vm_address_t)native_pointer(obj))) {
245         printf("(invalid address)");
246     } else if (obj == NIL) {
247         printf(" (NIL)");
248     } else {
249         struct cons *cons = (struct cons *)native_pointer(obj);
250
251         print_obj("car: ", cons->car);
252         print_obj("cdr: ", cons->cdr);
253     }
254 }
255
256 static void brief_struct(lispobj obj)
257 {
258     struct instance *instance = (struct instance *)native_pointer(obj);
259     if (!is_valid_lisp_addr((os_vm_address_t)instance)) {
260         printf("(invalid address)");
261     } else {
262         printf("#<ptr to 0x%08lx instance>",
263                (unsigned long) instance->slots[0]);
264     }
265 }
266
267 static void print_struct(lispobj obj)
268 {
269     struct instance *instance = (struct instance *)native_pointer(obj);
270     unsigned int i;
271     char buffer[16];
272     if (!is_valid_lisp_addr((os_vm_address_t)instance)) {
273         printf("(invalid address)");
274     } else {
275         print_obj("type: ", ((struct instance *)native_pointer(obj))->slots[0]);
276         for (i = 1; i < HeaderValue(instance->header); i++) {
277             sprintf(buffer, "slot %d: ", i);
278             print_obj(buffer, instance->slots[i]);
279         }
280     }
281 }
282
283 static void brief_otherptr(lispobj obj)
284 {
285     lispobj *ptr, header;
286     int type;
287     struct symbol *symbol;
288     struct vector *vector;
289     char *charptr;
290
291     ptr = (lispobj *) native_pointer(obj);
292
293     if (!is_valid_lisp_addr((os_vm_address_t)obj)) {
294             printf("(invalid address)");
295             return;
296     }
297
298     header = *ptr;
299     type = widetag_of(header);
300     switch (type) {
301         case SYMBOL_HEADER_WIDETAG:
302             symbol = (struct symbol *)ptr;
303             vector = (struct vector *)native_pointer(symbol->name);
304             for (charptr = (char *)vector->data; *charptr != '\0'; charptr++) {
305                 if (*charptr == '"')
306                     putchar('\\');
307                 putchar(*charptr);
308             }
309             break;
310
311         case SIMPLE_BASE_STRING_WIDETAG:
312             vector = (struct vector *)ptr;
313             putchar('"');
314             for (charptr = (char *)vector->data; *charptr != '\0'; charptr++) {
315                 if (*charptr == '"')
316                     putchar('\\');
317                 putchar(*charptr);
318             }
319             putchar('"');
320             break;
321
322         default:
323             printf("#<ptr to ");
324             brief_otherimm(header);
325             putchar('>');
326     }
327 }
328
329 static void print_slots(char **slots, int count, lispobj *ptr)
330 {
331     while (count-- > 0) {
332         if (*slots) {
333             print_obj(*slots++, *ptr++);
334         } else {
335             print_obj("???: ", *ptr++);
336         }
337     }
338 }
339
340 /* FIXME: Yikes! This needs to depend on the values in sbcl.h (or
341  * perhaps be generated automatically by GENESIS as part of
342  * sbcl.h). */
343 static char *symbol_slots[] = {"value: ", "hash: ",
344     "plist: ", "name: ", "package: ",
345 #ifdef LISP_FEATURE_SB_THREAD
346     "tls-index: " ,
347 #endif
348     NULL};
349 static char *ratio_slots[] = {"numer: ", "denom: ", NULL};
350 static char *complex_slots[] = {"real: ", "imag: ", NULL};
351 static char *code_slots[] = {"words: ", "entry: ", "debug: ", NULL};
352 static char *fn_slots[] = {
353     "self: ", "next: ", "name: ", "arglist: ", "type: ", NULL};
354 static char *closure_slots[] = {"fn: ", NULL};
355 static char *funcallable_instance_slots[] = {"fn: ", "lexenv: ", "layout: ", NULL};
356 static char *weak_pointer_slots[] = {"value: ", NULL};
357 static char *fdefn_slots[] = {"name: ", "function: ", "raw_addr: ", NULL};
358 static char *value_cell_slots[] = {"value: ", NULL};
359
360 static void print_otherptr(lispobj obj)
361 {
362     if (!is_valid_lisp_addr((os_vm_address_t)obj)) {
363         printf("(invalid address)");
364     } else {
365 #ifndef LISP_FEATURE_ALPHA
366         lispobj *ptr;
367         unsigned long header;
368         unsigned long length;
369 #else
370         u32 *ptr;
371         u32 header;
372         u32 length;
373 #endif
374         int count, type, index;
375         char *cptr, buffer[16];
376
377         ptr = (lispobj*) native_pointer(obj);
378         if (ptr == NULL) {
379                 printf(" (NULL Pointer)");
380                 return;
381         }
382
383         header = *ptr++;
384         length = fixnum_value(*ptr);
385         count = HeaderValue(header);
386         type = widetag_of(header);
387
388         print_obj("header: ", header);
389         if (!other_immediate_lowtag_p(header)) {
390             NEWLINE_OR_RETURN;
391             printf("(invalid header object)");
392             return;
393         }
394
395         switch (type) {
396             case BIGNUM_WIDETAG:
397                 ptr += count;
398                 NEWLINE_OR_RETURN;
399                 printf("0x");
400                 while (count-- > 0)
401                     printf("%08lx", (unsigned long) *--ptr);
402                 break;
403
404             case RATIO_WIDETAG:
405                 print_slots(ratio_slots, count, ptr);
406                 break;
407
408             case COMPLEX_WIDETAG:
409                 print_slots(complex_slots, count, ptr);
410                 break;
411
412             case SYMBOL_HEADER_WIDETAG:
413                 print_slots(symbol_slots, count, ptr);
414                 break;
415
416 #if N_WORD_BITS == 32
417             case SINGLE_FLOAT_WIDETAG:
418                 NEWLINE_OR_RETURN;
419                 printf("%g", ((struct single_float *)native_pointer(obj))->value);
420                 break;
421 #endif
422             case DOUBLE_FLOAT_WIDETAG:
423                 NEWLINE_OR_RETURN;
424                 printf("%g", ((struct double_float *)native_pointer(obj))->value);
425                 break;
426
427 #ifdef LONG_FLOAT_WIDETAG
428             case LONG_FLOAT_WIDETAG:
429                 NEWLINE_OR_RETURN;
430                 printf("%Lg", ((struct long_float *)native_pointer(obj))->value);
431                 break;
432 #endif
433
434 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
435             case COMPLEX_SINGLE_FLOAT_WIDETAG:
436                 NEWLINE_OR_RETURN;
437 #ifdef LISP_FEATURE_X86_64
438                 printf("%g", ((struct complex_single_float *)native_pointer(obj))->data.data[0]);
439 #else
440                 printf("%g", ((struct complex_single_float *)native_pointer(obj))->real);
441 #endif
442                 NEWLINE_OR_RETURN;
443 #ifdef LISP_FEATURE_X86_64
444                 printf("%g", ((struct complex_single_float *)native_pointer(obj))->data.data[1]);
445 #else
446                 printf("%g", ((struct complex_single_float *)native_pointer(obj))->imag);
447 #endif
448                 break;
449 #endif
450
451 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
452             case COMPLEX_DOUBLE_FLOAT_WIDETAG:
453                 NEWLINE_OR_RETURN;
454                 printf("%g", ((struct complex_double_float *)native_pointer(obj))->real);
455                 NEWLINE_OR_RETURN;
456                 printf("%g", ((struct complex_double_float *)native_pointer(obj))->imag);
457                 break;
458 #endif
459
460 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
461             case COMPLEX_LONG_FLOAT_WIDETAG:
462                 NEWLINE_OR_RETURN;
463                 printf("%Lg", ((struct complex_long_float *)native_pointer(obj))->real);
464                 NEWLINE_OR_RETURN;
465                 printf("%Lg", ((struct complex_long_float *)native_pointer(obj))->imag);
466                 break;
467 #endif
468
469             case SIMPLE_BASE_STRING_WIDETAG:
470 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
471         case SIMPLE_CHARACTER_STRING_WIDETAG: /* FIXME */
472 #endif
473                 NEWLINE_OR_RETURN;
474                 cptr = (char *)(ptr+1);
475                 putchar('"');
476                 while (length-- > 0)
477                     putchar(*cptr++);
478                 putchar('"');
479                 break;
480
481             case SIMPLE_VECTOR_WIDETAG:
482                 NEWLINE_OR_RETURN;
483                 printf("length = %ld", length);
484                 ptr++;
485                 index = 0;
486                 while (length-- > 0) {
487                     sprintf(buffer, "%d: ", index++);
488                     print_obj(buffer, *ptr++);
489                 }
490                 break;
491
492             case INSTANCE_HEADER_WIDETAG:
493                 NEWLINE_OR_RETURN;
494                 printf("length = %ld", (long) count);
495                 index = 0;
496                 while (count-- > 0) {
497                     sprintf(buffer, "%d: ", index++);
498                     print_obj(buffer, *ptr++);
499                 }
500                 break;
501
502             case SIMPLE_ARRAY_WIDETAG:
503             case SIMPLE_BIT_VECTOR_WIDETAG:
504             case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
505             case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
506             case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
507             case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
508             case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
509             case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
510
511             case SIMPLE_ARRAY_UNSIGNED_FIXNUM_WIDETAG:
512
513             case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
514             case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
515 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
516             case SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG:
517 #endif
518 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
519             case SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG:
520 #endif
521 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
522             case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
523 #endif
524 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
525             case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
526 #endif
527
528             case SIMPLE_ARRAY_FIXNUM_WIDETAG:
529
530 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
531             case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
532 #endif
533 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
534             case SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG:
535 #endif
536             case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
537             case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
538 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
539             case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
540 #endif
541 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
542             case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
543 #endif
544 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
545             case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
546 #endif
547 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
548             case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
549 #endif
550             case COMPLEX_BASE_STRING_WIDETAG:
551 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
552         case COMPLEX_CHARACTER_STRING_WIDETAG:
553 #endif
554             case COMPLEX_VECTOR_NIL_WIDETAG:
555             case COMPLEX_BIT_VECTOR_WIDETAG:
556             case COMPLEX_VECTOR_WIDETAG:
557             case COMPLEX_ARRAY_WIDETAG:
558                 break;
559
560             case CODE_HEADER_WIDETAG:
561                 print_slots(code_slots, count-1, ptr);
562                 break;
563
564             case SIMPLE_FUN_HEADER_WIDETAG:
565                 print_slots(fn_slots, 5, ptr);
566                 break;
567
568             case RETURN_PC_HEADER_WIDETAG:
569                 print_obj("code: ", obj - (count * 4));
570                 break;
571
572             case CLOSURE_HEADER_WIDETAG:
573                 print_slots(closure_slots, count, ptr);
574                 break;
575
576             case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
577                 print_slots(funcallable_instance_slots, count, ptr);
578                 break;
579
580             case VALUE_CELL_HEADER_WIDETAG:
581                 print_slots(value_cell_slots, 1, ptr);
582                 break;
583
584             case SAP_WIDETAG:
585                 NEWLINE_OR_RETURN;
586 #ifndef LISP_FEATURE_ALPHA
587                 printf("0x%08lx", (unsigned long) *ptr);
588 #else
589                 printf("0x%016lx", *(lispobj*)(ptr+1));
590 #endif
591                 break;
592
593             case WEAK_POINTER_WIDETAG:
594                 print_slots(weak_pointer_slots, 1, ptr);
595                 break;
596
597             case CHARACTER_WIDETAG:
598             case UNBOUND_MARKER_WIDETAG:
599                 NEWLINE_OR_RETURN;
600                 printf("pointer to an immediate?");
601                 break;
602
603             case FDEFN_WIDETAG:
604                 print_slots(fdefn_slots, count, ptr);
605                 break;
606
607             default:
608                 NEWLINE_OR_RETURN;
609                 printf("Unknown header object?");
610                 break;
611         }
612     }
613 }
614
615 static void print_obj(char *prefix, lispobj obj)
616 {
617 #ifdef LISP_FEATURE_X86_64
618     static void (*verbose_fns[])(lispobj obj)
619         = {print_fixnum, print_otherimm, print_fixnum, print_struct,
620            print_fixnum, print_otherimm, print_fixnum, print_list,
621            print_fixnum, print_otherimm, print_fixnum, print_otherptr,
622            print_fixnum, print_otherimm, print_fixnum, print_otherptr};
623     static void (*brief_fns[])(lispobj obj)
624         = {brief_fixnum, brief_otherimm, brief_fixnum, brief_struct,
625            brief_fixnum, brief_otherimm, brief_fixnum, brief_list,
626            brief_fixnum, brief_otherimm, brief_fixnum, brief_otherptr,
627            brief_fixnum, brief_otherimm, brief_fixnum, brief_otherptr};
628 #else
629     static void (*verbose_fns[])(lispobj obj)
630         = {print_fixnum, print_struct, print_otherimm, print_list,
631            print_fixnum, print_otherptr, print_otherimm, print_otherptr};
632     static void (*brief_fns[])(lispobj obj)
633         = {brief_fixnum, brief_struct, brief_otherimm, brief_list,
634            brief_fixnum, brief_otherptr, brief_otherimm, brief_otherptr};
635 #endif
636     int type = lowtag_of(obj);
637     struct var *var = lookup_by_obj(obj);
638     char buffer[256];
639     boolean verbose = cur_depth < brief_depth;
640
641     if (!continue_p(verbose))
642         return;
643
644     if (var != NULL && var_clock(var) == cur_clock)
645         dont_descend = 1;
646
647     if (var == NULL && is_lisp_pointer(obj))
648         var = define_var(NULL, obj, 0);
649
650     if (var != NULL)
651         var_setclock(var, cur_clock);
652
653     cur_depth++;
654     if (verbose) {
655         if (var != NULL) {
656             sprintf(buffer, "$%s=", var_name(var));
657             newline(buffer);
658         }
659         else
660             newline(NULL);
661         printf("%s0x%08lx: ", prefix, (unsigned long) obj);
662         if (cur_depth < brief_depth) {
663             fputs(lowtag_names[type], stdout);
664             (*verbose_fns[type])(obj);
665         }
666         else
667             (*brief_fns[type])(obj);
668     }
669     else {
670         if (dont_descend)
671             printf("$%s", var_name(var));
672         else {
673             if (var != NULL)
674                 printf("$%s=", var_name(var));
675             (*brief_fns[type])(obj);
676         }
677     }
678     cur_depth--;
679     dont_descend = 0;
680 }
681
682 void reset_printer()
683 {
684     cur_clock++;
685     cur_lines = 0;
686     dont_descend = 0;
687 }
688
689 void print(lispobj obj)
690 {
691     skip_newline = 1;
692     cur_depth = 0;
693     max_depth = 5;
694     max_lines = 20;
695
696     print_obj("", obj);
697
698     putchar('\n');
699 }
700
701 void brief_print(lispobj obj)
702 {
703     skip_newline = 1;
704     cur_depth = 0;
705     max_depth = 1;
706     max_lines = 5000;
707
708     print_obj("", obj);
709     putchar('\n');
710 }
711
712 #else
713
714 void
715 brief_print(lispobj obj)
716 {
717     printf("lispobj 0x%lx\n", (unsigned long)obj);
718 }
719
720 #endif /* defined(LISP_FEATURE_SB_LDB) */