1 /************************************************************************/
2 /* The OcamlEvent library */
4 /* Copyright 2002, 2003, 2004 Maas-Maarten Zeeman. All rights reserved. */
5 /* See LICENCE for details. */
6 /************************************************************************/
8 /* $Id: event_stubs.c,v 1.2 2009-11-26 08:41:10 maas Exp $ */
10 /* Stub code to interface Ocaml with libevent */
17 #include <caml/mlvalues.h>
18 #include <caml/custom.h>
19 #include <caml/alloc.h>
20 #include <caml/memory.h>
21 #include <caml/callback.h>
22 #include <caml/fail.h>
23 #include <caml/unixsupport.h>
24 #include <caml/signals.h>
26 #define struct_event_val(v) (*(struct event**) Data_custom_val(v))
27 #define Is_some(v) (Is_block(v))
29 /* FIXME use custom block */
30 #define struct_event_base_val(v) (struct event_base*)(v)
31 #define Val_struct_event_base(base) ((value)(base))
33 static value
* event_cb_closure
= NULL
;
35 /* FIXME use dedicated exception */
36 static void raise_error(char const* str
, char const* arg
)
38 uerror((char*)str
, NULL
== arg
? Nothing
: caml_copy_string(arg
));
42 struct_event_finalize(value ve
)
44 struct event
*ev
= struct_event_val(ve
);
46 if (event_initialized(ev
)) {
50 caml_stat_free(struct_event_val(ve
));
54 struct_event_compare(value v1
, value v2
)
56 struct event
*p1
= struct_event_val(v1
);
57 struct event
*p2
= struct_event_val(v2
);
58 if(p1
== p2
) return 0;
59 if(p1
< p2
) return -1;
64 struct_event_hash(value v
)
66 return (long) struct_event_val(v
);
69 static struct custom_operations struct_event_ops
= {
71 struct_event_finalize
,
74 custom_serialize_default
,
75 custom_deserialize_default
79 * This callback calls the ocaml event callback, which will in turn
80 * call the real ocaml callback.
83 event_cb(int fd
, short type
, void *arg
)
85 caml_leave_blocking_section();
86 callback3(*event_cb_closure
,
87 Val_long((long) arg
), Val_int(fd
), Val_int(type
));
88 caml_enter_blocking_section();
92 set_struct_timeval(struct timeval
*tv
, value vfloat
)
94 double timeout
= Double_val(vfloat
);
95 tv
->tv_sec
= (int) timeout
;
96 tv
->tv_usec
= (int) (1e6
* (timeout
- tv
->tv_sec
));
100 oc_create_event(value u
)
104 struct event
* ev
= caml_stat_alloc(sizeof(struct event
));
105 memset(ev
, 0, sizeof(*ev
));
107 ve
= caml_alloc_custom(&struct_event_ops
, sizeof(struct event
*), 0, 1);
108 struct_event_val(ve
) = ev
;
114 oc_event_id(value vevent
)
117 CAMLreturn(Val_long((long) struct_event_val(vevent
)));
121 oc_event_fd(value vevent
)
124 CAMLreturn(Val_long(EVENT_FD(struct_event_val(vevent
))));
128 oc_event_set(value vbase
, value vevent
, value fd
, value vevent_flag
)
130 CAMLparam4(vbase
, vevent
, fd
, vevent_flag
);
132 struct event
*event
= struct_event_val(vevent
);
134 event_set(event
, Int_val(fd
), Int_val(vevent_flag
),
137 if (0 != event_base_set(struct_event_base_val(vbase
), event
))
139 raise_error("event_set", "event_base_set");
142 CAMLreturn(Val_unit
);
146 oc_event_add(value vevent
, value vfloat_option
)
148 CAMLparam2(vevent
, vfloat_option
);
149 struct event
*event
= struct_event_val(vevent
);
150 struct timeval timeval
;
151 struct timeval
*tv
= NULL
;
153 if (Is_some(vfloat_option
)) {
154 set_struct_timeval(&timeval
, Field(vfloat_option
, 0));
158 if (0 != event_add(event
, tv
)) {
159 raise_error("event_add", "event_add");
162 CAMLreturn(Val_unit
);
166 oc_event_del(value vevent
)
169 struct event
*event
= struct_event_val(vevent
);
173 CAMLreturn(Val_unit
);
177 oc_event_pending(value vevent
, value vtype
, value vfloat_option
)
179 CAMLparam3(vevent
, vtype
, vfloat_option
);
180 struct event
*event
= struct_event_val(vevent
);
181 struct timeval timeval
;
182 struct timeval
*tv
= NULL
;
184 if Is_some(vfloat_option
) {
185 set_struct_timeval(&timeval
, Field(vfloat_option
, 0));
189 event_pending(event
, Int_val(vtype
), tv
);
191 CAMLreturn(Val_unit
);
195 oc_event_base_loop(value vbase
, value vloop_flag
)
197 CAMLparam2(vbase
,vloop_flag
);
198 struct event_base
* base
= struct_event_base_val(vbase
);
200 if (0 == Int_val(vloop_flag
)) flag
= EVLOOP_ONCE
;
201 else if (1 == Int_val(vloop_flag
)) flag
= EVLOOP_NONBLOCK
;
202 else caml_invalid_argument("loop");
204 caml_enter_blocking_section();
205 if((-1 == event_base_loop(base
,flag
))) {
206 caml_leave_blocking_section();
207 raise_error("event_loop", NULL
);
209 caml_leave_blocking_section();
211 CAMLreturn(Val_unit
);
216 oc_event_base_dispatch(value vbase
)
219 struct event_base
* base
= struct_event_base_val(vbase
);
221 caml_enter_blocking_section();
222 if((-1 == event_base_dispatch(base
))) {
223 caml_leave_blocking_section();
224 raise_error("event_dispatch", NULL
);
226 caml_leave_blocking_section();
228 CAMLreturn(Val_unit
);
232 * Initialize event base
235 oc_event_base_init(value unit
)
238 struct event_base
* base
= NULL
;
240 /* setup the event callback closure if needed */
241 if(event_cb_closure
== NULL
) {
242 event_cb_closure
= caml_named_value("event_cb");
243 if(event_cb_closure
== NULL
) {
244 invalid_argument("Callback event_cb not initialized.");
248 base
= event_base_new();
250 raise_error("event_base_init", NULL
);
253 CAMLreturn(Val_struct_event_base(base
));
257 oc_event_base_reinit(value vbase
)
260 struct event_base
* base
= struct_event_base_val(vbase
);
262 if (0 != event_reinit(base
)) {
263 raise_error("event_base_reinit", NULL
);
266 CAMLreturn(Val_unit
);
270 oc_event_base_free(value vbase
)
273 struct event_base
* base
= struct_event_base_val(vbase
);
275 event_base_free(base
);
277 CAMLreturn(Val_unit
);