Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Why3
why3
Commits
28b9f058
Commit
28b9f058
authored
Jan 26, 2011
by
François Bobot
Browse files
Dont create one thread by external proof
parent
b82bb4d2
Changes
3
Hide whitespace changes
Inline
Side-by-side
Makefile.in
View file @
28b9f058
...
...
@@ -424,7 +424,7 @@ install_local: bin/why3config
ifeq
(@enable_ide@,yes)
IDE_FILES
=
gconfig scheduler db gmain
IDE_FILES
=
gconfig
worker
scheduler db gmain
IDEMODULES
=
$(
addprefix
src/ide/,
$(IDE_FILES)
)
...
...
@@ -489,7 +489,7 @@ BENCH_FILES = bench benchrc whybench
BENCHMODULES
:=
$(
addprefix
src/bench/,
$(BENCH_FILES)
)
BENCHMODULES
:=
src/ide/scheduler
$(BENCHMODULES)
BENCHMODULES
:=
src/ide/worker
src/ide/scheduler
$(BENCHMODULES)
BENCHML
=
$(
addsuffix
.ml,
$(BENCHMODULES)
)
BENCHMLI
=
$(
addsuffix
.mli,
$(BENCHMODULES)
)
...
...
src/bench/bench.ml
View file @
28b9f058
...
...
@@ -59,76 +59,7 @@ type ('a,'b) callback = 'a -> 'b -> task -> int -> proof_attempt_status -> unit
let
debug_call
=
Debug
.
register_flag
"call"
let
debug
=
Debug
.
register_flag
"bench_core"
(** Create and manage one main worker which
wait for the remaining works *)
module
MainWorker
:
sig
type
'
a
t
val
create
:
unit
->
'
a
t
val
treat
:
'
a
t
->
(
'
b
->
'
a
->
'
b
)
->
'
b
->
'
b
val
start_work
:
'
a
t
->
unit
val
stop_work
:
'
a
t
->
unit
val
add_work
:
'
a
t
->
'
a
->
unit
val
add_works
:
'
a
t
->
'
a
Queue
.
t
->
unit
end
=
struct
type
'
a
t
=
{
queue
:
'
a
Queue
.
t
;
mutex
:
Mutex
.
t
;
condition
:
Condition
.
t
;
mutable
remaining
:
int
;
}
let
create
()
=
{
queue
=
Queue
.
create
()
;
mutex
=
Mutex
.
create
()
;
condition
=
Condition
.
create
()
;
remaining
=
0
;
}
let
treat
t
f
acc
=
let
rec
main
acc
=
Mutex
.
lock
t
.
mutex
;
while
Queue
.
is_empty
t
.
queue
&&
t
.
remaining
>
0
do
Condition
.
wait
t
.
condition
t
.
mutex
done
;
if
Queue
.
is_empty
t
.
queue
then
begin
(* t.remaining < 0 *)
Mutex
.
unlock
t
.
mutex
;
acc
end
else
begin
let
v
=
Queue
.
pop
t
.
queue
in
Mutex
.
unlock
t
.
mutex
;
let
acc
=
f
acc
v
in
Thread
.
yield
()
;
main
acc
end
in
main
acc
let
start_work
t
=
Mutex
.
lock
t
.
mutex
;
t
.
remaining
<-
t
.
remaining
+
1
;
Mutex
.
unlock
t
.
mutex
let
stop_work
t
=
Mutex
.
lock
t
.
mutex
;
t
.
remaining
<-
t
.
remaining
-
1
;
if
t
.
remaining
=
0
then
Condition
.
signal
t
.
condition
;
Mutex
.
unlock
t
.
mutex
let
add_work
t
x
=
Mutex
.
lock
t
.
mutex
;
Queue
.
push
x
t
.
queue
;
Condition
.
signal
t
.
condition
;
Mutex
.
unlock
t
.
mutex
let
add_works
t
q
=
Mutex
.
lock
t
.
mutex
;
Queue
.
transfer
q
t
.
queue
;
Condition
.
signal
t
.
condition
;
Mutex
.
unlock
t
.
mutex
end
open
Worker
let
call
s
callback
tool
prob
=
(** Prove goal *)
...
...
src/ide/scheduler.ml
View file @
28b9f058
...
...
@@ -20,6 +20,7 @@
open
Format
open
Why
open
Worker
(** max scheduled proofs / max running proofs *)
let
coef_buf
=
2
...
...
@@ -165,7 +166,26 @@ let edit_proof () =
prover_attempts_queue is non empty and
scheduled_proofs < maximum_running_proofs * coef_buf
*)
let
new_external_proof
()
=
let
new_external_proof
=
let
run_external
(
call_prover
,
callback
)
=
Mutex
.
lock
queue_lock
;
decr
scheduled_proofs
;
incr
running_proofs
;
print_debug_nb_running
()
;
Condition
.
signal
queue_condition
;
Mutex
.
unlock
queue_lock
;
!
async
(
fun
()
->
callback
Running
)
()
;
let
r
=
call_prover
()
in
Mutex
.
lock
queue_lock
;
decr
running_proofs
;
print_debug_nb_running
()
;
Queue
.
push
(
Prover_answer
(
callback
,
r
))
answers_queue
;
Condition
.
signal
queue_condition
;
Mutex
.
unlock
queue_lock
in
let
external_workers
=
ManyWorkers
.
create
maximum_running_proofs
run_external
in
fun
()
->
if
!
scheduled_proofs
>=
!
maximum_running_proofs
*
coef_buf
then
raise
Queue
.
Empty
;
let
(
_debug
,
timelimit
,
memlimit
,
old
,
command
,
driver
,
callback
,
goal
)
=
...
...
@@ -188,35 +208,7 @@ let new_external_proof () =
*)
Driver
.
prove_task
?
old
~
command
~
timelimit
~
memlimit
driver
goal
in
let
(
_
:
Thread
.
t
)
=
Thread
.
create
(
fun
()
->
Mutex
.
lock
running_lock
;
while
!
running_proofs
>=
!
maximum_running_proofs
;
do
Condition
.
wait
running_condition
running_lock
done
;
incr
running_proofs
;
Mutex
.
unlock
running_lock
;
Mutex
.
lock
queue_lock
;
decr
scheduled_proofs
;
Condition
.
signal
queue_condition
;
Mutex
.
unlock
queue_lock
;
print_debug_nb_running
()
;
!
async
(
fun
()
->
callback
Running
)
()
;
let
r
=
call_prover
()
in
Mutex
.
lock
running_lock
;
decr
running_proofs
;
Condition
.
signal
running_condition
;
Mutex
.
unlock
running_lock
;
print_debug_nb_running
()
;
Mutex
.
lock
queue_lock
;
Queue
.
push
(
Prover_answer
(
callback
,
r
))
answers_queue
;
Condition
.
signal
queue_condition
;
Mutex
.
unlock
queue_lock
;
()
)
()
in
()
ManyWorkers
.
add_work
external_workers
(
call_prover
,
callback
);
with
|
e
->
eprintf
"%a@."
Exn_printer
.
exn_printer
e
;
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment