(* $Id$ *) open Netplex_types let plugin = (object method required = [ Netplex_sharedvar.plugin; Netplex_semaphore.plugin ] method program = failwith "Netplex_mbox#program" method ctrl_added _ = () method ctrl_unplugged _ = () method ctrl_receive_call _ _ _ _ _ = () method ctrl_container_finished _ _ _ = () end : plugin ) module type MBOX = sig type t type mbox val create : string -> mbox val send : mbox -> t -> unit val receive : mbox -> t end module Make_mbox_type(T:Netplex_cenv.TYPE) = struct type t = T.t type mbox = string module Message_var = Netplex_sharedvar.Make_var_type(T) let create name = let box_name = "netplex." ^ name ^ ".box" in let sem1_name = "netplex." ^ name ^ ".sem1" in let sem2_name = "netplex." ^ name ^ ".sem2" in let box_created = Netplex_sharedvar.create_var ~enc:true box_name in if box_created then ( (* init semaphores *) ignore(Netplex_semaphore.create sem1_name 0L); ignore(Netplex_semaphore.create sem2_name 1L); (* Message_var.set box_name Null *) ) else ignore(Netplex_sharedvar.wait_for_enc_value box_name); name let send name (msg : t) = let box_name = "netplex." ^ name ^ ".box" in let sem1_name = "netplex." ^ name ^ ".sem1" in let sem2_name = "netplex." ^ name ^ ".sem2" in ignore(Netplex_semaphore.decrement ~wait:true sem2_name); Message_var.set box_name msg; ignore(Netplex_semaphore.increment sem1_name) let receive name = let box_name = "netplex." ^ name ^ ".box" in let sem1_name = "netplex." ^ name ^ ".sem1" in let sem2_name = "netplex." ^ name ^ ".sem2" in ignore(Netplex_semaphore.decrement ~wait:true sem1_name); let msg = Message_var.get box_name in ignore(Netplex_semaphore.increment sem2_name); msg end