1 /* timers.c -- call a function after a period of time has passed
2 Copyright (C) 1999 John Harper <john@dcs.warwick.ac.uk>
3 $Id$
4
5 This file is part of librep.
6
7 librep is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
11
12 librep is distributed in the hope that it will be useful, but
13 WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with librep; see the file COPYING. If not, write to
19 the Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */
20
21 #define _GNU_SOURCE
22
23 /* AIX requires this to be the first thing in the file. */
24 #include <config.h>
25 #ifdef __GNUC__
26 # define alloca __builtin_alloca
27 #else
28 # if HAVE_ALLOCA_H
29 # include <alloca.h>
30 # else
31 # ifdef _AIX
32 #pragma alloca
33 # else
34 # ifndef alloca /* predefined by HP cc +Olibcalls */
35 char *alloca ();
36 # endif
37 # endif
38 # endif
39 #endif
40
41 #include "repint.h"
42 #include <signal.h>
43 #include <time.h>
44 #include <assert.h>
45
46 #ifdef HAVE_UNISTD_H
47 # include <unistd.h>
48 #endif
49
50 #ifdef HAVE_SYS_TIME_H
51 # include <sys/time.h>
52 #endif
53
54 static int timer_type;
55
56 #define TIMER(v) ((Lisp_Timer *)rep_PTR(v))
57 #define TIMERP(v) rep_CELL16_TYPEP(v, timer_type)
58
59 typedef struct lisp_timer {
60 repv car;
61 struct lisp_timer *next;
62 struct lisp_timer *next_alloc;
63 repv function;
64 long secs, msecs;
65 long rel_secs, rel_msecs;
66 unsigned int fired : 1;
67 unsigned int deleted : 1;
68 } Lisp_Timer;
69
70 /* List of all allocated timer objects, linked through next_alloc field */
71 static Lisp_Timer *allocated_timers;
72
73 /* List of all pending timers, linked through next field. Only ever
74 touch this variable if SIGALRM is blocked! */
75 static Lisp_Timer *timer_chain;
76
77 /* Pipe used to trigger the input callback */
78 static int pipe_fds[2];
79
80 /* Contains SIGALRM */
81 static sigset_t alrm_sigset;
82
83
84
85 static RETSIGTYPE
timer_signal_handler(int sig)86 timer_signal_handler (int sig)
87 {
88 int dummy = 0;
89 Lisp_Timer *t = timer_chain;
90 assert (t != 0);
91 t->rel_secs = t->rel_msecs = 0;
92 while (t != 0 && t->rel_secs == 0 && t->rel_msecs == 0)
93 {
94 t->fired = 1;
95 t = t->next;
96 }
97 write (pipe_fds[1], &dummy, sizeof (dummy));
98 }
99
100 /* only call with SIGALRM blocked */
101 static void
setup_next_timer(void)102 setup_next_timer (void)
103 {
104 if (timer_chain != 0
105 && (timer_chain->rel_secs > 0 || timer_chain->rel_msecs > 0))
106 {
107 #ifdef HAVE_SETITIMER
108 struct itimerval it, tem;
109 it.it_interval.tv_usec = 0;
110 it.it_interval.tv_sec = 0;
111 it.it_value.tv_usec = timer_chain->rel_msecs * 1000;
112 it.it_value.tv_sec = timer_chain->rel_secs;
113 setitimer (ITIMER_REAL, &it, &tem);
114 #else
115 alarm (timer_chain->secs);
116 #endif
117 signal (SIGALRM, timer_signal_handler);
118 }
119 else
120 signal (SIGALRM, SIG_IGN);
121 }
122
123 static inline void
fix_time(long * secs,long * msecs)124 fix_time (long *secs, long *msecs)
125 {
126 while (*msecs < 0)
127 {
128 *msecs += 1000;
129 (*secs)--;
130 }
131 while (*msecs >= 1000)
132 {
133 *msecs -= 1000;
134 (*secs)++;
135 }
136 }
137
138 static void
insert_timer(Lisp_Timer * t)139 insert_timer (Lisp_Timer *t)
140 {
141 sigset_t old;
142 sigprocmask (SIG_BLOCK, &alrm_sigset, &old);
143 if (t->secs > 0 || t->msecs > 0)
144 {
145 Lisp_Timer **x;
146 t->rel_secs = t->secs;
147 t->rel_msecs = t->msecs;
148 t->fired = 0;
149 t->deleted = 0;
150 x = &timer_chain;
151 while (*x != 0
152 && ((*x)->rel_secs < t->rel_secs
153 || ((*x)->rel_secs == t->rel_secs
154 && (*x)->rel_msecs <= t->rel_msecs)))
155 {
156 t->rel_msecs -= (*x)->rel_msecs;
157 t->rel_secs -= (*x)->rel_secs;
158 fix_time (&t->rel_secs, &t->rel_msecs);
159 x = &((*x)->next);
160 }
161 if (*x != 0)
162 {
163 (*x)->rel_msecs -= t->rel_msecs;
164 (*x)->rel_secs -= t->rel_secs;
165 fix_time (&(*x)->rel_secs, &(*x)->rel_msecs);
166 }
167 t->next = *x;
168 *x = t;
169 if (timer_chain == t)
170 setup_next_timer ();
171 }
172 sigprocmask (SIG_SETMASK, &old, 0);
173 }
174
175 static void
delete_timer(Lisp_Timer * t)176 delete_timer (Lisp_Timer *t)
177 {
178 Lisp_Timer **x;
179 sigset_t old;
180
181 sigprocmask (SIG_BLOCK, &alrm_sigset, &old);
182 t->deleted = 1;
183 x = &timer_chain;
184 while (*x != 0 && (*x) != t)
185 x = &((*x)->next);
186 if (*x == t)
187 {
188 if (t->next != 0)
189 {
190 t->next->rel_msecs += t->rel_msecs;
191 t->next->rel_secs += t->rel_secs;
192 fix_time (&t->next->rel_secs, &t->next->rel_msecs);
193 }
194 t->rel_secs = t->rel_msecs = 0;
195 *x = t->next;
196 if (x == &timer_chain)
197 setup_next_timer ();
198 }
199 sigprocmask (SIG_SETMASK, &old, 0);
200 }
201
202 static void
timer_fd_handler(int fd)203 timer_fd_handler (int fd)
204 {
205 int dummy;
206 int ready, i;
207 repv *timers;
208 rep_GC_n_roots gc_timers;
209 Lisp_Timer *t;
210 sigset_t old;
211
212 read (pipe_fds[0], &dummy, sizeof (dummy));
213 sigprocmask (SIG_BLOCK, &alrm_sigset, &old);
214 ready = 0;
215 for (t = timer_chain; t != 0 && t->fired; t = t->next)
216 ready++;
217 timers = alloca (sizeof (repv) * ready);
218 for (i = 0; i < ready; i++)
219 {
220 timers[i] = rep_VAL(timer_chain);
221 timer_chain = timer_chain->next;
222 }
223 setup_next_timer ();
224 sigprocmask (SIG_SETMASK, &old, 0);
225 rep_PUSHGCN(gc_timers, timers, ready);
226 for (i = 0; i < ready; i++)
227 {
228 if (!TIMER(timers[i])->deleted)
229 rep_call_lisp1 (TIMER(timers[i])->function, timers[i]);
230 }
231 rep_POPGCN;
232 }
233
234
235 /* Lisp interface */
236
237 DEFUN("make-timer", Fmake_timer, Smake_timer,
238 (repv fun, repv secs, repv msecs), rep_Subr3) /*
239 ::doc:rep.io.timers#make-timer::
240 make-timer FUNCTION [SECONDS] [MILLISECONDS]
241
242 Create and return a new one-shot timer object. After SECONDS*1000 +
243 MILLISECONDS milliseconds FUNCTION will be called.
244
245 Note that the timer will only fire _once_, use the `set-timer' function
246 to re-enable it.
247 ::end:: */
248 {
249 Lisp_Timer *t = rep_ALLOC_CELL (sizeof (Lisp_Timer));
250 rep_data_after_gc += sizeof (Lisp_Timer);
251 t->car = timer_type;
252 t->function = fun;
253 t->secs = rep_get_long_int (secs);
254 t->msecs = rep_get_long_int (msecs);
255 fix_time (&t->secs, &t->msecs);
256 t->next_alloc = allocated_timers;
257 allocated_timers = t;
258 insert_timer (t);
259 return rep_VAL(t);
260 }
261
262 DEFUN("delete-timer", Fdelete_timer, Sdelete_timer, (repv timer), rep_Subr1) /*
263 ::doc:rep.io.timers#delete-timer::
264 delete-timer TIMER
265
266 Prevent the one-shot timer TIMER from firing (i.e. calling the function
267 associated with it). If the timer has already fired, this function has
268 no effect.
269 ::end:: */
270 {
271 rep_DECLARE1(timer, TIMERP);
272 delete_timer (TIMER(timer));
273 return timer;
274 }
275
276 DEFUN("set-timer", Fset_timer, Sset_timer,
277 (repv timer, repv secs, repv msecs), rep_Subr3) /*
278 ::doc:rep.io.timers#set-timer::
279 set-timer TIMER [SECONDS] [MILLISECONDS]
280
281 Restart the one-shot timer TIMER. If SECONDS and/or MILLISECONDS is
282 defined the period after which it fires will be reset to the specified
283 duration. Otherwise, the existing values are preserved.
284 ::end:: */
285 {
286 rep_DECLARE1(timer, TIMERP);
287 rep_DECLARE2_OPT(secs, rep_NUMERICP);
288 rep_DECLARE3_OPT(msecs, rep_NUMERICP);
289 delete_timer (TIMER(timer));
290 if (secs != Qnil || msecs != Qnil)
291 {
292 TIMER(timer)->secs = rep_get_long_int (secs);
293 TIMER(timer)->msecs = rep_get_long_int (msecs);
294 fix_time (&TIMER (timer)->secs, &TIMER (timer)->msecs);
295 }
296 insert_timer (TIMER(timer));
297 return timer;
298 }
299
300
301 /* Type hooks */
302
303 static void
timer_mark(repv val)304 timer_mark (repv val)
305 {
306 rep_MARKVAL (TIMER(val)->function);
307 }
308
309 static void
timer_mark_active(void)310 timer_mark_active (void)
311 {
312 Lisp_Timer *t;
313 sigset_t old;
314 sigprocmask (SIG_BLOCK, &alrm_sigset, &old);
315 t = timer_chain;
316 while (t != 0)
317 {
318 rep_MARKVAL (rep_VAL(t));
319 t = t->next;
320 }
321 sigprocmask (SIG_SETMASK, &old, 0);
322 }
323
324 static void
timer_sweep(void)325 timer_sweep (void)
326 {
327 Lisp_Timer *x = allocated_timers;
328 allocated_timers = 0;
329 while (x != 0)
330 {
331 Lisp_Timer *next = x->next_alloc;
332 if (!rep_GC_CELL_MARKEDP (rep_VAL(x)))
333 rep_FREE_CELL (x);
334 else
335 {
336 rep_GC_CLR_CELL (rep_VAL(x));
337 x->next_alloc = allocated_timers;
338 allocated_timers = x;
339 }
340 x = next;
341 }
342 }
343
344 static void
timer_print(repv stream,repv arg)345 timer_print (repv stream, repv arg)
346 {
347 char buf[64];
348 #ifdef HAVE_SNPRINTF
349 snprintf (buf, sizeof (buf), "#<timer %lds, %ldms>",
350 TIMER(arg)->secs, TIMER(arg)->msecs);
351 #else
352 sprintf (buf, "#<timer %lds, %ldms>", TIMER(arg)->secs, TIMER(arg)->msecs);
353 #endif
354 rep_stream_puts (stream, buf, -1, rep_FALSE);
355 }
356
357
358 /* DL hooks */
359
360 repv
rep_dl_init(void)361 rep_dl_init (void)
362 {
363 repv tem;
364 timer_type = rep_register_new_type ("timer", 0, timer_print, timer_print,
365 timer_sweep, timer_mark,
366 timer_mark_active, 0, 0, 0, 0, 0, 0);
367 pipe (pipe_fds);
368 rep_register_input_fd (pipe_fds[0], timer_fd_handler);
369 #ifdef rep_HAVE_UNIX
370 rep_unix_set_fd_cloexec (pipe_fds[1]);
371 #endif
372 sigemptyset (&alrm_sigset);
373 sigaddset (&alrm_sigset, SIGALRM);
374 rep_sig_restart (SIGALRM, rep_TRUE);
375
376 tem = rep_push_structure ("rep.io.timers");
377 /* ::alias:timers rep.io.timers:: */
378 rep_alias_structure ("timers");
379 rep_ADD_SUBR(Smake_timer);
380 rep_ADD_SUBR(Sdelete_timer);
381 rep_ADD_SUBR(Sset_timer);
382 return rep_pop_structure (tem);
383 }
384
385 void
rep_dl_kill(void)386 rep_dl_kill (void)
387 {
388 rep_deregister_input_fd (pipe_fds[0]);
389 close (pipe_fds[0]);
390 close (pipe_fds[1]);
391 signal (SIGALRM, SIG_IGN);
392 }
393