diff options
| -rw-r--r-- | Lisp/instance-management.lisp | 32 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 8 | ||||
| -rw-r--r-- | Lisp/memory-management.lisp | 5 | ||||
| -rw-r--r-- | Objective-C/libobjcl.h | 3 | ||||
| -rw-r--r-- | Objective-C/libobjcl.m | 7 | ||||
| -rw-r--r-- | objective-cl.asd | 4 |
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"))))) |