0.6.12.2:

[sbcl.git] / src / runtime / print.c

diff --git a/src/runtime/print.c b/src/runtime/print.c
index 3eb97e1..8ff85e8 100644 (file)
--- a/src/runtime/print.c
+++ b/src/runtime/print.c
@@ -12,10 +12,6 @@
  */
 
 /*
- * $Header$
- */
-
-/*
  * FIXME:
  *   1. Ordinary users won't get much out of this code, so it shouldn't
  *      be compiled into the ordinary build of the system. Probably it
@@ -38,11 +34,11 @@ static int max_lines = 20, cur_lines = 0;
 static int max_depth = 5, brief_depth = 2, cur_depth = 0;
 static int max_length = 5;
 static boolean dont_descend = 0, skip_newline = 0;
-static cur_clock = 0;
+static int cur_clock = 0;
 
 static void print_obj(char *prefix, lispobj obj);
 
-#define NEWLINE if (continue_p(1)) newline(NULL); else return;
+#define NEWLINE_OR_RETURN if (continue_p(1)) newline(NULL); else return;
 
 char *lowtag_Names[] = {
     "even fixnum",
@@ -281,7 +277,7 @@ static void print_otherimm(lispobj obj)
             break;
 
         default:
-            printf(": data=%ld", (obj>>8)&0xffffff);
+            printf(": data=%ld", (long) (obj>>8)&0xffffff);
             break;
     }
 }
@@ -338,7 +334,7 @@ static void print_list(lispobj obj)
 static void brief_struct(lispobj obj)
 {
     printf("#<ptr to 0x%08lx instance>",
-           ((struct instance *)PTR(obj))->slots[0]);
+           (unsigned long) ((struct instance *)PTR(obj))->slots[0]);
 }
 
 static void print_struct(lispobj obj)
@@ -454,7 +450,7 @@ static void print_otherptr(lispobj obj)
 
         print_obj("header: ", header);
         if (LowtagOf(header) != type_OtherImmediate0 && LowtagOf(header) != type_OtherImmediate1) {
-            NEWLINE;
+            NEWLINE_OR_RETURN;
             printf("(invalid header object)");
             return;
         }
@@ -462,10 +458,10 @@ static void print_otherptr(lispobj obj)
         switch (type) {
             case type_Bignum:
                 ptr += count;
-                NEWLINE;
+                NEWLINE_OR_RETURN;
                 printf("0x");
                 while (count-- > 0)
-                    printf("%08lx", *--ptr);
+                    printf("%08lx", (unsigned long) *--ptr);
                 break;
 
             case type_Ratio:
@@ -481,51 +477,51 @@ static void print_otherptr(lispobj obj)
                 break;
 
             case type_SingleFloat:
-                NEWLINE;
+                NEWLINE_OR_RETURN;
                 printf("%g", ((struct single_float *)PTR(obj))->value);
                 break;
 
             case type_DoubleFloat:
-                NEWLINE;
+                NEWLINE_OR_RETURN;
                 printf("%g", ((struct double_float *)PTR(obj))->value);
                 break;
 
 #ifdef type_LongFloat
             case type_LongFloat:
-                NEWLINE;
+                NEWLINE_OR_RETURN;
                 printf("%Lg", ((struct long_float *)PTR(obj))->value);
                 break;
 #endif
 
 #ifdef type_ComplexSingleFloat
             case type_ComplexSingleFloat:
-                NEWLINE;
+                NEWLINE_OR_RETURN;
                 printf("%g", ((struct complex_single_float *)PTR(obj))->real);
-                NEWLINE;
+                NEWLINE_OR_RETURN;
                 printf("%g", ((struct complex_single_float *)PTR(obj))->imag);
                 break;
 #endif
 
 #ifdef type_ComplexDoubleFloat
             case type_ComplexDoubleFloat:
-                NEWLINE;
+                NEWLINE_OR_RETURN;
                 printf("%g", ((struct complex_double_float *)PTR(obj))->real);
-                NEWLINE;
+                NEWLINE_OR_RETURN;
                 printf("%g", ((struct complex_double_float *)PTR(obj))->imag);
                 break;
 #endif
 
 #ifdef type_ComplexLongFloat
             case type_ComplexLongFloat:
-                NEWLINE;
+                NEWLINE_OR_RETURN;
                 printf("%Lg", ((struct complex_long_float *)PTR(obj))->real);
-                NEWLINE;
+                NEWLINE_OR_RETURN;
                 printf("%Lg", ((struct complex_long_float *)PTR(obj))->imag);
                 break;
 #endif
 
             case type_SimpleString:
-                NEWLINE;
+                NEWLINE_OR_RETURN;
                 cptr = (char *)(ptr+1);
                 putchar('"');
                 while (length-- > 0)
@@ -534,8 +530,7 @@ static void print_otherptr(lispobj obj)
                 break;
 
             case type_SimpleVector:
-            case type_InstanceHeader:
-                NEWLINE;
+                NEWLINE_OR_RETURN;
                 printf("length = %ld", length);
                 ptr++;
                 index = 0;
@@ -545,6 +540,16 @@ static void print_otherptr(lispobj obj)
                 }
                 break;
 
+            case type_InstanceHeader:
+                NEWLINE_OR_RETURN;
+                printf("length = %ld", (long) count);
+                index = 0;
+                while (count-- > 0) {
+                    sprintf(buffer, "%d: ", index++);
+                    print_obj(buffer, *ptr++);
+                }
+                break;
+
             case type_SimpleArray:
             case type_SimpleBitVector:
             case type_SimpleArrayUnsignedByte2:
@@ -610,11 +615,11 @@ static void print_otherptr(lispobj obj)
                 break;
 
             case type_Sap:
-                NEWLINE;
+                NEWLINE_OR_RETURN;
 #ifndef alpha
-                printf("0x%08lx", *ptr);
+                printf("0x%08lx", (unsigned long) *ptr);
 #else
-                printf("0x%016lx", *(long*)(ptr+1));
+                printf("0x%016lx", *(lispobj*)(ptr+1));
 #endif
                 break;
 
@@ -624,7 +629,7 @@ static void print_otherptr(lispobj obj)
 
             case type_BaseChar:
             case type_UnboundMarker:
-                NEWLINE;
+                NEWLINE_OR_RETURN;
                 printf("pointer to an immediate?");
                 break;
 
@@ -633,7 +638,7 @@ static void print_otherptr(lispobj obj)
                break;
                
             default:
-                NEWLINE;
+                NEWLINE_OR_RETURN;
                 printf("Unknown header object?");
                 break;
         }
@@ -674,7 +679,7 @@ static void print_obj(char *prefix, lispobj obj)
         }
         else
             newline(NULL);
-        printf("%s0x%08lx: ", prefix, obj);
+        printf("%s0x%08lx: ", prefix, (unsigned long) obj);
         if (cur_depth < brief_depth) {
             fputs(lowtag_Names[type], stdout);
             (*verbose_fns[type])(obj);