summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-15 22:33:10 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-15 22:33:10 +0100
commit2a61fbdd27d9a3ff4dea7b2f1f193668b13f2f1b (patch)
treef3b87235ee2a198206467f4e28ddc563fff89ba8
parent2bb2aff46342274f990903b273d4a2545f6f7f9f (diff)
Specialise PRINT-OBJECT for FOREIGN-STRUCT values.
darcs-hash:cbdd6159c27549dcc033b9bf38c0bf4fd8c51054
-rw-r--r--Lisp/data-types.lisp1
-rw-r--r--Lisp/utilities.lisp20
2 files changed, 16 insertions, 5 deletions
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp
index 5d8c22b..cfbfcfb 100644
--- a/Lisp/data-types.lisp
+++ b/Lisp/data-types.lisp
@@ -302,6 +302,7 @@ an __exception__, you can simply send it the `self' message.
(let ((new-wrapper (make-instance (ecase (typespec-primary-type typespec)
(struct 'tagged-struct)
(union 'tagged-union))
+ :name (third typespec)
:typespec typespec
:pointer pointer
:lisp-managed-cell managedp-cell)))
diff --git a/Lisp/utilities.lisp b/Lisp/utilities.lisp
index 8b0ac5c..384c7e2 100644
--- a/Lisp/utilities.lisp
+++ b/Lisp/utilities.lisp
@@ -275,11 +275,21 @@ invocations will return numbers.)
(defmethod print-object ((exception exception) stream)
(print-unreadable-object (exception stream)
- (format stream "~S ~A {~X}"
- (type-of exception)
- (primitive-invoke (primitive-invoke exception "name" 'id)
- "UTF8String" :string)
- (primitive-invoke exception "hash" :unsigned-int))))
+ (with-slots (pointer) exception
+ (format stream "~S ~A {~X}"
+ (type-of exception)
+ (primitive-invoke (primitive-invoke exception "name" 'id)
+ "UTF8String" :string)
+ (cffi:pointer-address pointer)))))
+
+
+(defmethod print-object ((struct foreign-struct) stream)
+ (print-unreadable-object (struct stream)
+ (with-slots (pointer name) struct
+ (format stream "~S of type ~A {~X}"
+ (type-of struct)
+ name
+ (cffi:pointer-address pointer)))))
;;; (@* "Structure and Union Definition")