initial version

Author: palmskog

.gitignore

@@ -0,0 +1,2 @@
+_build
+verdi-runtime.install

CHANGES.md

@@ -0,0 +1,25 @@
+Copyright (c) 2014-2017, Verdi Team
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright
+notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

LICENSE.md

@@ -0,0 +1 @@
+Verdi framework runtime library

README.md

@@ -0,0 +1 @@
+true : bin_annot

_tags

@@ -0,0 +1,17 @@
+opam-version: "1.2"
+version: "1.0"
+maintainer: "[email protected]"
+homepage: "https://github.com/DistributedComponents/verdi-runtime"
+dev-repo: "https://github.com/DistributedComponents/verdi-runtime.git"
+bug-reports: "https://github.com/DistributedComponents/verdi-runtime/issues"
+authors: ["James Wilcox <>" "Doug Woos <>" "Steve Anton <>" "Karl Palmskog <>" "Ryan Doenges <>"]
+available: [ ocaml-version >= "4.02.3"]
+license: "BSD"
+depends: [
+  "ocamlfind" {build}
+  "ocamlbuild" {build}
+  "topkg" {build} ]
+build: [
+  "ocaml" "pkg/pkg.ml" "build"
+          "--pinned" "%{pinned}%" 
+]

opam

@@ -0,0 +1,8 @@
+version = "%%VERSION%%"
+description = "Verdi framework runtime library"
+requires = "unix str"
+archive(byte) = "verdi_runtime.cma"
+archive(byte, plugin) = "verdi_runtime.cma"
+archive(native) = "verdi_runtime.cmxa"
+archive(native, plugin) = "verdi_runtime.cmxs"
+exists_if = "verdi_runtime.cma"

pkg/META

@@ -0,0 +1,16 @@
+#!/usr/bin/env ocaml
+#use "topfind";;
+#require "topkg"
+open Topkg
+
+let () =
+  Pkg.describe "verdi-runtime" @@ fun c ->
+    Ok [ Pkg.lib "src/Util.cmi";
+	 Pkg.lib "src/Opts.cmi";
+	 Pkg.lib "src/Daemon.cmi";
+	 Pkg.lib "src/Shim.cmi";
+	 Pkg.lib "src/OrderedShim.cmi";
+	 Pkg.lib "src/verdi_runtime.a";
+	 Pkg.lib "src/verdi_runtime.cma";
+	 Pkg.lib "src/verdi_runtime.cmxa";
+	 Pkg.lib "src/verdi_runtime.cmxs" ]

pkg/pkg.ml

@@ -0,0 +1,52 @@
+type ('env, 'state) task  = 
+  { fd : Unix.file_descr
+  ; mutable select_on : bool
+  ; mutable wake_time : float option
+  ; mutable process_read : ('env, 'state) task -> 'env -> 'state -> bool * ('env, 'state) task list * 'state
+  ; mutable process_wake : ('env, 'state) task -> 'env -> 'state -> bool * ('env, 'state) task list * 'state
+  ; finalize : ('env, 'state) task -> 'env -> 'state -> 'state
+  }
+
+let process process_f t hts env state =
+  let state = ref state in
+  let (finished, ts, state') = process_f t env !state in
+  state := state';
+  if finished then begin 
+    Hashtbl.remove hts t.fd; 
+    state := t.finalize t env !state 
+  end;
+  List.iter (fun t' -> Hashtbl.add hts t'.fd t') ts;
+  !state
+
+let rec eloop default_timeout old_timestamp hts env state =
+  let state = ref state in
+  let (select_fds, min_timeout) = 
+    Hashtbl.fold
+      (fun fd t (fds, timeout) ->
+	let fds' = if t.select_on then fd :: fds else fds in
+	let timeout' =
+	  match t.wake_time with
+	  | None -> timeout
+	  | Some wake_time -> min timeout wake_time 
+	in (fds', timeout'))
+      hts ([], default_timeout) in
+  let (ready_fds, _, _) = Util.select_unintr select_fds [] [] min_timeout in
+  List.iter
+    (fun fd -> 
+      let t = Hashtbl.find hts fd in 
+      state := process t.process_read t hts env !state) ready_fds;
+  let new_timestamp = Unix.gettimeofday () in
+  let elapsed_time = new_timestamp -. old_timestamp in
+  let wake_tasks =
+    Hashtbl.fold
+      (fun fd t ts ->
+	match t.wake_time with
+	| None -> ts
+	| Some wake_time ->
+	  if elapsed_time >= wake_time then
+	    t :: ts
+	  else
+	    (t.wake_time <- Some (wake_time -. elapsed_time); ts))
+      hts [] in
+  List.iter (fun t -> state := process t.process_wake t hts env !state) wake_tasks;
+  eloop default_timeout new_timestamp hts env !state

src/Daemon.ml

@@ -0,0 +1,10 @@
+type ('env, 'state) task  = 
+  { fd : Unix.file_descr
+  ; mutable select_on : bool
+  ; mutable wake_time : float option
+  ; mutable process_read : ('env, 'state) task -> 'env -> 'state -> bool * ('env, 'state) task list * 'state
+  ; mutable process_wake : ('env, 'state) task -> 'env -> 'state -> bool * ('env, 'state) task list * 'state
+  ; finalize : ('env, 'state) task -> 'env -> 'state -> 'state
+  }
+
+val eloop : float -> float -> (Unix.file_descr, ('a, 'b) task) Hashtbl.t -> 'a -> 'b -> 'c