Index: /branches/objc-gf/ccl/level-1/l1-io.lisp
===================================================================
--- /branches/objc-gf/ccl/level-1/l1-io.lisp	(revision 6044)
+++ /branches/objc-gf/ccl/level-1/l1-io.lisp	(revision 6045)
@@ -1564,15 +1564,30 @@
       (if null
 	(progn
-	  (%write-string "A Null Mac Pointer" stream))
+	  (%write-string "A Null Foreign Pointer" stream))
 	(progn
-	  (pp-start-block stream "A Mac Pointer")
-	  (%write-macptr-termination-info macptr stream)
+	  (pp-start-block stream "A Foreign Pointer")
+	  (%write-macptr-allocation-info macptr stream)
 	  (stream-write-char stream #\ )
+          (%write-macptr-type-info macptr stream)
 	  (write-an-integer (%ptr-to-int macptr) stream 16. t))))))
 
-; redefined by macptr-termination.lisp
-(defun %write-macptr-termination-info (macptr stream)
-  (declare (ignore macptr stream)))
-
+(defun %write-macptr-allocation-info (macptr stream)
+  (if (or (on-any-csp-stack macptr)
+          (on-any-tsp-stack macptr))
+    (format stream " [stack-allocated]")
+    (if (eql (uvsize macptr) target::xmacptr.element-count)
+      (format stream " [gcable]"))))
+
+(defun %write-macptr-type-info (macptr stream)
+  (let* ((ordinal (%macptr-type macptr)))
+    (unless (eql 0 ordinal)
+      (let* ((type (gethash ordinal (ftd-ordinal-types *target-ftd*)))
+             (form
+              (if (typep type 'foreign-record-type)
+                `(:* (,(foreign-record-type-kind type)
+                        ,(foreign-record-type-name type)))
+                `(:* ,(unparse-foreign-type type)))))
+        (when form (format stream "~s " form))))))
+