summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-02-16 21:58:48 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-02-16 21:58:48 +0100
commitc61f86dce1eb244fb775e74043070e32e6fdcaaf (patch)
tree7c6d0a4763921321c331462e8e9b925a8fa34beb
parent23aeccec01d4e888885cca03c6557f2f0542ab0c (diff)
Add module: instance-management.
darcs-hash:79549f0b837006321061a524ad376df397a9ab5a
-rw-r--r--Lisp/instance-management.lisp32
-rw-r--r--Lisp/libobjcl.lisp8
-rw-r--r--Lisp/memory-management.lisp5
-rw-r--r--Objective-C/libobjcl.h3
-rw-r--r--Objective-C/libobjcl.m7
-rw-r--r--objective-cl.asd4
6 files changed, 58 insertions, 1 deletions
diff --git a/Lisp/instance-management.lisp b/Lisp/instance-management.lisp
new file mode 100644
index 0000000..c8abb44
--- /dev/null
+++ b/Lisp/instance-management.lisp
@@ -0,0 +1,32 @@
+;;;; Objective-CL, an Objective-C bridge for Common Lisp.
+;;;; Copyright (C) 2007, 2008 Matthias Andreas Benkard.
+;;;;
+;;;; This program is free software: you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public License
+;;;; as published by the Free Software Foundation, either version 3 of
+;;;; the License, or (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful, but
+;;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this program. If not, see
+;;;; <http://www.gnu.org/licenses/>.
+
+(in-package #:mulk.objective-cl)
+
+
+(defvar *lisp-managed-instances* (make-hash-table :test 'eql))
+
+(defun intern-lisp-managed-foreign-instance (&rest initargs &key pointer)
+ (let ((key (cffi:pointer-address pointer)))
+ (or (gethash key *lisp-managed-instances* nil)
+ (apply #'make-instance
+ (intern-pointer-wrapper (%objcl-object-get-class pointer))
+ initargs))))
+
+(defun unintern-lisp-managed-foreign-instance (instance)
+ (remhash (cffi:pointer-address (pointer-to instance))
+ *lisp-managed-instances*))
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index 8cb490b..da85f31 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -167,6 +167,11 @@
(class :pointer)
(backed-p :int))
+(defcfun ("objcl_object_backed_by_lisp_class_p"
+ %objcl-object-backed-by-lisp-class-p)
+ :int
+ (class :pointer))
+
(defcvar *objcl-current-exception-lock* :pointer)
(defcvar *objcl-current-exception* :pointer)
@@ -884,3 +889,6 @@ separating parts by hyphens works nicely in all of the `:INVERT`,
(defun objcl-class-set-backed-by-lisp-class/pointer (class-ptr backed-p)
(%objcl-class-set-backed-by-lisp-class class-ptr (if backed-p 1 0)))
+
+(defun objcl-object-backed-by-lisp-class-p/pointer (object-ptr)
+ (not (zerop (%objcl-object-backed-by-lisp-class-p object-ptr))))
diff --git a/Lisp/memory-management.lisp b/Lisp/memory-management.lisp
index 3d4685d..b625b8f 100644
--- a/Lisp/memory-management.lisp
+++ b/Lisp/memory-management.lisp
@@ -37,7 +37,10 @@
(find-objc-meta-class-by-name (%objcl-class-name pointer))))
((%objcl-object-is-class pointer)
(return-from intern-pointer-wrapper
- (find-objc-class-by-name (%objcl-class-name pointer))))))
+ (find-objc-class-by-name (%objcl-class-name pointer))))
+ ((objcl-object-backed-by-lisp-class-p/pointer pointer)
+ (return-from intern-pointer-wrapper
+ (apply #'intern-lisp-managed-foreign-instance initargs)))))
(let* ((hash-table (ecase class
((id) *id-objects*)
((exception) *exception-objects*)
diff --git a/Objective-C/libobjcl.h b/Objective-C/libobjcl.h
index 26dca23..4b26fae 100644
--- a/Objective-C/libobjcl.h
+++ b/Objective-C/libobjcl.h
@@ -193,3 +193,6 @@ objcl_class_backed_by_lisp_class_p (Class class);
void
objcl_class_set_backed_by_lisp_class (Class class, int backed_p);
+
+int
+objcl_object_backed_by_lisp_class_p (id object);
diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m
index 141c069..cd35b86 100644
--- a/Objective-C/libobjcl.m
+++ b/Objective-C/libobjcl.m
@@ -797,3 +797,10 @@ objcl_class_set_backed_by_lisp_class (Class class, int backed_p)
{
[class __objcl_setBackedByLispClass: backed_p];
}
+
+
+int
+objcl_object_backed_by_lisp_class_p (id object)
+{
+ return [[object class] __objcl_isBackedByLispClass];
+}
diff --git a/objective-cl.asd b/objective-cl.asd
index 9420f95..d595746 100644
--- a/objective-cl.asd
+++ b/objective-cl.asd
@@ -80,6 +80,10 @@
"init"
"method-invocation"
"data-types"))
+ (:file "instance-management" :depends-on ("defpackage"
+ "libobjcl"
+ "init"
+ "method-invocation"))
(:file "compiler-macros" :depends-on ("defpackage"
"method-invocation"
"conditions")))))