Printer addresses

src/c/printer/print_unreadable.d

@@ -14,34 +14,47 @@
 #include <ecl/internal.h>
 
 void
-_ecl_write_addr(cl_object x, cl_object stream)
+_ecl_write_addr(void *x, cl_object stream)
 {
   cl_fixnum i, j;
+  int print_zeros = 0;
 
   i = (cl_index)x;
+
+  if (i == 0) {
+    writestr_stream("0x0", stream);
+    return;
+  }
+  writestr_stream("0x", stream);
   for (j = sizeof(i)*8-4;  j >= 0;  j -= 4) {
     int k = (i>>j) & 0xf;
-    if (k < 10)
+    if (!print_zeros && k == 0) {
+      ;
+    } else if (k < 10) {
+      print_zeros = 1;
       ecl_write_char('0' + k, stream);
-    else
+    } else {
+      print_zeros = 1;
       ecl_write_char('a' + k - 10, stream);
+    }
   }
 }
 
 void
 _ecl_write_unreadable(cl_object x, const char *prefix, cl_object name, cl_object stream)
 {
-  if (ecl_print_readably())
+  if (ecl_print_readably()) {
     FEprint_not_readable(x);
+  }
   ecl_write_char('#', stream);
   ecl_write_char('<', stream);
   writestr_stream(prefix, stream);
   ecl_write_char(' ', stream);
   if (!Null(name)) {
     si_write_ugly_object(name, stream);
-  } else {
-    _ecl_write_addr(x, stream);
+    ecl_write_char(' ', stream);
   }
+  _ecl_write_addr((void *)x, stream);
   ecl_write_char('>', stream);
 }
 
@@ -71,7 +84,7 @@ si_print_unreadable_object_function(cl_object o, cl_object stream, cl_object typ
     }
     if (!Null(id)) {
       ecl_write_char(' ', stream);
-      _ecl_write_addr(o, stream);
+      _ecl_write_addr((void *)o, stream);
     }
     ecl_write_char('>', stream);
   }

src/c/printer/write_array.d

@@ -39,7 +39,7 @@ write_array_inner(bool vector, cl_object x, cl_object stream)
   } else {
     if (!ecl_print_array()) {
       writestr_stream(vector? "#<vector " : "#<array ", stream);
-      _ecl_write_addr(x, stream);
+      _ecl_write_addr((void *)x, stream);
       ecl_write_char('>', stream);
       return;
     }
@@ -189,7 +189,7 @@ _ecl_write_bitvector(cl_object x, cl_object stream)
 {
   if (!ecl_print_array() && !ecl_print_readably()) {
     writestr_stream("#<bit-vector ", stream);
-    _ecl_write_addr(x, stream);
+    _ecl_write_addr((void *)x, stream);
     ecl_write_char('>', stream);
   } else {
     cl_index ndx;

src/c/printer/write_code.d

@@ -33,13 +33,7 @@ _ecl_write_bytecodes(cl_object x, cl_object stream)
                                  x->bytecodes.file_position),
                          stream);
   } else {
-    cl_object name = x->bytecodes.name;
-    writestr_stream("#<bytecompiled-function ", stream);
-    if (name != ECL_NIL)
-      si_write_ugly_object(name, stream);
-    else
-      _ecl_write_addr(x, stream);
-    ecl_write_char('>', stream);
+    _ecl_write_unreadable(x, "bytecompiled-function", x->bytecodes.name, stream);
   }
 }
 
@@ -58,10 +52,11 @@ _ecl_write_bclosure(cl_object x, cl_object stream)
   } else {
     cl_object name = x->bytecodes.name;
     writestr_stream("#<bytecompiled-closure ", stream);
-    if (name != ECL_NIL)
+    if (name != ECL_NIL) {
       si_write_ugly_object(name, stream);
-    else
-      _ecl_write_addr(x, stream);
+    } else {
+      _ecl_write_addr((void *)x, stream);
+    }
     ecl_write_char('>', stream);
   }
 }

src/c/printer/write_ugly.d

@@ -329,7 +329,18 @@ write_cclosure(cl_object x, cl_object stream)
 static void
 write_foreign(cl_object x, cl_object stream)
 {
-  _ecl_write_unreadable(x, "foreign", x->foreign.tag, stream);
+  if (ecl_print_readably()) {
+    FEprint_not_readable(x);
+  }
+  writestr_stream("#<foreign ", stream);
+  si_write_ugly_object(x->foreign.tag, stream);
+  ecl_write_char(' ', stream);
+  if (x->foreign.data == NULL) {
+    writestr_stream("NULL", stream);
+  } else {
+    _ecl_write_addr((void *)x->foreign.data, stream);
+  }
+  ecl_write_char('>', stream);
 }
 
 static void

src/h/internal.h

@@ -340,7 +340,7 @@ extern cl_fixnum ecl_option_values[ECL_OPT_LIMIT+1];
 /* print.d */
 
 extern cl_object _ecl_stream_or_default_output(cl_object stream);
-extern void _ecl_write_addr(cl_object x, cl_object stream);
+extern void _ecl_write_addr(void *x, cl_object stream);
 extern void _ecl_write_array(cl_object o, cl_object stream);
 extern void _ecl_write_vector(cl_object o, cl_object stream);
 extern void _ecl_write_bitvector(cl_object o, cl_object stream);