Commit | Line | Data |
---|---|---|
8f96789a MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Weak pointers and data structures | |
4 | ;;; | |
5 | ;;; (c) 2008 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
10 | ;;; This program is free software; you can redistribute it and/or modify | |
11 | ;;; it under the terms of the GNU General Public License as published by | |
12 | ;;; the Free Software Foundation; either version 2 of the License, or | |
13 | ;;; (at your option) any later version. | |
14 | ;;; | |
15 | ;;; This program is distributed in the hope that it will be useful, | |
16 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;;; GNU General Public License for more details. | |
19 | ;;; | |
20 | ;;; You should have received a copy of the GNU General Public License | |
21 | ;;; along with this program; if not, write to the Free Software Foundation, | |
22 | ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
23 | ||
24 | (cl:defpackage #:weak | |
25 | (:use #:common-lisp) | |
26 | #+sbcl | |
27 | (:import-from #:sb-ext #:make-weak-pointer #:weak-pointer-value) | |
28 | #+(or cmu clisp) | |
29 | (:import-from #:ext #:make-weak-pointer #:weak-pointer-value) | |
30 | (:export #:make-weak-pointer #:weak-pointer-value)) | |
31 | (cl:in-package #:weak) | |
32 | ||
33 | #+(or allegro common-lispworks) | |
34 | (progn | |
35 | (defun make-weak-pointer (object) | |
36 | (make-array 1 :initial-contents (list object) :weak t)) | |
37 | (defun weak-pointer-value (weak) | |
38 | (aref weak 0))) | |
39 | ||
40 | #+ecl | |
41 | (progn | |
42 | (defun make-weak-pointer (object) | |
43 | (ffi:c-inline (object) (:object) :pointer-void | |
44 | "{ cl_object *weak = GC_malloc_atomic(sizeof(cl_object)); | |
45 | *weak = #0; | |
46 | GC_general_register_disappearing_link(weak, GC_base(#0)); | |
47 | @(return) = weak; }" | |
48 | :one-liner nil)) | |
49 | (defun weak-pointer-value (weak) | |
50 | (ffi:c-inline (weak) (:pointer-void) (values :object :object) | |
51 | "{ cl_object *weak = #0; | |
52 | if (*weak) { @(return 0) = *weak; @(return 1) = @t; } | |
53 | else { @(return 0) = @nil; @(return 1) = @nil; } }" | |
54 | :one-liner nil))) | |
55 | ||
56 | #-(or sbcl cmu clisp allegro common-lispworks ecl) | |
57 | (progn | |
58 | (defun make-weak-pointer (object) object) | |
59 | (defun weak-pointer-value (weak) (values weak t))) | |
60 | ||
61 | ;;;----- That's all, folks -------------------------------------------------- |