Changeset 6045

Timestamp:

Mar 15, 2007, 4:28:58 AM (18 years ago)

Author:

Gary Byers

Message:

Macptr printing in the brave new world.

File:

• branches/objc-gf/ccl/level-1/l1-io.lisp (modified) (1 diff)

branches/objc-gf/ccl/level-1/l1-io.lisp

@@ -1564 +1564 @@
       (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))))))
+