Permalink
Browse files

Merge branch 'master' of github.com:djs55/shared-memory-ring

  • Loading branch information...
2 parents fa08a5b + 0a83df2 commit e3b9125bdd615ff49667af2c062f6fbbdc0395f1 David Scott committed Feb 22, 2013
Showing with 174 additions and 222 deletions.
  1. +5 −1 CHANGES
  2. +1 −1 Makefile
  3. +1 −1 _oasis
  4. +20 −20 _tags
  5. +5 −5 lib/META
  6. +20 −27 lwt/lwt_ring.ml
  7. +7 −0 lwt/lwt_ring.mli
  8. +33 −84 myocamlbuild.ml
  9. +82 −83 setup.ml
View
@@ -1,4 +1,8 @@
-0.1.0 (2012-12-20)
+0.2.0 (2012-02-08):
+* Add `Lwt_ring` write and push functions that separate updates and notification, to support fragment-based protocols.
+* Improve diagnostics support.
+
+0.1.0 (2012-12-20):
* Initial public release.
* Update to new cstruct 0.6.0 API
* [xen] support for suspend and resume
View
@@ -1,7 +1,7 @@
.PHONY: all clean install build
all: build doc
-NAME=shared_ring
+NAME=shared-memory-ring
J=4
export OCAMLRUNPARAM=b
View
2 _oasis
@@ -1,6 +1,6 @@
OASISFormat: 0.3
Name: shared-memory-ring
-Version: 0.1.0
+Version: 0.2.0
Synopsis: Xen-style shared memory rings
Authors: Anil Madhavapeddy, David Scott
License: ISC
View
40 _tags
@@ -1,5 +1,5 @@
# OASIS_START
-# DO NOT EDIT (digest: 3ddb5c0986b678218a8f74080e69d770)
+# DO NOT EDIT (digest: c284104c791b43b6d3e5b0420e858b0b)
# Ignore VCS directories, you can use the same kind of rule outside
# OASIS_START/STOP if you want to exclude directories that contains
# useless stuff for the build process
@@ -35,15 +35,15 @@
<lwt/*.ml{,i}>: pkg_cstruct
<lwt/*.ml{,i}>: pkg_cstruct.syntax
# Executable ring_test
-<lib_test/ring_test.{native,byte,nobj.o}>: use_libring_test_stubs
-<lib_test/ring_test.{native,byte,nobj.o}>: use_xenstore_ring
-<lib_test/ring_test.{native,byte,nobj.o}>: use_console_ring
-<lib_test/ring_test.{native,byte,nobj.o}>: use_shared_memory_ring
-<lib_test/ring_test.{native,byte,nobj.o}>: pkg_lwt
-<lib_test/ring_test.{native,byte,nobj.o}>: pkg_lwt.unix
-<lib_test/ring_test.{native,byte,nobj.o}>: pkg_oUnit
-<lib_test/ring_test.{native,byte,nobj.o}>: pkg_cstruct
-<lib_test/ring_test.{native,byte,nobj.o}>: pkg_cstruct.syntax
+<lib_test/ring_test.{native,byte}>: use_libring_test_stubs
+<lib_test/ring_test.{native,byte}>: use_xenstore_ring
+<lib_test/ring_test.{native,byte}>: use_console_ring
+<lib_test/ring_test.{native,byte}>: use_shared_memory_ring
+<lib_test/ring_test.{native,byte}>: pkg_lwt
+<lib_test/ring_test.{native,byte}>: pkg_lwt.unix
+<lib_test/ring_test.{native,byte}>: pkg_oUnit
+<lib_test/ring_test.{native,byte}>: pkg_cstruct
+<lib_test/ring_test.{native,byte}>: pkg_cstruct.syntax
<lib_test/*.ml{,i}>: use_xenstore_ring
<lib_test/*.ml{,i}>: use_console_ring
<lib_test/*.ml{,i}>: use_shared_memory_ring
@@ -60,16 +60,16 @@
"lib_test/old_ring_stubs.c": pkg_oUnit
"lib_test/old_ring_stubs.c": pkg_cstruct
"lib_test/old_ring_stubs.c": pkg_cstruct.syntax
-<lib_test/ring_test.{native,byte,nobj.o}>: custom
+<lib_test/ring_test.{native,byte}>: custom
# Executable lwt_test
-<lwt_test/lwt_test.{native,byte,nobj.o}>: use_lwt_shared_memory_ring
-<lwt_test/lwt_test.{native,byte,nobj.o}>: use_shared_memory_ring
-<lwt_test/lwt_test.{native,byte,nobj.o}>: pkg_lwt
-<lwt_test/lwt_test.{native,byte,nobj.o}>: pkg_lwt.unix
-<lwt_test/lwt_test.{native,byte,nobj.o}>: pkg_oUnit
-<lwt_test/lwt_test.{native,byte,nobj.o}>: pkg_lwt.syntax
-<lwt_test/lwt_test.{native,byte,nobj.o}>: pkg_cstruct
-<lwt_test/lwt_test.{native,byte,nobj.o}>: pkg_cstruct.syntax
+<lwt_test/lwt_test.{native,byte}>: use_lwt_shared_memory_ring
+<lwt_test/lwt_test.{native,byte}>: use_shared_memory_ring
+<lwt_test/lwt_test.{native,byte}>: pkg_lwt
+<lwt_test/lwt_test.{native,byte}>: pkg_lwt.unix
+<lwt_test/lwt_test.{native,byte}>: pkg_oUnit
+<lwt_test/lwt_test.{native,byte}>: pkg_lwt.syntax
+<lwt_test/lwt_test.{native,byte}>: pkg_cstruct
+<lwt_test/lwt_test.{native,byte}>: pkg_cstruct.syntax
<lwt_test/*.ml{,i}>: use_lwt_shared_memory_ring
<lwt_test/*.ml{,i}>: use_shared_memory_ring
<lwt_test/*.ml{,i}>: pkg_lwt
@@ -78,7 +78,7 @@
<lwt_test/*.ml{,i}>: pkg_lwt.syntax
<lwt_test/*.ml{,i}>: pkg_cstruct
<lwt_test/*.ml{,i}>: pkg_cstruct.syntax
-<lwt_test/lwt_test.{native,byte,nobj.o}>: custom
+<lwt_test/lwt_test.{native,byte}>: custom
# OASIS_STOP
true: annot
<*/*>: syntax_camlp4o
View
@@ -1,6 +1,6 @@
# OASIS_START
-# DO NOT EDIT (digest: f6889156ddfdcf425806da0219e7b624)
-version = "0.1.0"
+# DO NOT EDIT (digest: 8dd02c0090fe9cda27c2dcc376b5c662)
+version = "0.2.0"
description = "Xen-style shared memory rings"
requires = "cstruct cstruct.syntax"
archive(byte) = "shared_memory_ring.cma"
@@ -9,7 +9,7 @@ archive(native) = "shared_memory_ring.cmxa"
archive(native, plugin) = "shared_memory_ring.cmxs"
exists_if = "shared_memory_ring.cma"
package "xenstore" (
- version = "0.1.0"
+ version = "0.2.0"
description = "Xen-style shared memory rings"
requires = "shared-memory-ring"
archive(byte) = "xenstore_ring.cma"
@@ -20,7 +20,7 @@ package "xenstore" (
)
package "lwt" (
- version = "0.1.0"
+ version = "0.2.0"
description = "Xen-style shared memory rings"
requires = "shared-memory-ring lwt lwt.syntax"
archive(byte) = "lwt_shared_memory_ring.cma"
@@ -31,7 +31,7 @@ package "lwt" (
)
package "console" (
- version = "0.1.0"
+ version = "0.2.0"
description = "Xen-style shared memory rings"
requires = "shared-memory-ring"
archive(byte) = "console_ring.cma"
View
@@ -57,35 +57,28 @@ module Front = struct
|None -> ()
|Some u -> Lwt.wakeup u ()
- let rec push_request_and_wait t notifyfn reqfn =
- if Ring.Rpc.Front.get_free_requests t.ring > 0 then begin
- let slot_id = Ring.Rpc.Front.next_req_id t.ring in
- let slot = Ring.Rpc.Front.slot t.ring slot_id in
- let th,u = Lwt.task () in
- let id = reqfn slot in
- if Ring.Rpc.Front.push_requests_and_check_notify t.ring
- then notifyfn ();
- Lwt.on_cancel th (fun _ -> Hashtbl.remove t.wakers id);
- Hashtbl.add t.wakers id u;
- th
- end else begin
- let th,u = Lwt.task () in
- let node = Lwt_sequence.add_r u t.waiters in
- Lwt.on_cancel th (fun _ -> Lwt_sequence.remove node);
- th >>
- push_request_and_wait t notifyfn reqfn
- end
+ let write t reqfn =
+ lwt () = wait_for_free_slot t in
+ let slot_id = Ring.Rpc.Front.next_req_id t.ring in
+ let slot = Ring.Rpc.Front.slot t.ring slot_id in
+ let th, u = Lwt.task () in
+ let id = reqfn slot in
+ Lwt.on_cancel th (fun _ -> Hashtbl.remove t.wakers id);
+ Hashtbl.add t.wakers id u;
+ return th
+
+ let push t notifyfn =
+ if Ring.Rpc.Front.push_requests_and_check_notify t.ring
+ then notifyfn ()
+
+ let push_request_and_wait t notifyfn reqfn =
+ lwt th = write t reqfn in
+ push t notifyfn;
+ th
let push_request_async t notifyfn reqfn freefn =
- lwt () = wait_for_free_slot t in
- let slot_id = Ring.Rpc.Front.next_req_id t.ring in
- let slot = Ring.Rpc.Front.slot t.ring slot_id in
- let th,u = Lwt.task () in
- let id = reqfn slot in
- if Ring.Rpc.Front.push_requests_and_check_notify t.ring
- then notifyfn ();
- Lwt.on_cancel th (fun _ -> Hashtbl.remove t.wakers id);
- Hashtbl.add t.wakers id u;
+ lwt th = write t reqfn in
+ push t notifyfn;
let _ = freefn th in
return ()
View
@@ -32,6 +32,13 @@ module Front : sig
*)
val init : ('a, 'b) Ring.Rpc.Front.t -> ('a,'b) t
+ (** Block until a ring slot is free, write the request and return the response thread *)
+ val write : ('a, 'b) t -> (buf -> 'b) -> 'a Lwt.t Lwt.t
+
+ (** Advance the shared ring pointers, exposing the written requests to the other end.
+ If the other end won't see the update, call the provided notify function to signal it. *)
+ val push : ('a, 'b) t -> (unit -> unit) -> unit
+
(** Push an asynchronous request to the slot and call [freefn] when a response comes in *)
val push_request_async : ('a,'b) t -> (unit -> unit) -> (buf -> 'b) -> ('a Lwt.t -> unit Lwt.t) -> unit Lwt.t
View
@@ -1,7 +1,7 @@
(* OASIS_START *)
-(* DO NOT EDIT (digest: 6db1faea0bf65d85a37c695085f83b25) *)
+(* DO NOT EDIT (digest: fa01762308f97d953e3d7ec39aa4f64f) *)
module OASISGettext = struct
-# 21 "/home/djs/oasis/src/oasis/OASISGettext.ml"
+(* # 21 "/home/avsm/.opam/system/build/oasis-mirage.0.3.0a/src/oasis/OASISGettext.ml" *)
let ns_ str =
str
@@ -24,7 +24,7 @@ module OASISGettext = struct
end
module OASISExpr = struct
-# 21 "/home/djs/oasis/src/oasis/OASISExpr.ml"
+(* # 21 "/home/avsm/.opam/system/build/oasis-mirage.0.3.0a/src/oasis/OASISExpr.ml" *)
@@ -116,7 +116,7 @@ end
# 117 "myocamlbuild.ml"
module BaseEnvLight = struct
-# 21 "/home/djs/oasis/src/base/BaseEnvLight.ml"
+(* # 21 "/home/avsm/.opam/system/build/oasis-mirage.0.3.0a/src/base/BaseEnvLight.ml" *)
module MapString = Map.Make(String)
@@ -213,76 +213,8 @@ end
# 215 "myocamlbuild.ml"
-module MyOCamlbuildXen = struct
-# 22 "/home/djs/oasis/src/plugins/ocamlbuild/MyOCamlbuildXen.ml"
-
- open Ocamlbuild_plugin
-
- module Util = struct
- let split s ch =
- let x = ref [] in
- let rec go s =
- let pos = String.index s ch in
- x := (String.before s pos)::!x;
- go (String.after s (pos + 1))
- in
- try
- go s
- with Not_found -> !x
-
- let split_nl s = split s '\n'
- let run_and_read x = List.hd (split_nl (Ocamlbuild_pack.My_unix.run_and_read x))
- end
-
- module Xen = struct
- (** Link to a standalone Xen microkernel *)
- let cc_xen_link bc tags arg out env =
- (* XXX check ocamlfind path here *)
- let xenlib = Util.run_and_read "ocamlfind query mirage" in
- let jmp_obj = Px (xenlib / "longjmp.o") in
- let head_obj = Px (xenlib / "x86_64.o") in
- let ocamllib = match bc with |true -> "ocamlbc" |false -> "ocaml" in
- let ld = getenv ~default:"ld" "LD" in
- let ldlibs = List.map (fun x -> Px (xenlib / ("lib" ^ x ^ ".a")))
- [ocamllib; "xen"; "xencaml"; "diet"; "m"] in
- Cmd (S ( A ld :: [ T(tags++"link"++"xen");
- A"-d"; A"-nostdlib"; A"-m"; A"elf_x86_64"; A"-T";
- Px (xenlib / "mirage-x86_64.lds"); head_obj; P arg ]
- @ ldlibs @ [jmp_obj; A"-o"; Px out]))
-
- let cc_xen_bc_link tags arg out env = cc_xen_link true tags arg out env
- let cc_xen_nc_link tags arg out env = cc_xen_link false tags arg out env
-
- (* Rewrite sections for Xen LDS layout *)
- let xen_objcopy dst src env builder =
- let dst = env dst in
- let src = env src in
- let cmd = ["objcopy";"--rename-section";".bss=.mlbss";"--rename-section";
- ".data=.mldata";"--rename-section";".rodata=.mlrodata";
- "--rename-section";".text=.mltext"] in
- let cmds = List.map (fun x -> A x) cmd in
- Cmd (S (cmds @ [Px src; Px dst]))
-
- let rules () =
- let cc_link_c_implem ?tag fn c o env build =
- let c = env c and o = env o in
- fn (tags_of_pathname c++"implem"+++tag) c o env
- in
- rule "final link: %.nobj.o -> %.xen" ~prod:"%(file).xen" ~dep:"%(file).nobj.o"
- (cc_link_c_implem cc_xen_nc_link "%(file).nobj.o" "%(file).xen")
-
- end
-
- let dispatch =
- function
- | After_rules ->
- Xen.rules ()
- | _ ->
- ()
-end
-
module MyOCamlbuildFindlib = struct
-# 21 "/home/djs/oasis/src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml"
+(* # 21 "/home/avsm/.opam/system/build/oasis-mirage.0.3.0a/src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
(** OCamlbuild extension, copied from
* http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild
@@ -358,11 +290,20 @@ module MyOCamlbuildFindlib = struct
* linking. *)
List.iter
begin fun pkg ->
- flag ["ocaml"; "compile"; "pkg_"^pkg] & S[A"-package"; A pkg];
- flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S[A"-package"; A pkg];
- flag ["ocaml"; "doc"; "pkg_"^pkg] & S[A"-package"; A pkg];
- flag ["ocaml"; "link"; "pkg_"^pkg] & S[A"-package"; A pkg];
- flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S[A"-package"; A pkg];
+ let base_args = [A"-package"; A pkg] in
+ let syn_args = [A"-syntax"; A "camlp4o"] in
+ let args =
+ (* heuristic to identify syntax extensions:
+ whether they end in ".syntax"; some might not *)
+ if Filename.check_suffix pkg "syntax"
+ then syn_args @ base_args
+ else base_args
+ in
+ flag ["ocaml"; "compile"; "pkg_"^pkg] & S args;
+ flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
+ flag ["ocaml"; "doc"; "pkg_"^pkg] & S args;
+ flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args;
+ flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
end
(find_packages ());
@@ -394,7 +335,7 @@ module MyOCamlbuildFindlib = struct
end
module MyOCamlbuildBase = struct
-# 21 "/home/djs/oasis/src/plugins/ocamlbuild/MyOCamlbuildBase.ml"
+(* # 21 "/home/avsm/.opam/system/build/oasis-mirage.0.3.0a/src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
(** Base functions for writing myocamlbuild.ml
@author Sylvain Le Gall
@@ -410,7 +351,7 @@ module MyOCamlbuildBase = struct
type name = string
type tag = string
-# 56 "/home/djs/oasis/src/plugins/ocamlbuild/MyOCamlbuildBase.ml"
+(* # 56 "/home/avsm/.opam/system/build/oasis-mirage.0.3.0a/src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
type t =
{
@@ -527,11 +468,20 @@ module MyOCamlbuildBase = struct
let native_output_obj x =
OC.link_gen "cmx" "cmxa" !Options.ext_lib [!Options.ext_obj; "cmi"]
OC.ocamlopt_link_prog
- (fun tags -> tags++"ocaml"++"link"++"byte"++"output_obj") x
+ (fun tags -> tags++"ocaml"++"link"++"native"++"output_obj") x
in
rule "ocaml: cmx* and o* -> .nobj.o" ~prod:"%.nobj.o" ~deps:["%.cmx"; "%.o"]
(native_output_obj "%.cmx" "%.nobj.o");
+ (* Add output_obj rules mapped to .bobj.o *)
+ let bytecode_output_obj x =
+ OC.link_gen "cmo" "cma" !Options.ext_lib [!Options.ext_obj; "cmi"]
+ OC.ocamlc_link_prog
+ (fun tags -> tags++"ocaml"++"link"++"byte"++"output_obj") x
+ in
+ rule "ocaml: cmo* -> .nobj.o" ~prod:"%.bobj.o" ~deps:["%.cmo"]
+ (bytecode_output_obj "%.cmo" "%.bobj.o");
+
(* Add flags *)
List.iter
(fun (tags, cond_specs) ->
@@ -548,13 +498,12 @@ module MyOCamlbuildBase = struct
[
dispatch t;
MyOCamlbuildFindlib.dispatch;
- MyOCamlbuildXen.dispatch;
]
end
-# 557 "myocamlbuild.ml"
+# 506 "myocamlbuild.ml"
open Ocamlbuild_plugin;;
let package_default =
{
@@ -589,6 +538,6 @@ let package_default =
let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;;
-# 593 "myocamlbuild.ml"
+# 542 "myocamlbuild.ml"
(* OASIS_STOP *)
Ocamlbuild_plugin.dispatch dispatch_default;;
Oops, something went wrong.

0 comments on commit e3b9125

Please sign in to comment.