Make -j default to the number of CPUs (#726)
This commit is contained in:
parent
c406a51bb3
commit
53202d0a09
|
@ -18,6 +18,9 @@ next
|
||||||
- Fix a bug causing `jbuilder external-lib-deps` to crash (#723,
|
- Fix a bug causing `jbuilder external-lib-deps` to crash (#723,
|
||||||
@diml)
|
@diml)
|
||||||
|
|
||||||
|
- `-j` now defaults to the number of processing units available rather
|
||||||
|
4 (#726, @diml)
|
||||||
|
|
||||||
1.0+beta20 (10/04/2018)
|
1.0+beta20 (10/04/2018)
|
||||||
-----------------------
|
-----------------------
|
||||||
|
|
||||||
|
|
15
bin/main.ml
15
bin/main.ml
|
@ -95,6 +95,11 @@ module Scheduler = struct
|
||||||
include Jbuilder.Scheduler
|
include Jbuilder.Scheduler
|
||||||
|
|
||||||
let go ?log ~common fiber =
|
let go ?log ~common fiber =
|
||||||
|
let fiber =
|
||||||
|
Main.set_concurrency ?log common.config
|
||||||
|
>>= fun () ->
|
||||||
|
fiber
|
||||||
|
in
|
||||||
Scheduler.go ?log ~config:common.config fiber
|
Scheduler.go ?log ~config:common.config fiber
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -274,8 +279,16 @@ let common =
|
||||||
in
|
in
|
||||||
let docs = copts_sect in
|
let docs = copts_sect in
|
||||||
let concurrency =
|
let concurrency =
|
||||||
|
let arg =
|
||||||
|
Arg.conv
|
||||||
|
((fun s ->
|
||||||
|
Result.map_error (Config.Concurrency.of_string s)
|
||||||
|
~f:(fun s -> `Msg s)),
|
||||||
|
fun pp x ->
|
||||||
|
Format.pp_print_string pp (Config.Concurrency.to_string x))
|
||||||
|
in
|
||||||
Arg.(value
|
Arg.(value
|
||||||
& opt (some int) None
|
& opt (some arg) None
|
||||||
& info ["j"] ~docs ~docv:"JOBS"
|
& info ["j"] ~docs ~docv:"JOBS"
|
||||||
~doc:{|Run no more than $(i,JOBS) commands simultaneously.|}
|
~doc:{|Run no more than $(i,JOBS) commands simultaneously.|}
|
||||||
)
|
)
|
||||||
|
|
|
@ -41,12 +41,41 @@ module Display = struct
|
||||||
let t = enum all
|
let t = enum all
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Concurrency = struct
|
||||||
|
type t =
|
||||||
|
| Fixed of int
|
||||||
|
| Auto
|
||||||
|
|
||||||
|
let error =
|
||||||
|
Error "invalid concurrency value, must be 'auto' or a positive number"
|
||||||
|
|
||||||
|
let of_string = function
|
||||||
|
| "auto" -> Ok Auto
|
||||||
|
| s ->
|
||||||
|
match int_of_string s with
|
||||||
|
| exception _ -> error
|
||||||
|
| n ->
|
||||||
|
if n >= 1 then
|
||||||
|
Ok (Fixed n)
|
||||||
|
else
|
||||||
|
error
|
||||||
|
|
||||||
|
let t sexp =
|
||||||
|
match of_string (string sexp) with
|
||||||
|
| Ok t -> t
|
||||||
|
| Error msg -> of_sexp_error sexp msg
|
||||||
|
|
||||||
|
let to_string = function
|
||||||
|
| Auto -> "auto"
|
||||||
|
| Fixed n -> string_of_int n
|
||||||
|
end
|
||||||
|
|
||||||
module type S = sig
|
module type S = sig
|
||||||
type 'a field
|
type 'a field
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ display : Display.t field
|
{ display : Display.t field
|
||||||
; concurrency : int field
|
; concurrency : Concurrency.t field
|
||||||
}
|
}
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -65,14 +94,14 @@ let merge t (partial : Partial.t) =
|
||||||
|
|
||||||
let default =
|
let default =
|
||||||
{ display = if inside_dune then Quiet else Progress
|
{ display = if inside_dune then Quiet else Progress
|
||||||
; concurrency = if inside_dune then 1 else 4
|
; concurrency = if inside_dune then Fixed 1 else Auto
|
||||||
}
|
}
|
||||||
|
|
||||||
let t =
|
let t =
|
||||||
record
|
record
|
||||||
(field "display" Display.t ~default:default.display
|
(field "display" Display.t ~default:default.display
|
||||||
>>= fun display ->
|
>>= fun display ->
|
||||||
field "jobs" int ~default:default.concurrency
|
field "jobs" Concurrency.t ~default:default.concurrency
|
||||||
>>= fun concurrency ->
|
>>= fun concurrency ->
|
||||||
return { display
|
return { display
|
||||||
; concurrency
|
; concurrency
|
||||||
|
|
|
@ -34,12 +34,21 @@ module Display : sig
|
||||||
val all : (string * t) list
|
val all : (string * t) list
|
||||||
end
|
end
|
||||||
|
|
||||||
|
module Concurrency : sig
|
||||||
|
type t =
|
||||||
|
| Fixed of int
|
||||||
|
| Auto
|
||||||
|
|
||||||
|
val of_string : string -> (t, string) result
|
||||||
|
val to_string : t -> string
|
||||||
|
end
|
||||||
|
|
||||||
module type S = sig
|
module type S = sig
|
||||||
type 'a field
|
type 'a field
|
||||||
|
|
||||||
type t =
|
type t =
|
||||||
{ display : Display.t field
|
{ display : Display.t field
|
||||||
; concurrency : int field
|
; concurrency : Concurrency.t field
|
||||||
}
|
}
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
62
src/main.ml
62
src/main.ml
|
@ -137,6 +137,56 @@ let ignored_during_bootstrap =
|
||||||
; "example"
|
; "example"
|
||||||
])
|
])
|
||||||
|
|
||||||
|
let auto_concurrency =
|
||||||
|
let v = ref None in
|
||||||
|
fun ?(log=Log.no_log) () ->
|
||||||
|
match !v with
|
||||||
|
| Some n -> Fiber.return n
|
||||||
|
| None ->
|
||||||
|
(if Sys.win32 then
|
||||||
|
match Env.get Env.initial "NUMBER_OF_PROCESSORS" with
|
||||||
|
| None -> Fiber.return 1
|
||||||
|
| Some s ->
|
||||||
|
match int_of_string s with
|
||||||
|
| exception _ -> Fiber.return 1
|
||||||
|
| n -> Fiber.return n
|
||||||
|
else
|
||||||
|
let commands =
|
||||||
|
[ "nproc", []
|
||||||
|
; "getconf", ["_NPROCESSORS_ONLN"]
|
||||||
|
; "getconf", ["NPROCESSORS_ONLN"]
|
||||||
|
]
|
||||||
|
in
|
||||||
|
let rec loop = function
|
||||||
|
| [] -> Fiber.return 1
|
||||||
|
| (prog, args) :: rest ->
|
||||||
|
match Bin.which prog with
|
||||||
|
| None -> loop rest
|
||||||
|
| Some prog ->
|
||||||
|
Process.run_capture (Accept All) prog args ~env:Env.initial
|
||||||
|
>>= function
|
||||||
|
| Error _ -> loop rest
|
||||||
|
| Ok s ->
|
||||||
|
match int_of_string (String.trim s) with
|
||||||
|
| n -> Fiber.return n
|
||||||
|
| exception _ -> loop rest
|
||||||
|
in
|
||||||
|
loop commands)
|
||||||
|
>>| fun n ->
|
||||||
|
Log.infof log "Auto-detected concurrency: %d" n;
|
||||||
|
v := Some n;
|
||||||
|
n
|
||||||
|
|
||||||
|
let set_concurrency ?log (config : Config.t) =
|
||||||
|
(match config.concurrency with
|
||||||
|
| Fixed n -> Fiber.return n
|
||||||
|
| Auto -> auto_concurrency ?log ())
|
||||||
|
>>= fun n ->
|
||||||
|
if n >= 1 then
|
||||||
|
Scheduler.set_concurrency n
|
||||||
|
else
|
||||||
|
Fiber.return ()
|
||||||
|
|
||||||
(* Called by the script generated by ../build.ml *)
|
(* Called by the script generated by ../build.ml *)
|
||||||
let bootstrap () =
|
let bootstrap () =
|
||||||
Colors.setup_err_formatter_colors ();
|
Colors.setup_err_formatter_colors ();
|
||||||
|
@ -154,9 +204,13 @@ let bootstrap () =
|
||||||
display := Some (List.assoc s Config.Display.all))
|
display := Some (List.assoc s Config.Display.all))
|
||||||
in
|
in
|
||||||
let concurrency = ref None in
|
let concurrency = ref None in
|
||||||
let set r x = r := Some x in
|
let concurrency_arg x =
|
||||||
|
match Config.Concurrency.of_string x with
|
||||||
|
| Error msg -> raise (Arg.Bad msg)
|
||||||
|
| Ok c -> concurrency := Some c
|
||||||
|
in
|
||||||
Arg.parse
|
Arg.parse
|
||||||
[ "-j" , Int (set concurrency), "JOBS concurrency"
|
[ "-j" , String concurrency_arg, "JOBS concurrency"
|
||||||
; "--dev" , Set Clflags.dev_mode , " set development mode"
|
; "--dev" , Set Clflags.dev_mode , " set development mode"
|
||||||
; "--display" , display_mode , " set the display mode"
|
; "--display" , display_mode , " set the display mode"
|
||||||
; "--subst" , Unit subst ,
|
; "--subst" , Unit subst ,
|
||||||
|
@ -186,7 +240,9 @@ let bootstrap () =
|
||||||
in
|
in
|
||||||
let log = Log.create ~display:config.display () in
|
let log = Log.create ~display:config.display () in
|
||||||
Scheduler.go ~log ~config
|
Scheduler.go ~log ~config
|
||||||
(setup ~log ~workspace:{ merlin_context = Some "default"
|
(set_concurrency config
|
||||||
|
>>= fun () ->
|
||||||
|
setup ~log ~workspace:{ merlin_context = Some "default"
|
||||||
; contexts = [Default [Native]] }
|
; contexts = [Default [Native]] }
|
||||||
~extra_ignored_subtrees:ignored_during_bootstrap
|
~extra_ignored_subtrees:ignored_during_bootstrap
|
||||||
()
|
()
|
||||||
|
|
|
@ -38,6 +38,9 @@ val find_context_exn : setup -> name:string -> Context.t
|
||||||
(** Setup the environment *)
|
(** Setup the environment *)
|
||||||
val setup_env : capture_outputs:bool -> Env.t
|
val setup_env : capture_outputs:bool -> Env.t
|
||||||
|
|
||||||
|
(** Set the concurrency level according to the user configuration *)
|
||||||
|
val set_concurrency : ?log:Log.t -> Config.t -> unit Fiber.t
|
||||||
|
|
||||||
(**/**)
|
(**/**)
|
||||||
|
|
||||||
(* This is used to bootstrap jbuilder itself. It is not part of the
|
(* This is used to bootstrap jbuilder itself. It is not part of the
|
||||||
|
|
|
@ -62,7 +62,7 @@ type t =
|
||||||
{ log : Log.t
|
{ log : Log.t
|
||||||
; original_cwd : string
|
; original_cwd : string
|
||||||
; display : Config.Display.t
|
; display : Config.Display.t
|
||||||
; concurrency : int
|
; mutable concurrency : int
|
||||||
; waiting_for_available_job : t Fiber.Ivar.t Queue.t
|
; waiting_for_available_job : t Fiber.Ivar.t Queue.t
|
||||||
; mutable status_line : string
|
; mutable status_line : string
|
||||||
; mutable gen_status_line : unit -> string option
|
; mutable gen_status_line : unit -> string option
|
||||||
|
@ -95,6 +95,10 @@ let set_status_line_generator f =
|
||||||
Fiber.Var.get_exn t_var >>| fun t ->
|
Fiber.Var.get_exn t_var >>| fun t ->
|
||||||
t.gen_status_line <- f
|
t.gen_status_line <- f
|
||||||
|
|
||||||
|
let set_concurrency n =
|
||||||
|
Fiber.Var.get_exn t_var >>| fun t ->
|
||||||
|
t.concurrency <- n
|
||||||
|
|
||||||
let wait_for_available_job () =
|
let wait_for_available_job () =
|
||||||
Fiber.Var.get_exn t_var >>= fun t ->
|
Fiber.Var.get_exn t_var >>= fun t ->
|
||||||
if Running_jobs.count () < t.concurrency then
|
if Running_jobs.count () < t.concurrency then
|
||||||
|
@ -162,7 +166,7 @@ let go ?(log=Log.no_log) ?(config=Config.default)
|
||||||
; gen_status_line
|
; gen_status_line
|
||||||
; original_cwd = cwd
|
; original_cwd = cwd
|
||||||
; display = config.display
|
; display = config.display
|
||||||
; concurrency = config.concurrency
|
; concurrency = (match config.concurrency with Auto -> 1 | Fixed n -> n)
|
||||||
; status_line = ""
|
; status_line = ""
|
||||||
; waiting_for_available_job = Queue.create ()
|
; waiting_for_available_job = Queue.create ()
|
||||||
}
|
}
|
||||||
|
|
|
@ -18,6 +18,8 @@ val wait_for_process : int -> Unix.process_status Fiber.t
|
||||||
(** Set the status line generator for the current scheduler *)
|
(** Set the status line generator for the current scheduler *)
|
||||||
val set_status_line_generator : (unit -> string option) -> unit Fiber.t
|
val set_status_line_generator : (unit -> string option) -> unit Fiber.t
|
||||||
|
|
||||||
|
val set_concurrency : int -> unit Fiber.t
|
||||||
|
|
||||||
(** Scheduler informations *)
|
(** Scheduler informations *)
|
||||||
type t
|
type t
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue