/* timers.c -- call a function after a period of time has passed
Copyright (C) 1999 John Harper <john@dcs.warwick.ac.uk>
$Id: timers.c,v 1.15 2002/03/02 05:22:53 jsh Exp $
This file is part of librep.
librep is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
librep is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with librep; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
#define _GNU_SOURCE
/* AIX requires this to be the first thing in the file. */
#include <config.h>
#ifdef __GNUC__
# define alloca __builtin_alloca
#else
# if HAVE_ALLOCA_H
# include <alloca.h>
# else
# ifdef _AIX
#pragma alloca
# else
# ifndef alloca /* predefined by HP cc +Olibcalls */
char *alloca ();
# endif
# endif
# endif
#endif
#include "repint.h"
#include <signal.h>
#include <time.h>
#include <assert.h>
#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif
#ifdef HAVE_SYS_TIME_H
# include <sys/time.h>
#endif
static int timer_type;
#define TIMER(v) ((Lisp_Timer *)rep_PTR(v))
#define TIMERP(v) rep_CELL16_TYPEP(v, timer_type)
typedef struct lisp_timer {
repv car;
struct lisp_timer *next;
struct lisp_timer *next_alloc;
repv function;
long secs, msecs;
long rel_secs, rel_msecs;
u_int fired : 1;
u_int deleted : 1;
} Lisp_Timer;
/* List of all allocated timer objects, linked through next_alloc field */
static Lisp_Timer *allocated_timers;
/* List of all pending timers, linked through next field. Only ever
touch this variable if SIGALRM is blocked! */
static Lisp_Timer *timer_chain;
/* Pipe used to trigger the input callback */
static int pipe_fds[2];
/* Contains SIGALRM */
static sigset_t alrm_sigset;
static RETSIGTYPE
timer_signal_handler (int sig)
{
int dummy = 0;
Lisp_Timer *t = timer_chain;
assert (t != 0);
t->rel_secs = t->rel_msecs = 0;
while (t != 0 && t->rel_secs == 0 && t->rel_msecs == 0)
{
t->fired = 1;
t = t->next;
}
write (pipe_fds[1], &dummy, sizeof (dummy));
}
/* only call with SIGALRM blocked */
static void
setup_next_timer (void)
{
if (timer_chain != 0
&& (timer_chain->rel_secs > 0 || timer_chain->rel_msecs > 0))
{
#ifdef HAVE_SETITIMER
struct itimerval it, tem;
it.it_interval.tv_usec = 0;
it.it_interval.tv_sec = 0;
it.it_value.tv_usec = timer_chain->rel_msecs * 1000;
it.it_value.tv_sec = timer_chain->rel_secs;
setitimer (ITIMER_REAL, &it, &tem);
#else
alarm (timer_chain->secs);
#endif
signal (SIGALRM, timer_signal_handler);
}
else
signal (SIGALRM, SIG_IGN);
}
static inline void
fix_time (long *secs, long *msecs)
{
while (*msecs < 0)
{
*msecs += 1000;
(*secs)--;
}
while (*msecs > 1000)
{
*msecs -= 1000;
(*secs)++;
}
}
static void
insert_timer (Lisp_Timer *t)
{
sigset_t old;
sigprocmask (SIG_BLOCK, &alrm_sigset, &old);
if (t->secs > 0 || t->msecs > 0)
{
Lisp_Timer **x;
t->rel_secs = t->secs;
t->rel_msecs = t->msecs;
t->fired = 0;
t->deleted = 0;
x = &timer_chain;
while (*x != 0
&& ((*x)->rel_secs < t->rel_secs
|| ((*x)->rel_secs == t->rel_secs
&& (*x)->rel_msecs <= t->rel_msecs)))
{
t->rel_msecs -= (*x)->rel_msecs;
t->rel_secs -= (*x)->rel_secs;
fix_time (&t->rel_secs, &t->rel_msecs);
x = &((*x)->next);
}
if (*x != 0)
{
(*x)->rel_msecs -= t->rel_msecs;
(*x)->rel_secs -= t->rel_secs;
fix_time (&(*x)->rel_secs, &(*x)->rel_msecs);
}
t->next = *x;
*x = t;
if (timer_chain == t)
setup_next_timer ();
}
sigprocmask (SIG_SETMASK, &old, 0);
}
static void
delete_timer (Lisp_Timer *t)
{
Lisp_Timer **x;
sigset_t old;
sigprocmask (SIG_BLOCK, &alrm_sigset, &old);
t->deleted = 1;
x = &timer_chain;
while (*x != 0 && (*x) != t)
x = &((*x)->next);
if (*x == t)
{
if (t->next != 0)
{
t->next->rel_msecs += t->rel_msecs;
t->next->rel_secs += t->rel_secs;
fix_time (&t->next->rel_secs, &t->next->rel_msecs);
}
t->rel_secs = t->rel_msecs = 0;
*x = t->next;
if (x == &timer_chain)
setup_next_timer ();
}
sigprocmask (SIG_SETMASK, &old, 0);
}
static void
timer_fd_handler (int fd)
{
int dummy;
int ready, i;
repv *timers;
rep_GC_n_roots gc_timers;
Lisp_Timer *t;
sigset_t old;
read (pipe_fds[0], &dummy, sizeof (dummy));
sigprocmask (SIG_BLOCK, &alrm_sigset, &old);
ready = 0;
for (t = timer_chain; t != 0 && t->fired; t = t->next)
ready++;
timers = alloca (sizeof (repv) * ready);
for (i = 0; i < ready; i++)
{
timers[i] = rep_VAL(timer_chain);
timer_chain = timer_chain->next;
}
setup_next_timer ();
sigprocmask (SIG_SETMASK, &old, 0);
rep_PUSHGCN(gc_timers, timers, ready);
for (i = 0; i < ready; i++)
{
if (!TIMER(timers[i])->deleted)
rep_call_lisp1 (TIMER(timers[i])->function, timers[i]);
}
rep_POPGCN;
}
/* Lisp interface */
DEFUN("make-timer", Fmake_timer, Smake_timer,
(repv fun, repv secs, repv msecs), rep_Subr3) /*
::doc:rep.io.timers#make-timer::
make-timer FUNCTION [SECONDS] [MILLISECONDS]
Create and return a new one-shot timer object. After SECONDS*1000 +
MILLISECONDS milliseconds FUNCTION will be called.
Note that the timer will only fire _once_, use the `set-timer' function
to re-enable it.
::end:: */
{
Lisp_Timer *t = rep_ALLOC_CELL (sizeof (Lisp_Timer));
rep_data_after_gc += sizeof (Lisp_Timer);
t->car = timer_type;
t->function = fun;
t->secs = rep_get_long_int (secs);
t->msecs = rep_get_long_int (msecs);
t->next_alloc = allocated_timers;
allocated_timers = t;
insert_timer (t);
return rep_VAL(t);
}
DEFUN("delete-timer", Fdelete_timer, Sdelete_timer, (repv timer), rep_Subr1) /*
::doc:rep.io.timers#delete-timer::
delete-timer TIMER
Prevent the one-shot timer TIMER from firing (i.e. calling the function
associated with it). If the timer has already fired, this function has
no effect.
::end:: */
{
rep_DECLARE1(timer, TIMERP);
delete_timer (TIMER(timer));
return timer;
}
DEFUN("set-timer", Fset_timer, Sset_timer,
(repv timer, repv secs, repv msecs), rep_Subr3) /*
::doc:rep.io.timers#set-timer::
set-timer TIMER [SECONDS] [MILLISECONDS]
Restart the one-shot timer TIMER. If SECONDS and/or MILLISECONDS is
defined the period after which it fires will be reset to the specified
duration. Otherwise, the existing values are preserved.
::end:: */
{
rep_DECLARE1(timer, TIMERP);
rep_DECLARE2_OPT(secs, rep_NUMERICP);
rep_DECLARE3_OPT(msecs, rep_NUMERICP);
delete_timer (TIMER(timer));
if (secs != Qnil || msecs != Qnil)
{
TIMER(timer)->secs = rep_get_long_int (secs);
TIMER(timer)->msecs = rep_get_long_int (msecs);
}
insert_timer (TIMER(timer));
return timer;
}
/* Type hooks */
static void
timer_mark (repv val)
{
rep_MARKVAL (TIMER(val)->function);
}
static void
timer_mark_active (void)
{
Lisp_Timer *t;
sigset_t old;
sigprocmask (SIG_BLOCK, &alrm_sigset, &old);
t = timer_chain;
while (t != 0)
{
rep_MARKVAL (rep_VAL(t));
t = t->next;
}
sigprocmask (SIG_SETMASK, &old, 0);
}
static void
timer_sweep (void)
{
Lisp_Timer *x = allocated_timers;
allocated_timers = 0;
while (x != 0)
{
Lisp_Timer *next = x->next_alloc;
if (!rep_GC_CELL_MARKEDP (rep_VAL(x)))
rep_FREE_CELL (x);
else
{
rep_GC_CLR_CELL (rep_VAL(x));
x->next_alloc = allocated_timers;
allocated_timers = x;
}
x = next;
}
}
static void
timer_print (repv stream, repv arg)
{
char buf[64];
#ifdef HAVE_SNPRINTF
snprintf (buf, sizeof (buf), "#<timer %lds, %ldms>",
TIMER(arg)->secs, TIMER(arg)->msecs);
#else
sprintf (buf, "#<timer %lds, %ldms>", TIMER(arg)->secs, TIMER(arg)->msecs);
#endif
rep_stream_puts (stream, buf, -1, rep_FALSE);
}
/* DL hooks */
repv
rep_dl_init (void)
{
repv tem;
timer_type = rep_register_new_type ("timer", 0, timer_print, timer_print,
timer_sweep, timer_mark,
timer_mark_active, 0, 0, 0, 0, 0, 0);
pipe (pipe_fds);
rep_register_input_fd (pipe_fds[0], timer_fd_handler);
#ifdef rep_HAVE_UNIX
rep_unix_set_fd_cloexec (pipe_fds[1]);
#endif
sigemptyset (&alrm_sigset);
sigaddset (&alrm_sigset, SIGALRM);
rep_sig_restart (SIGALRM, rep_TRUE);
tem = rep_push_structure ("rep.io.timers");
/* ::alias:timers rep.io.timers:: */
rep_alias_structure ("timers");
rep_ADD_SUBR(Smake_timer);
rep_ADD_SUBR(Sdelete_timer);
rep_ADD_SUBR(Sset_timer);
return rep_pop_structure (tem);
}
void
rep_dl_kill (void)
{
rep_deregister_input_fd (pipe_fds[0]);
close (pipe_fds[0]);
close (pipe_fds[1]);
signal (SIGALRM, SIG_IGN);
}
syntax highlighted by Code2HTML, v. 0.9.1