/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- weakvector_print
- weakvector_finalize
- Scm_MakeWeakVector
- Scm_WeakVectorRef
- Scm_WeakVectorSet
- wbox_setvalue
- Scm_MakeWeakBox
- Scm_WeakBoxEmptyP
- Scm_WeakBoxSet
- Scm_WeakBoxRef
1 /*
2 * weak.c - weak vectors and tables
3 *
4 * Copyright (c) 2000-2005 Shiro Kawai, All rights reserved.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * 3. Neither the name of the authors nor the names of its contributors
18 * may be used to endorse or promote products derived from this
19 * software without specific prior written permission.
20 *
21 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 *
33 * $Id: weak.c,v 1.12 2005/07/30 21:37:11 shirok Exp $
34 */
35
36 #define LIBGAUCHE_BODY
37 #include "gauche.h"
38
39 /*=============================================================
40 * Weak vector
41 *
42 * A weak vector is like a vector of Scheme objects, except
43 * it doesn't prevent the referenced objects to be garbage-collected.
44 * Internally, it is implemented using "disappearing link" feature
45 * of Boehm GC; when the referenced object is collected, the pointer
46 * in the vector is set to NULL.
47 * It is important to keep track of whether the entry of the vector
48 * is registered as a disappearing link or not, for you can't register
49 * the same location more than once.
50 */
51
52 static void weakvector_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
53 {
54 int i;
55 ScmWeakVector *v = SCM_WEAK_VECTOR(obj);
56 ScmObj *ptrs = (ScmObj*)v->pointers;
57 Scm_Printf(port, "#,(<weak-vector> %d", v->size);
58 for (i=0; i<v->size; i++) {
59 SCM_PUTC(' ', port);
60 if (ptrs[i]) Scm_Write(ptrs[i], SCM_OBJ(port), ctx->mode);
61 else Scm_Write(SCM_FALSE, SCM_OBJ(port), ctx->mode);
62 }
63 SCM_PUTC(')', port);
64 }
65
66 static void weakvector_finalize(ScmObj obj, void *data)
67 {
68 int i;
69 ScmWeakVector *v = SCM_WEAK_VECTOR(obj);
70 ScmObj *p = (ScmObj*)v->pointers;
71 for (i=0; i<v->size; i++) {
72 if (p[i]==NULL || SCM_PTRP(p[i])) {
73 GC_unregister_disappearing_link((GC_PTR*)&p[i]);
74 }
75 p[i] = SCM_FALSE; /* safety */
76 }
77 }
78
79 SCM_DEFINE_BUILTIN_CLASS(Scm_WeakVectorClass, weakvector_print,
80 NULL, NULL, NULL,
81 SCM_CLASS_SEQUENCE_CPL);
82
83 ScmObj Scm_MakeWeakVector(int size)
84 {
85 int i;
86 ScmObj *p;
87 ScmWeakVector *v = SCM_NEW(ScmWeakVector);
88
89 SCM_SET_CLASS(v, SCM_CLASS_WEAK_VECTOR);
90 v->size = size;
91 /* Allocate pointer array by ATOMIC, so that GC won't trace the
92 pointers in it. */
93 p = SCM_NEW_ATOMIC2(ScmObj*, size * sizeof(ScmObj));
94 for (i=0; i<size; i++) p[i] = SCM_FALSE;
95 v->pointers = (void*)p;
96 Scm_RegisterFinalizer(SCM_OBJ(v), weakvector_finalize, NULL);
97 return SCM_OBJ(v);
98 }
99
100 ScmObj Scm_WeakVectorRef(ScmWeakVector *v, int index, ScmObj fallback)
101 {
102 ScmObj *p;
103 if (index < 0 || index >= v->size) {
104 if (SCM_UNBOUNDP(fallback)) {
105 Scm_Error("argument out of range: %d", index);
106 } else {
107 return fallback;
108 }
109 }
110 p = (ScmObj*)v->pointers;
111 if (p[index] == NULL) {
112 if (SCM_UNBOUNDP(fallback)) return SCM_FALSE;
113 else return fallback;
114 } else {
115 return p[index];
116 }
117 }
118
119 ScmObj Scm_WeakVectorSet(ScmWeakVector *v, int index, ScmObj value)
120 {
121 ScmObj *p;
122 if (index < 0 || index >= v->size) {
123 Scm_Error("argument out of range: %d", index);
124 }
125 p = (ScmObj*)v->pointers;
126
127 /* unregister the location if it was registered before */
128 if (p[index] == NULL || SCM_PTRP(p[index])) {
129 GC_unregister_disappearing_link((GC_PTR*)&p[index]);
130 }
131
132 p[index] = value;
133 /* register the location if the value is a heap object */
134 if (SCM_PTRP(value)) {
135 GC_general_register_disappearing_link((GC_PTR*)&p[index], (GC_PTR)value);
136 }
137 return SCM_UNDEFINED;
138 }
139
140 /*=============================================================
141 * Weak box
142 */
143
144 /* Weak box is not an ScmObj. It provides a packaged 'weak pointer'
145 feature to C. Weak hash table (hash.c) uses this. */
146
147 /* ptr points to the target object weakly.
148 Registered flag becomes TRUE whenever ptr points to a GC_malloced object,
149 thus &wbox->ptr is registered as a disappearing link.
150 Note that we can distinguish a box that contaning NULL pointer, and
151 a box whose target has been GCed and hence ptr is cleared---in the
152 former case registered is FALSE, while in the latter case it is TRUE. */
153 struct ScmWeakBoxRec {
154 void *ptr;
155 int registered;
156 };
157
158 static void wbox_setvalue(ScmWeakBox *wbox, void *value)
159 {
160 GC_PTR base = GC_base((GC_PTR)value);
161 wbox->ptr = value;
162 if (base != NULL) {
163 GC_general_register_disappearing_link((GC_PTR)&wbox->ptr, base);
164 wbox->registered = TRUE;
165 } else {
166 wbox->registered = FALSE;
167 }
168 }
169
170
171 ScmWeakBox *Scm_MakeWeakBox(void *value)
172 {
173 ScmWeakBox *wbox = SCM_NEW_ATOMIC(ScmWeakBox);
174 wbox_setvalue(wbox, value);
175 return wbox;
176 }
177
178 int Scm_WeakBoxEmptyP(ScmWeakBox *wbox)
179 {
180 return (wbox->registered && wbox->ptr == NULL);
181 }
182
183 void Scm_WeakBoxSet(ScmWeakBox *wbox, void *newvalue)
184 {
185 if (wbox->registered) {
186 GC_unregister_disappearing_link((GC_PTR)&wbox->ptr);
187 wbox->registered = FALSE;
188 }
189 wbox_setvalue(wbox, newvalue);
190 }
191
192 void *Scm_WeakBoxRef(ScmWeakBox *wbox)
193 {
194 return wbox->ptr; /* NB: if NULL is retured, you can't know
195 whether box has been containing NULL or
196 the target is GCed. You have to call
197 Scm_WeakBoxEmptyP to check that. */
198 }
199
200