Anonymous avatar Anonymous committed ec61113

Submit cf-0.1 release.

Comments (0)

Files changed (5)

 (*---------------------------------------------------------------------------*
   IMPLEMENTATION  cf_ordered.ml
 
-  Copyright (c) 2002, James H. Woodyatt
+  Copyright (c) 2002-2004, James H. Woodyatt
   All rights reserved.
 
   Redistribution and use in source and binary forms, with or without

cf/cf_ordered.mli

 (*---------------------------------------------------------------------------*
   INTERFACE  cf_ordered.mli
 
-  Copyright (c) 2002, James H. Woodyatt
+  Copyright (c) 2002-2004, James H. Woodyatt
   All rights reserved.
 
   Redistribution and use in source and binary forms, with or without
 (*---------------------------------------------------------------------------*
   IMPLEMENTATION  cf_parser.ml
 
-  Copyright (c) 2002, James H. Woodyatt
+  Copyright (c) 2002-2004, James H. Woodyatt
   All rights reserved.
 
   Redistribution and use in source and binary forms, with or without
 (*---------------------------------------------------------------------------*
   INTERFACE  cf_parser.mli
 
-  Copyright (c) 2002, James H. Woodyatt
+  Copyright (c) 2002-2004, James H. Woodyatt
   All rights reserved.
 
   Redistribution and use in source and binary forms, with or without
 (*---------------------------------------------------------------------------*
   IMPLEMENTATION  cf_poll.ml
 
-  Copyright (c) 2003, James H. Woodyatt
+  Copyright (c) 2003-2004, James H. Woodyatt
   All rights reserved.
 
   Redistribution and use in source and binary forms, with or without
     mutable p_sig_tree_: (Sys.signal_behavior * (unit -> unit)) Sig_tree.t;
     mutable p_sig_zlist_: int list Lazy.t;
     mutable p_sig_stack_: int list;
-    mutable p_idle_queue_: ((unit -> unit) * Obj.t) Cf_deque.t;
+    mutable p_idle_queue_: ((Cf_tai64n.t -> unit) * Obj.t) Cf_deque.t;
 }
 and fd_aux_t = {
     mutable fd_tree_: (unit -> unit) Fd_tree.t;
     p.p_sig_stack_ <- [];
     loop stack
 
-let idle_service_ p =
+let idle_service_ p now =
     match Cf_deque.B.pop p.p_idle_queue_ with
-    | Some ((call, _), tl) -> p.p_idle_queue_ <- tl; call ()
+    | Some ((call, _), tl) -> p.p_idle_queue_ <- tl; call now
     | None -> ()
 
 let create () = {
     let wlist = Lazy.force p.p_fd_w_aux_.fd_zlist_ in
     let xlist = Lazy.force p.p_fd_x_aux_.fd_zlist_ in
     let sigs = Lazy.force p.p_sig_zlist_ in
+    let idling = not (Cf_deque.empty p.p_idle_queue_) in
     match rlist, wlist, xlist with
-    | [], [], [] when dt < 0.0 && sigs = [] ->
+    | [], [], [] when dt < 0.0 && sigs = [] && not idling ->
         (*
         xprintf "selecting: done.\n";
         flush stdout;
     | _, _, _ when dt = 0.0 ->
         tm_service_ p now;
         More
-    | _, _, _ when not (Cf_deque.empty p.p_idle_queue_) ->
-        idle_service_ p;
+    | _, _, _ when idling ->
+        idle_service_ p now;
         More
     | _, _, _ ->
         (*
         constraint 'self = 'a #core
         inherit ['a] core as super
         
-        method private callback_ p () =
-            state_ <- (try self#service_ p with e -> `Exception e);
+        val mutable epoch_: Cf_tai64n.t option = None
+        
+        method private callback_with_time_ p now =
+            state_ <- begin
+                try
+                    epoch_ <- Some now;
+                    self#service_ p
+                with
+                | e ->
+                    epoch_ <- None;
+                    `Exception e
+            end;
             super#put_
 
         method private load_ p =
-            let v = self#callback_ p, Obj.repr self in
+            epoch_ <- None;
+            let v = self#callback_with_time_ p, Obj.repr self in
             p.p_idle_queue_ <- Cf_deque.A.push v p.p_idle_queue_
         
         method private unload_ p =
+            epoch_ <- None;
             let f (_, obj) = Obj.repr self != obj in
             p.p_idle_queue_ <- Cf_deque.filter f p.p_idle_queue_
+        
+        method get =
+            let v = super#get in
+            epoch_ <- None;
+            v
     end
 
 (*--- End of File [ cf_poll.ml ] ---*)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.