diff options
Diffstat (limited to 'Lisp')
| -rw-r--r-- | Lisp/instance-management.lisp | 32 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 8 | ||||
| -rw-r--r-- | Lisp/memory-management.lisp | 5 |
3 files changed, 44 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*) |