Commit 275b6e3f authored by François Bobot's avatar François Bobot

runstrat: try to write an automatic strategy in why3 as an independent project.

Try to use the way make do parallelism. It is able to
interact with the parallelism of make as sub-makes do.
parent fcb8f0e8
......@@ -1181,6 +1181,7 @@ install_local: bin/why3doc
bench:: bin/why3.@OCAMLBEST@ bin/why3config.@OCAMLBEST@ plugins $(TOOLS)
$(MAKE) test-api.@OCAMLBEST@
$(MAKE) test-runstrat.@OCAMLBEST@
sh bench/bench "bin/why3.@OCAMLBEST@"
@if test "@enable_coq_tactic@" = "yes"; then \
echo "=== checking the Coq tactic ==="; \
......@@ -1240,6 +1241,16 @@ test-api.opt: examples/use_api.ml src/why3.cmxa
test-shape: src/why3.cma
ocaml -I src/ $(INCLUDES) $(EXTCMA) $? examples/test_shape.ml
#only test the compilation of runstrat
test-runstrat.byte: $(LOCALWHY3LIB)/why3.cmxa $(LOCALWHY3LIB)/why3ml.cmxa $(LOCALWHY3LIB)/META
OCAMLPATH=$(PWD)/lib-ocaml $(MAKE) -C examples/runstrat clean
OCAMLPATH=$(PWD)/lib-ocaml $(MAKE) -C examples/runstrat byte
test-runstrat.opt: $(LOCALWHY3LIB)/why3.cmxa $(LOCALWHY3LIB)/why3ml.cmxa $(LOCALWHY3LIB)/META
OCAMLPATH=$(PWD)/lib-ocaml $(MAKE) -C examples/runstrat clean
OCAMLPATH=$(PWD)/lib-ocaml $(MAKE) -C examples/runstrat opt
test-runstrat: test-runstrat.$(OCAMLBEST)
################
# documentation
......
BINDIR=/usr/local/bin
OCAMLFIND = ocamlfind
OCAMLFIND_OPT = $(addprefix -package ,$(PACKAGES)) -annot
OCAMLOPT = $(OCAMLFIND) ocamlopt $(OCAMLFIND_OPT)
OCAMLC = $(OCAMLFIND) ocamlc $(OCAMLFIND_OPT)
OCAMLDEP = $(OCAMLFIND) ocamldep $(OCAMLFIND_OPT)
PACKAGES = unix str
all:makejob runstrat
opt: makejob.opt runstrat.opt
byte: makejob.byte runstrat.byte
printconf:
echo $(OCAMLPATH)
ocamlfind printconf
makeproto.cmo: makeproto.cmi
makeproto.cmx: makeproto.cmi
makejob.opt: makeproto.cmx makejob.ml
makejob.byte: makeproto.cmo makejob.ml
makejob: makejob.opt
@rm -f makejob
ln -s makejob.opt makejob
runstrat.opt runstrat.byte: PACKAGES += why3 why3.ml
runstrat.opt: makeproto.cmx runstrat.ml
runstrat.byte: makeproto.cmo runstrat.ml
runstrat: runstrat.opt
@rm -f runstrat
ln -s runstrat.opt runstrat
install:
mkdir -p $(BINDIR)
cp runstrat.opt $(BINDIR)/runstrat
cp makejob.opt $(BINDIR)/makejob
clean:
rm -f *.cmo *.cma *.cmx *.cmi *.o *.annot *.opt
rm -f runstrat makejob
### Tests ###
.PHONY: test_makejob %.test_makejob_aux
TEST_MAKEJOB=$(addsuffix .test_makejob_aux , $(shell seq 5 -1 1))
test_makejob: $(TEST_MAKEJOB)
@echo Done $(TEST_MAKEJOB)
%.test_makejob_aux: makejob
@echo Run $*
+./run_wait.ml e 10 ./echo_wait.ml $*
@echo Done $*
################
# generic rules
################
%.cmi: %.mli
$(if $(QUIET),@echo 'Ocamlc $<' &&) $(OCAMLC) -c $<
%.cmo: %.ml
$(if $(QUIET),@echo 'Ocamlc $<' &&) $(OCAMLC) -c $<
%.cmx: %.ml
$(if $(QUIET),@echo 'Ocamlopt $<' &&) $(OCAMLOPT) -c $<
%.dep: %.ml
$(if $(QUIET),@echo 'Ocamldep $<' &&) $(OCAMLDEP) $(DEPFLAGS) $< $<i > $@
%.opt:
$(if $(QUIET),@echo 'Ocamlopt $<' &&) $(OCAMLOPT) -linkpkg -o $@ $^
%.byte:
$(if $(QUIET),@echo 'Ocamlc $<' &&) $(OCAMLC) -linkpkg -o $@ $^
#!/usr/bin/env ocaml
#load "unix.cma";;
open Format
let print_args fmt =
for i = 1 to Array.length Sys.argv - 1 do
fprintf fmt "%s" Sys.argv.(i);
if i <> Array.length Sys.argv - 1
then fprintf fmt " "
done
let max_sleep =
try float_of_string (Sys.argv.(1))
with _ -> 1.0
let () =
Random.self_init ();
let sleep = Random.float max_sleep in
printf "echo %f wait %t@." sleep print_args;
ignore (Unix.select [] [] [] sleep);
printf "echo done %t@." print_args
(**************************************************************************)
(* *)
(* Copyright (C) 2010-2012 *)
(* François Bobot *)
(* Jean-Christophe Filliâtre *)
(* Claude Marché *)
(* Guillaume Melquiond *)
(* Andrei Paskevich *)
(* *)
(* This software is free software; you can redistribute it and/or *)
(* modify it under the terms of the GNU Library General Public *)
(* License version 2.1, with the special exception on linking *)
(* described in file LICENSE. *)
(* *)
(* This software is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *)
(* *)
(**************************************************************************)
(** This simple program implement the client side of the make
jobserver protocole. It ask for a job token and release it after completion
of the command
http://mad-scientist.net/make/jobserver.html
*)
(** ./makejob fdid_in fdid_out command [command options]
fdid_in and fdid_out are valid filedescriptor given by the caller
*)
open Format
let print_usage fmt =
fprintf fmt "usage: %s fdid_in fdid_out command [command options]@."
Sys.argv.(0)
(** Test there is enough arguments *)
let () = if Array.length Sys.argv < 4
then begin
print_usage err_formatter; exit 1;
end
let cmd,args = Sys.argv.(3),Array.sub Sys.argv 3 (Array.length Sys.argv - 3)
(** How should I do that? *)
let fd_of_int : int -> Unix.file_descr = Obj.magic
(** parse the file descriptor *)
let pipe =
let fdid_in, fdid_out =
try int_of_string Sys.argv.(1), int_of_string Sys.argv.(2)
with Invalid_argument _ ->
eprintf "The first two argument must be the number of a file descriptor%t"
print_usage;
exit 1
in
Makeproto.from_fd_id fdid_in fdid_out
let run_job f =
Makeproto.wait_worker pipe;
try
let res = f () in
Makeproto.release_worker pipe;
res
with exn ->
Makeproto.release_worker pipe;
raise exn
(** Execute the command *)
let () =
let ps = run_job (fun () ->
let pid = Unix.create_process cmd args
Unix.stdin Unix.stdout Unix.stderr in
let rpid,ps = Unix.waitpid [] pid in
assert (pid = rpid);
ps) in
match ps with
| Unix.WEXITED i -> exit i
| Unix.WSIGNALED i ->
(** Should not appear on windows ? *)
Unix.kill (Unix.getpid ()) Sys.sigterm
| Unix.WSTOPPED _ ->
(** Not possible since we doesn't wait for that *)
assert false
(**************************************************************************)
(* *)
(* Copyright (C) 2010-2012 *)
(* François Bobot *)
(* Jean-Christophe Filliâtre *)
(* Claude Marché *)
(* Guillaume Melquiond *)
(* Andrei Paskevich *)
(* *)
(* This software is free software; you can redistribute it and/or *)
(* modify it under the terms of the GNU Library General Public *)
(* License version 2.1, with the special exception on linking *)
(* described in file LICENSE. *)
(* *)
(* This software is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *)
(* *)
(**************************************************************************)
open Format
(** Make protocol for parallelism **)
type pipe = { pin : Unix.file_descr;
pout: Unix.file_descr }
type t =
| Sequential
| Parallel of pipe
exception Invalid_fd of Unix.file_descr * pipe
exception Bad_IO of Unix.file_descr * pipe
(** How should I do that? *)
let fd_of_int : int -> Unix.file_descr = Obj.magic
let int_of_fd : Unix.file_descr -> int = Obj.magic
let print_fd fmt fd =
fprintf fmt "%i" (int_of_fd fd)
let print_pipe fmt pipe =
fprintf fmt "%a,%a" print_fd pipe.pin print_fd pipe.pout
let read_makeflags () =
(** slave *)
try
let flags = Sys.getenv "MAKEFLAGS" in
let r = Str.regexp "--jobserver-fds=\\([0-9]+\\),\\([0-9]+\\)" in
ignore (Str.search_forward r flags 0);
Parallel
{pin = fd_of_int (int_of_string (Str.matched_group 1 flags));
pout = fd_of_int (int_of_string (Str.matched_group 2 flags))}
with Not_found ->
(** No MAKEFLAGS or no --jobserver-fds: sequential*)
Sequential
let make_jobserver j =
if j <= 1 then
invalid_arg "make_serverjob: number of worker must be greater than 1";
(** master *)
let pin,pout = Unix.pipe () in
let pipe = {pin = pin; pout = pout} in
let s = String.make 1 '|' in
for i = 1 to j do
ignore (Unix.write pipe.pout s 0 1)
done;
pipe
let from_fd_id pin pout =
let pipe = {pin = fd_of_int pin; pout = fd_of_int pout} in
begin try ignore (Unix.select [pipe.pin] [] [] 0.)
with Unix.Unix_error (Unix.EBADF,_,_) ->
raise (Invalid_fd (pipe.pin,pipe));
end;
begin try ignore (Unix.select [] [pipe.pout] [] 0.)
with Unix.Unix_error (Unix.EBADF,_,_) ->
raise (Invalid_fd (pipe.pout,pipe))
end;
pipe
(** Wait for a job token *)
let wait_worker pipe =
let s = String.create 1 in
let n =
try Unix.read pipe.pin s 0 1
with Unix.Unix_error(Unix.EBADF,_,_) ->
raise (Invalid_fd (pipe.pin,pipe))
in
if n <> 1 then raise (Bad_IO (pipe.pin,pipe))
(** Give back the job token *)
let release_worker =
let s = String.make 1 '|' in
fun pipe ->
let n =
try Unix.write pipe.pout s 0 1
with Unix.Unix_error(Unix.EBADF,_,_) ->
raise (Invalid_fd (pipe.pout,pipe))
in
if n <> 1 then raise (Bad_IO (pipe.pout,pipe))
let print_error fmt = function
| Invalid_fd (fd,pipe) ->
fprintf fmt "Invalid file descriptor given %a for the pipe (%a)"
print_fd fd print_pipe pipe
| Bad_IO (fd,pipe) ->
fprintf fmt "Bad io for the file descriptor given %a for the pipe (%a)"
print_fd fd print_pipe pipe
| exn -> raise exn
(**************************************************************************)
(* *)
(* Copyright (C) 2010-2012 *)
(* François Bobot *)
(* Jean-Christophe Filliâtre *)
(* Claude Marché *)
(* Guillaume Melquiond *)
(* Andrei Paskevich *)
(* *)
(* This software is free software; you can redistribute it and/or *)
(* modify it under the terms of the GNU Library General Public *)
(* License version 2.1, with the special exception on linking *)
(* described in file LICENSE. *)
(* *)
(* This software is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *)
(* *)
(**************************************************************************)
(** Make protocol for parallelism **)
type pipe = { pin : Unix.file_descr;
pout: Unix.file_descr }
type t =
| Sequential
| Parallel of pipe
val print_pipe: Format.formatter -> pipe -> unit
val print_fd: Format.formatter -> Unix.file_descr -> unit
val read_makeflags: unit -> t
(** Get from the environnement the jobserver created by make *)
val make_jobserver: int -> pipe
(** create a jobserver with the given number of worker *)
val wait_worker: pipe -> unit
(** wait for a free worker *)
val release_worker: pipe -> unit
(** release a worker *)
val from_fd_id : int -> int -> pipe
exception Invalid_fd of Unix.file_descr * pipe
exception Bad_IO of Unix.file_descr * pipe
val print_error: Format.formatter -> exn -> unit
(** print the exceptions of this module *)
#!/usr/bin/env ocaml
(** a mini-mini-make or mini-mini-sub-make
just the protocole for parallelism
*)
#load "unix.cma";;
#load "str.cma";;
open Format
let print_args fmt arr =
for i = 1 to Array.length arr - 1 do
fprintf fmt "%s" arr.(i);
if i <> Array.length arr - 1
then fprintf fmt " "
done
let add_id = true
let create_process cmd args id =
if add_id then args.(Array.length args - 1) <- string_of_int id;
Unix.create_process cmd args Unix.stdin Unix.stdout Unix.stderr
let cmd = Sys.argv.(3)
let args =
let add_arg = if add_id then 1 else 0 in
let t = Array.make (Array.length Sys.argv + add_arg - 3) "" in
Array.blit Sys.argv 3 t 0 (Array.length Sys.argv - 3);
t
let nb_run = max (int_of_string Sys.argv.(2)) 1
let nb_j = Sys.argv.(1)
type pipe = { pin : Unix.file_descr;
pout: Unix.file_descr }
(** How should I do that? *)
let fd_of_int : int -> Unix.file_descr = Obj.magic
let int_of_fd : Unix.file_descr -> int = Obj.magic
let pipe =
if nb_j = "e" then
(** slave *)
try
let flags = Sys.getenv "MAKEFLAGS" in
let r = Str.regexp "--jobserver-fds=\\([0-9]+\\),\\([0-9]+\\)" in
ignore (Str.search_forward r flags 0);
{pin = fd_of_int (int_of_string (Str.matched_group 1 flags));
pout = fd_of_int (int_of_string (Str.matched_group 2 flags))}
with Not_found ->
(** No MAKEFLAGS or no --jobserver-fds: sequential*)
for i = 1 to nb_run do
let pid = create_process cmd args i in
ignore (Unix.waitpid [] pid);
done;
exit 0
else (** number of worker as argument *)
(** master *)
let pj = try int_of_string nb_j
with _ ->
eprintf
"The first argument must be 'e' or the number of simultaneous \
workers@.";
exit 1
in
let pj = max pj 1 in
let pin,pout = Unix.pipe () in
let pipe = {pin = pin; pout = pout} in
let s = String.make 1 '|' in
for i = 1 to pj - 1 do (* one for run_wait.ml *)
ignore (Unix.write pipe.pout s 0 1)
done;
pipe
let makejob = "./makejob"
let makejob_args =
let t = Array.make (Array.length args + 3) "" in
Array.blit args 0 t 3 (Array.length args);
t.(0) <- makejob;
t.(1) <- string_of_int (int_of_fd pipe.pin);
t.(2) <- string_of_int (int_of_fd pipe.pout);
t
(* let () = *)
(* eprintf "Sys.argv:%a@.args:%a@.makejobs_args:%a@." *)
(* print_args Sys.argv *)
(* print_args args *)
(* print_args makejob_args *)
let () =
for i = 1 to nb_run - 1 do
ignore (create_process cmd args i)
done;
ignore (create_process cmd args nb_run);
eprintf "run_wait: *** Attente des tâches non terminées....@.";
let remaining_child = ref nb_run in
while !remaining_child <> 0 do
ignore (Unix.wait ()); decr remaining_child;
done
(*
(** If the arguments are e and e then we should read ourself --jobserver-fds *)
let () = if Sys.argv.(1) = "d" && Sys.argv.(2) = "d" then
try
Unix.execv cmd args
with Unix.Unix_error(err,_,_) ->
eprintf "Can't run exec the program %s:%s@." cmd (Unix.error_message err);
exit 1
*)
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment