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

Contents of /src/code/weak.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (show annotations)
Fri Mar 19 15:19:00 2010 UTC (4 years, 1 month ago) by rtoy
Branch: MAIN
CVS Tags: post-merge-intl-branch, snapshot-2010-04
Changes since 1.6: +7 -5 lines
Merge intl-branch 2010-03-18 to HEAD.  To build, you need to use
boot-2010-02-1 as the bootstrap file.  You should probably also use
the new -P option for build.sh to generate and update the po files
while building.
1 ;;; -*- Mode: Lisp; Package: EXTENSIONS; Log: code.log -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;; 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 "$Header: /tiger/var/lib/cvsroots/cmucl/src/code/weak.lisp,v 1.7 2010/03/19 15:19:00 rtoy Exp $")
9 ;;;
10 ;;; **********************************************************************
11 ;;;
12 ;;; $Header: /tiger/var/lib/cvsroots/cmucl/src/code/weak.lisp,v 1.7 2010/03/19 15:19:00 rtoy Exp $
13 ;;;
14 ;;; Weak Pointer Support.
15 ;;;
16 ;;; Written by Christopher Hoover.
17 ;;;
18
19 (in-package "EXTENSIONS")
20
21 (intl:textdomain "cmucl")
22
23 (export '(weak-pointer weak-pointer-p make-weak-pointer weak-pointer-value))
24
25 (defun make-weak-pointer (object)
26 _N"Allocates and returns a weak pointer which points to OBJECT."
27 (declare (values weak-pointer))
28 (make-weak-pointer object))
29
30 (declaim (inline weak-pointer-value))
31 (defun weak-pointer-value (weak-pointer)
32 _N"If WEAK-POINTER is valid, returns the value of WEAK-POINTER and T.
33 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
45 (declaim (inline (setf weak-pointer-value)))
46 (defun (setf weak-pointer-value) (object weak-pointer)
47 _N"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 ;;; 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 (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