Commit | Line | Data |
---|---|---|
7b327550 AW |
1 | /* Copyright (C) 2012 Free Software Foundation, Inc. |
2 | * | |
3 | * This library is free software; you can redistribute it and/or | |
4 | * modify it under the terms of the GNU Lesser General Public License | |
5 | * as published by the Free Software Foundation; either version 3 of | |
6 | * the License, or (at your option) any later version. | |
7 | * | |
8 | * This library is distributed in the hope that it will be useful, but | |
9 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
11 | * Lesser General Public License for more details. | |
12 | * | |
13 | * You should have received a copy of the GNU Lesser General Public | |
14 | * License along with this library; if not, write to the Free Software | |
15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA | |
16 | * 02110-1301 USA | |
17 | */ | |
18 | ||
19 | ||
20 | \f | |
21 | ||
22 | #ifdef HAVE_CONFIG_H | |
23 | # include <config.h> | |
24 | #endif | |
25 | ||
26 | #include "libguile/bdw-gc.h" | |
27 | #include "libguile/_scm.h" | |
28 | #include "libguile/finalizers.h" | |
29 | #include "libguile/gc.h" | |
30 | #include "libguile/threads.h" | |
31 | ||
32 | \f | |
33 | ||
f740445a AW |
34 | static size_t finalization_count; |
35 | ||
36 | ||
37 | \f | |
38 | ||
7b327550 AW |
39 | void |
40 | scm_i_set_finalizer (void *obj, scm_t_finalizer_proc proc, void *data) | |
41 | { | |
42 | GC_finalization_proc prev; | |
6922d92f | 43 | void *prev_data; |
7b327550 AW |
44 | GC_REGISTER_FINALIZER_NO_ORDER (obj, proc, data, &prev, &prev_data); |
45 | } | |
46 | ||
47 | struct scm_t_chained_finalizer | |
48 | { | |
49 | int resuscitating_p; | |
50 | scm_t_finalizer_proc proc; | |
51 | void *data; | |
52 | scm_t_finalizer_proc prev; | |
53 | void *prev_data; | |
54 | }; | |
55 | ||
56 | static void | |
57 | chained_finalizer (void *obj, void *data) | |
58 | { | |
59 | struct scm_t_chained_finalizer *chained_data = data; | |
60 | if (chained_data->resuscitating_p) | |
61 | { | |
62 | if (chained_data->prev) | |
63 | scm_i_set_finalizer (obj, chained_data->prev, chained_data->prev_data); | |
64 | chained_data->proc (obj, chained_data->data); | |
65 | } | |
66 | else | |
67 | { | |
68 | chained_data->proc (obj, chained_data->data); | |
69 | if (chained_data->prev) | |
70 | chained_data->prev (obj, chained_data->prev_data); | |
71 | } | |
72 | } | |
73 | ||
74 | void | |
75 | scm_i_add_resuscitator (void *obj, scm_t_finalizer_proc proc, void *data) | |
76 | { | |
77 | struct scm_t_chained_finalizer *chained_data; | |
78 | chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer"); | |
79 | chained_data->resuscitating_p = 1; | |
80 | chained_data->proc = proc; | |
81 | chained_data->data = data; | |
82 | GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data, | |
83 | &chained_data->prev, | |
84 | &chained_data->prev_data); | |
85 | } | |
86 | ||
87 | static void | |
88 | shuffle_resuscitators_to_front (struct scm_t_chained_finalizer *cd) | |
89 | { | |
90 | while (cd->prev == chained_finalizer) | |
91 | { | |
92 | struct scm_t_chained_finalizer *prev = cd->prev_data; | |
93 | scm_t_finalizer_proc proc = cd->proc; | |
94 | void *data = cd->data; | |
95 | ||
96 | if (!prev->resuscitating_p) | |
97 | break; | |
98 | ||
99 | cd->resuscitating_p = 1; | |
100 | cd->proc = prev->proc; | |
101 | cd->data = prev->data; | |
102 | ||
103 | prev->resuscitating_p = 0; | |
104 | prev->proc = proc; | |
105 | prev->data = data; | |
106 | ||
107 | cd = prev; | |
108 | } | |
109 | } | |
110 | ||
111 | void | |
112 | scm_i_add_finalizer (void *obj, scm_t_finalizer_proc proc, void *data) | |
113 | { | |
114 | struct scm_t_chained_finalizer *chained_data; | |
115 | chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer"); | |
116 | chained_data->resuscitating_p = 0; | |
117 | chained_data->proc = proc; | |
118 | chained_data->data = data; | |
119 | GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data, | |
120 | &chained_data->prev, | |
121 | &chained_data->prev_data); | |
122 | shuffle_resuscitators_to_front (chained_data); | |
123 | } | |
124 | ||
f740445a AW |
125 | |
126 | \f | |
127 | ||
128 | static SCM finalizer_async_cell; | |
129 | ||
130 | static SCM | |
131 | run_finalizers_async_thunk (void) | |
132 | { | |
133 | finalization_count += GC_invoke_finalizers (); | |
134 | return SCM_UNSPECIFIED; | |
135 | } | |
136 | ||
137 | ||
138 | /* The function queue_finalizer_async is run by the GC when there are | |
139 | * objects to finalize. It will enqueue an asynchronous call to | |
140 | * GC_invoke_finalizers() at the next SCM_TICK in this thread. | |
141 | */ | |
142 | static void | |
143 | queue_finalizer_async (void) | |
144 | { | |
145 | scm_i_thread *t = SCM_I_CURRENT_THREAD; | |
146 | static scm_i_pthread_mutex_t lock = SCM_I_PTHREAD_MUTEX_INITIALIZER; | |
147 | ||
148 | scm_i_pthread_mutex_lock (&lock); | |
149 | /* If t is NULL, that could be because we're allocating in | |
150 | threads.c:guilify_self_1. In that case, rely on the | |
151 | GC_invoke_finalizers call there after the thread spins up. */ | |
152 | if (t && scm_is_false (SCM_CDR (finalizer_async_cell))) | |
153 | { | |
154 | SCM_SETCDR (finalizer_async_cell, t->active_asyncs); | |
155 | t->active_asyncs = finalizer_async_cell; | |
156 | t->pending_asyncs = 1; | |
157 | } | |
158 | scm_i_pthread_mutex_unlock (&lock); | |
159 | } | |
160 | ||
161 | ||
7b327550 AW |
162 | \f |
163 | ||
f740445a AW |
164 | #ifndef HAVE_GC_SET_FINALIZER_NOTIFIER |
165 | static void | |
166 | GC_set_finalizer_notifier (void (*notifier) (void)) | |
167 | { | |
168 | GC_finalizer_notifier = notifier; | |
169 | } | |
170 | #endif | |
7b327550 AW |
171 | |
172 | void | |
173 | scm_init_finalizers (void) | |
174 | { | |
f740445a AW |
175 | /* When the async is to run, the cdr of the pair gets set to the |
176 | asyncs queue of the current thread. */ | |
177 | finalizer_async_cell = | |
178 | scm_cons (scm_c_make_gsubr ("%run-finalizers", 0, 0, 0, | |
179 | run_finalizers_async_thunk), | |
180 | SCM_BOOL_F); | |
181 | GC_set_finalizer_notifier (queue_finalizer_async); | |
7b327550 | 182 | } |