/[cmucl]/src/code/weak.lisp
ViewVC logotype

Contents of /src/code/weak.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6.48.1 - (hide annotations)
Mon Feb 8 17:15:49 2010 UTC (4 years, 2 months ago) by rtoy
Branch: intl-branch
Changes since 1.6: +4 -2 lines
Add (intl:textdomain "cmucl") to the files to set the textdomain.
1 ch 1.1 ;;; -*- Mode: Lisp; Package: EXTENSIONS; Log: code.log -*-
2     ;;;
3     ;;; **********************************************************************
4 ram 1.2 ;;; This code was written as part of the CMU Common Lisp project at
5     ;;; Carnegie Mellon University, and has been placed in the public domain.
6     ;;;
7     (ext:file-comment
8 rtoy 1.6.48.1 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/weak.lisp,v 1.6.48.1 2010/02/08 17:15:49 rtoy Exp $")
9 ram 1.2 ;;;
10 ch 1.1 ;;; **********************************************************************
11     ;;;
12 rtoy 1.6.48.1 ;;; $Header: /tiger/var/lib/cvsroots/cmucl/src/code/weak.lisp,v 1.6.48.1 2010/02/08 17:15:49 rtoy Exp $
13 ch 1.1 ;;;
14     ;;; Weak Pointer Support.
15     ;;;
16     ;;; Written by Christopher Hoover.
17     ;;;
18    
19     (in-package "EXTENSIONS")
20    
21 rtoy 1.6.48.1 (intl:textdomain "cmucl")
22    
23 ch 1.1 (export '(weak-pointer weak-pointer-p make-weak-pointer weak-pointer-value))
24    
25     (defun make-weak-pointer (object)
26     "Allocates and returns a weak pointer which points to OBJECT."
27 wlott 1.3 (declare (values weak-pointer))
28     (make-weak-pointer object))
29 ch 1.1
30 wlott 1.3 (declaim (inline weak-pointer-value))
31 ch 1.1 (defun weak-pointer-value (weak-pointer)
32     "If WEAK-POINTER is valid, returns the value of WEAK-POINTER and T.
33 wlott 1.3 If the referent of WEAK-POINTER has been garbage collected, returns
34     the values NIL and NIL."
35     (declare (type weak-pointer weak-pointer)
36     (values t (member t nil)))
37     ;; We don't need to wrap this with a without-gcing, because once we have
38     ;; extracted the value, our reference to it will keep the weak pointer
39     ;; from becoming broken. We just have to make sure the compiler won't
40     ;; reorder these primitives.
41     (let ((value (c::%weak-pointer-value weak-pointer))
42     (broken (c::%weak-pointer-broken weak-pointer)))
43     (values value (not broken))))
44 pw 1.5
45 gerd 1.6 (declaim (inline (setf weak-pointer-value)))
46     (defun (setf weak-pointer-value) (object weak-pointer)
47     "Updates WEAK-POINTER to point to a new object."
48     (declare (type weak-pointer weak-pointer))
49     (c::%set-weak-pointer-broken weak-pointer nil)
50     (c::%set-weak-pointer-value weak-pointer object))
51    
52 pw 1.5 ;;; For the interpreter..
53    
54     (defun c::%weak-pointer-value (w)
55     (declare (type weak-pointer w))
56     (c::%weak-pointer-value w))
57    
58     (defun c::%weak-pointer-broken (w)
59     (declare (type weak-pointer w))
60     (c::%weak-pointer-broken w))
61    
62 gerd 1.6 (defun c::%set-weak-pointer-value (w v)
63     (declare (type weak-pointer w))
64     (c::%set-weak-pointer-value w v))
65    
66     (defun c::%set-weak-pointer-broken (w v)
67     (declare (type weak-pointer w) (type boolean v))
68     (c::%set-weak-pointer-broken w v))

  ViewVC Help
Powered by ViewVC 1.1.5