1999-12-16 04:25:11 -08:00
|
|
|
(*************************************************************************)
|
|
|
|
|
(* *)
|
|
|
|
|
(* Objective Caml LablTk library *)
|
|
|
|
|
(* *)
|
|
|
|
|
(* Francois Rouaix, Francois Pessaux and Jun Furuse *)
|
|
|
|
|
(* projet Cristal, INRIA Rocquencourt *)
|
|
|
|
|
(* Jacques Garrigue, Kyoto University RIMS *)
|
|
|
|
|
(* *)
|
|
|
|
|
(* Copyright 1999 Institut National de Recherche en Informatique et *)
|
|
|
|
|
(* en Automatique and Kyoto University. All rights reserved. *)
|
|
|
|
|
(* This file is distributed under the terms of the GNU Library *)
|
|
|
|
|
(* General Public License. *)
|
|
|
|
|
(* *)
|
|
|
|
|
(*************************************************************************)
|
|
|
|
|
|
1999-11-30 06:59:39 -08:00
|
|
|
(* $Id$ *)
|
|
|
|
|
|
|
|
|
|
(* Timers *)
|
|
|
|
|
open Protocol
|
|
|
|
|
|
|
|
|
|
type tkTimer = int
|
|
|
|
|
|
|
|
|
|
external internal_add_timer : int -> cbid -> tkTimer
|
|
|
|
|
= "camltk_add_timer"
|
|
|
|
|
external internal_rem_timer : tkTimer -> unit
|
|
|
|
|
= "camltk_rem_timer"
|
|
|
|
|
|
|
|
|
|
type t = tkTimer * cbid (* the token and the cb id *)
|
|
|
|
|
|
|
|
|
|
(* A timer is used only once, so we must clean the callback table *)
|
|
|
|
|
let add ms:milli callback:f =
|
|
|
|
|
let id = new_function_id () in
|
|
|
|
|
let wrapped _ =
|
|
|
|
|
clear_callback id; (* do it first in case f raises exception *)
|
|
|
|
|
f() in
|
|
|
|
|
Hashtbl.add callback_naming_table key:id data:wrapped;
|
|
|
|
|
if !Protocol.debug then begin
|
|
|
|
|
prerr_cbid id; prerr_endline " for timer"
|
|
|
|
|
end;
|
|
|
|
|
let t = internal_add_timer milli id in
|
|
|
|
|
t,id
|
|
|
|
|
|
|
|
|
|
(* If the timer has never been used, there is a small space leak in
|
|
|
|
|
the C heap, where a copy of id has been stored *)
|
|
|
|
|
let remove (tkTimer, id) =
|
|
|
|
|
internal_rem_timer tkTimer;
|
|
|
|
|
clear_callback id
|
|
|
|
|
|
