diff --git a/bench/README.md b/bench/README.md index 1cd2e8f..a2eddd4 100644 --- a/bench/README.md +++ b/bench/README.md @@ -4,10 +4,10 @@ ```sh $ ./bench.exe name, major-allocated, minor-allocated, monotonic-clock - bench/count 10, 33288.928571, 276123.921429, 17938694.735714 - bench/count 50, 154161.900000, 1236363.100000, 82434000.866667 - bench/count 100, 304196.200000, 2489845.200000, 161951876.400000 - bench/noop 10, 4.755783, 9356.412265, 22565.037398 - bench/noop 50, 74.613901, 54175.014009, 123743.201599 - bench/noop 100, 214.415321, 110480.221914, 276927.142825 + bench/count 10, 5553.085714, 129197.707143, 17226805.828571 + bench/count 50, 25666.571429, 645833.214286, 105844663.571429 + bench/count 100, 52441.000000, 1205587.800000, 176224104.800000 + bench/noop 10, 7.863472, 8759.033395, 20580.506026 + bench/noop 50, 66.498020, 51429.399360, 113273.461087 + bench/noop 100, 195.676704, 104762.484247, 245865.838707 ``` diff --git a/src/lib/ast.ml b/src/lib/ast.ml index 7157f25..acbf7ea 100644 --- a/src/lib/ast.ml +++ b/src/lib/ast.ml @@ -909,7 +909,11 @@ module Fragment = struct globbable = f1.globbable || f2.globbable; } - let join_list ~sep fs = List.fold_left (join ~sep) empty fs |> to_string + let join_list ~sep = function + | [] -> "" + | [ { txt; _ } ] -> txt + | fs -> List.map (fun t -> t.txt) fs |> String.concat sep + let length v = join_list ~sep:"" v |> String.length let pp_join ppf = function diff --git a/src/lib/eval.ml b/src/lib/eval.ml index 9ad1f71..db1ca7c 100644 --- a/src/lib/eval.ml +++ b/src/lib/eval.ml @@ -267,7 +267,6 @@ module Make (S : Types.State) (E : Types.Exec) = struct (* The minimal amount of context needed between pipeline stages. *) type pipeline_ctx = { - stdout : int * Eio_unix.Fd.t * Eio_unix.Private.Fork_action.blocking; stdin : int * Eio_unix.Fd.t * Eio_unix.Private.Fork_action.blocking; } @@ -338,10 +337,23 @@ module Make (S : Types.State) (E : Types.Exec) = struct let cwd_of_ctx ctx = S.cwd ctx.state |> Fpath.to_string |> ( / ) ctx.fs let immediate_built_in v = `Built_in (Promise.create_resolved @@ Ok v) - let get_env ?(extra = Stack.empty) ctx = - let extra = Stack.to_list extra |> List.concat in - let env = extra @ S.exports ctx.state in - List.map (fun (k, v) -> (k, Ast.Fragment.join_list ~sep:"" v)) env + let arg_equals_fast a b = + let s1 = String.length a in + let s2 = String.length b in + let bs = Bytes.create (s1 + 1 + s2) in + Bytes.unsafe_blit_string a 0 bs 0 s1; + Bytes.unsafe_blit_string "=" 0 bs s1 1; + Bytes.unsafe_blit_string b 0 bs (s1 + 1) s2; + Bytes.unsafe_to_string bs + + let get_env ?(extra : (string * Ast.fragments) list Stack.t = Stack.empty) ctx + = + let extra = Stack.to_list extra in + let env = S.exports ctx.state :: extra |> List.rev |> List.concat in + List.map + (fun (k, v) -> arg_equals_fast k @@ Ast.Fragment.join_list ~sep:"" v) + env + |> Array.of_list let update ?export ?readonly ?local ctx ~param v = match S.update ?export ?readonly ?local ctx.state ~param v with @@ -380,106 +392,102 @@ module Make (S : Types.State) (E : Types.Exec) = struct Fmt.epr "%a\n%!" Eio.Exn.pp_err err; Exit.nonzero ~message:(Fmt.str "%a" Eio.Exn.pp_err err) ctx 2 + let set_last_background ~async process ctx = + if async then begin + { ctx with last_background_process = string_of_int (E.pid process) } + end + else ctx + + let on_process ?process ~async ctx = + let ctx = pop_local_state ctx in + match process with + | None -> ctx + | Some process -> set_last_background ~async process ctx + + let handle_job j = function + | `Process (c, p) -> J.add_process c p j + | `Rdr p -> J.add_rdr p j + | `Built_in p -> J.add_built_in p j + | `Noop b -> J.add_noop b j + | `Error p -> J.add_error p j + | `Exit p -> J.add_exit p j + + let update_stdin ~stdin _ = { stdin } + + let exec_process ~async ~sw ctx job ?(fds = []) ?pgid executable args = + let fds = Eunix.keep_first fds in + let pgid = match pgid with None -> 0 | Some p -> p in + let reap = J.get_reaper job in + let mode = + if async then Types.Switched ctx.async_switch else Types.Switched sw + in + let ctx, process = + let hash, prog = + Eunix.resolve_program + ?path:(lookup_and_join ctx.state ~param:"PATH") + ctx.hash executable + in + let ctx = { ctx with hash } in + match (executable, prog) with + | _, None | "", _ -> + Eunix.with_redirections (make_child_rdrs_for_parent fds) ~restore:true + @@ fun () -> + Eio.Flow.copy_string + (Fmt.str "msh: command not found: %s\n" executable) + ctx.stdout; + (ctx, Error 127) + | _, Some full_path -> + Debug.Log.debug (fun f -> + f "executing %a (rdr: %a)" + Fmt.(list ~sep:(Fmt.any " ") (quote string)) + (full_path :: args) + Fmt.(lst Types.pp_redirect) + fds); + ( ctx, + catch_execs_with_error @@ fun () -> + E.exec ctx.executor ~delay_reap:(fst reap) ~fds ~pgid ~mode + ~cwd:(cwd_of_ctx ctx) ~pipe:Safe_fd.pipe + ~env:(get_env ~extra:ctx.local_state ctx) + ~executable:full_path (executable :: args) ) + in + match process with + | Error n -> + let job = handle_job job (`Error n) in + (on_process ~async ctx, job) + | Ok process -> + let pgid = if Int.equal pgid 0 then E.pid process else pgid in + let ctx = on_process ~async ~process ctx in + let job = handle_job job (`Process (ctx, process)) |> J.set_id pgid in + (ctx, job) + let rec handle_pipeline ~async initial_ctx p : ctx Exit.t = (* Push a new local state frame. *) let initial_ctx = { initial_ctx with local_state = Stack.push [] initial_ctx.local_state } in - let set_last_background ~async process ctx = - if async then begin - { ctx with last_background_process = string_of_int (E.pid process) } - end - else ctx - in let should_exit ?with_errexit ctx = should_exit ?with_errexit ctx && List.length p = 1 in - let on_process ?process ~async ctx = - let ctx = pop_local_state ctx in - match process with - | None -> ctx - | Some process -> set_last_background ~async process ctx - in - let handle_job j = function - | `Process (c, p) -> J.add_process c p j - | `Rdr p -> J.add_rdr p j - | `Built_in p -> J.add_built_in p j - | `Noop b -> J.add_noop b j - | `Error p -> J.add_error p j - | `Exit p -> J.add_exit p j - in let close_flow ~is_global (_, fd, _) = if not is_global then begin Eio_unix.Fd.close fd end in - let update_stdin ~stdin ctx = { ctx with stdin } in - let exec_process ~sw ctx job ?(fds = []) ?pgid executable args = - let fds = Eunix.keep_first fds in - let pgid = match pgid with None -> 0 | Some p -> p in - let reap = J.get_reaper job in - let mode = - if async then Types.Switched ctx.async_switch else Types.Switched sw - in - let ctx, process = - let hash, prog = - Eunix.resolve_program - ?path:(lookup_and_join ctx.state ~param:"PATH") - ctx.hash executable - in - let ctx = { ctx with hash } in - match (executable, prog) with - | _, None | "", _ -> - Eunix.with_redirections - (make_child_rdrs_for_parent fds) - ~restore:true - @@ fun () -> - Eio.Flow.copy_string - (Fmt.str "msh: command not found: %s\n" executable) - ctx.stdout; - (ctx, Error 127) - | _, Some full_path -> - Eio.Private.Trace.log - (Fmt.str "executing %a" - Fmt.(lst (quote string)) - (full_path :: args)); - Debug.Log.debug (fun f -> - f "executing %a (rdr: %a)" - Fmt.(list ~sep:(Fmt.any " ") (quote string)) - (full_path :: args) - Fmt.(lst Types.pp_redirect) - fds); - ( ctx, - catch_execs_with_error @@ fun () -> - E.exec ctx.executor ~delay_reap:(fst reap) ~fds ~pgid ~mode - ~cwd:(cwd_of_ctx ctx) ~pipe:Safe_fd.pipe - ~env:(get_env ~extra:ctx.local_state ctx) - ~executable:full_path (executable :: args) ) - in - match process with - | Error n -> - let job = handle_job job (`Error n) in - (on_process ~async ctx, job) - | Ok process -> - let pgid = if Int.equal pgid 0 then E.pid process else pgid in - let ctx = on_process ~async ~process ctx in - let job = handle_job job (`Process (ctx, process)) |> J.set_id pgid in - (ctx, job) - in let job_pgid (t : _ J.t) = J.get_id t in with_pipeline_scope initial_ctx @@ fun initial_ctx -> let rec loop pipeline_switch (pctx : pipeline_ctx) (job : _ J.t) : Ast.command list -> _ J.t = fun c -> - ignore pctx.stdout; let loop = loop pipeline_switch in match c with + | [] -> job | Ast.SimpleCommand (Prefixed (prefix, None, _suffix)) :: rest -> Debug.Log.debug (fun f -> f "assignment-only: %a" Ast_pp.cmd_prefix prefix); let ctx = collect_assignments initial_ctx prefix in let job = handle_job job (`Noop ctx) in loop pctx job rest + | [ Ast.SimpleCommand (Ast.Named ([ Ast.WordName ":" ], None)) ] -> job | Ast.SimpleCommand v :: rest as pipeline -> ( let executable, suffix = match v with @@ -635,9 +643,9 @@ module Make (S : Types.State) (E : Types.Exec) = struct let fds = rdrs @ ctx.rdrs in if ctx.subshell && args <> [] then let _ctx, job = - exec_process ~sw:pipeline_switch ctx job ~fds - ~pgid:(job_pgid job) (Option.get prog) - (List.tl args) + exec_process ~async ~sw:pipeline_switch ctx + job ~fds ~pgid:(job_pgid job) + (Option.get prog) (List.tl args) in job else @@ -651,9 +659,7 @@ module Make (S : Types.State) (E : Types.Exec) = struct if args <> [] then Unix.execve (Option.get prog) (Array.of_list args) - (Array.of_list - @@ List.map (fun (k, v) -> k ^ "=" ^ v) - @@ get_env ~extra:ctx.local_state ctx) + (get_env ~extra:ctx.local_state ctx) else job | ":" -> job | _ -> ( @@ -798,9 +804,10 @@ module Make (S : Types.State) (E : Types.Exec) = struct in let fds = rdrs @ ctx.rdrs in let _ctx, job = - exec_process ~sw:pipeline_switch ctx - job ~fds ~pgid:(job_pgid job) - executable args + exec_process ~async + ~sw:pipeline_switch ctx job ~fds + ~pgid:(job_pgid job) executable + args in Eio.Fiber.fork ~sw: @@ -921,7 +928,6 @@ module Make (S : Types.State) (E : Types.Exec) = struct Debug.Log.debug (fun f -> f "Added %s %a" name dump_ctx ctx); let job = handle_job job (`Noop (Exit.zero ctx)) in loop pctx job rest - | [] -> job in let initial_job = J.make 0 [] in let saved_ctx = initial_ctx in @@ -930,9 +936,9 @@ module Make (S : Types.State) (E : Types.Exec) = struct let name = Option.value ~default:"pipeline" ctx.current_pipeline in Eio.Switch.run ~name @@ fun sw -> let job = - let stdout = find_first_rdr `Stdout ctx.rdrs in + (* let stdout = find_first_rdr `Stdout ctx.rdrs in *) let stdin = find_first_rdr `Stdin ctx.rdrs in - loop sw { stdout; stdin } initial_job p + loop sw { stdin } initial_job p in let ctx = { ctx with stdin = saved_ctx.stdin; state = ctx.state } in match J.size job with diff --git a/src/lib/posix/exec.ml b/src/lib/posix/exec.ml index f6eafcf..ecd50e5 100644 --- a/src/lib/posix/exec.ml +++ b/src/lib/posix/exec.ml @@ -30,11 +30,11 @@ module Process = struct module Fork_action = Eio_unix.Private.Fork_action (* Read a (typically short) error message from a child process. *) - let rec read_response fd = + let read_response fd = let buf = Bytes.create 256 in match Eio_posix.Low_level.read fd buf 0 (Bytes.length buf) with | 0 -> "" - | n -> Bytes.sub_string buf 0 n ^ read_response fd + | n -> Bytes.sub_string buf 0 n let with_pipe fn = Switch.run ~name:"process-pipe" @@ fun sw -> diff --git a/src/lib/posix/merry_posix.ml b/src/lib/posix/merry_posix.ml index 123df3c..710836d 100644 --- a/src/lib/posix/merry_posix.ml +++ b/src/lib/posix/merry_posix.ml @@ -17,11 +17,6 @@ module Exec = struct let exec ?delay_reap ?(fork_actions = []) ?(fds = []) ?stdin ?stdout ?stderr ?env ~mode ~pgid ~cwd ~pipe ~executable t args = - let env = - Option.map - (fun lst -> List.map (fun (a, b) -> a ^ "=" ^ b) lst |> Array.of_list) - env - in try Ok (Exec.run ?delay_reap ~pipe ~fork_actions ~mode ~fds ~pgid ~cwd ?stdin diff --git a/src/lib/posix/state.ml b/src/lib/posix/state.ml index 97fe4d9..f5f2458 100644 --- a/src/lib/posix/state.ml +++ b/src/lib/posix/state.ml @@ -2,9 +2,9 @@ open Merry module Variables = Map.Make (String) module Stack = Merry.Stack -type attributes = { export : bool; readonly : bool; id : string } +type attributes = { readonly : bool; id : string } -let default_attribute = { export = false; readonly = false; id = "id" } +let default_attribute = { readonly = false; id = "id" } type scopes = (attributes * Ast.fragments) Variables.t Stack.t @@ -15,13 +15,14 @@ type t = { outermost : bool; home : string; variables : (attributes * Ast.fragments) Variables.t; + exports : (attributes * Ast.fragments) Variables.t; scopes : scopes; } type variable = Ast.fragments let pp_attr ppf attr = - Fmt.pf ppf "{ export = %b; readonly = %b; id = %a }" attr.export attr.readonly + Fmt.pf ppf "{ readonly = %b; id = %a }" attr.readonly Fmt.(quote string) attr.id @@ -54,9 +55,13 @@ let update ?(id = "") ?(export = false) ?(readonly = false) ?(local = false) t | Some ({ readonly = true; _ }, _) -> Error (Fmt.str "%s: readonly variable" param) | _ -> - let attr = { export; readonly; id } in - let variables' = Variables.add param (attr, v) t.variables in - Ok { t with variables = variables' }) + let attr = { readonly; id } in + if export then + let variables' = Variables.add param (attr, v) t.exports in + Ok { t with exports = variables' } + else + let variables' = Variables.add param (attr, v) t.variables in + Ok { t with variables = variables' }) in let add_local param = let attr = default_attribute in @@ -75,13 +80,22 @@ let seed_env () = List.fold_left (fun vars (param, v) -> let v = [ Ast.Fragment.make v ] in - Variables.add param ({ default_attribute with export = true }, v) vars) + Variables.add param (default_attribute, v) vars) Variables.empty env let make ?(functions = []) ?(root = 0) ?(outermost = true) ?(home = "/root") ?variables cwd = - let variables = match variables with None -> seed_env () | Some v -> v in - { cwd; functions; root; outermost; home; variables; scopes = Stack.empty } + let exports = match variables with None -> seed_env () | Some v -> v in + { + cwd; + functions; + root; + outermost; + home; + exports; + variables = Variables.empty; + scopes = Stack.empty; + } let pop t = match Stack.pop t.scopes with @@ -96,19 +110,27 @@ let cwd t = t.cwd let set_cwd t cwd = { t with cwd } let expand t = function `Tilde -> t.home +let lookup_variables param t = + match Variables.find_opt param t.exports with + | None -> Variables.find_opt param t.variables |> Option.map snd + | Some (_, v) -> Some v + let lookup t ~param = match Stack.peek t.scopes with - | None -> Variables.find_opt param t.variables |> Option.map snd + | None -> lookup_variables param t | Some vs -> ( let locals = Variables.find_opt param vs |> Option.map snd in - match locals with - | Some _ as v -> v - | None -> Variables.find_opt param t.variables |> Option.map snd) + match locals with Some _ as v -> v | None -> lookup_variables param t) let remove ~param t = - match Variables.find_opt param t.variables with - | None -> (false, t) - | Some _ -> (true, { t with variables = Variables.remove param t.variables }) + let b, t = + match Variables.find_opt param t.variables with + | None -> (false, t) + | Some _ -> (true, { t with variables = Variables.remove param t.variables }) + in + match Variables.find_opt param t.exports with + | None -> (b || false, t) + | Some _ -> (true, { t with exports = Variables.remove param t.exports }) let remove_group ~id t = let variables = @@ -122,13 +144,21 @@ let remove_group ~id t = end) t.variables t.variables in - { t with variables } + let exports = + Variables.fold + (fun param ({ id = id'; _ }, _) vs -> + if String.equal id id' then begin + Variables.remove param vs + end + else begin + vs + end) + t.exports t.exports + in + { t with variables; exports } let exports t = - Variables.to_list t.variables - |> List.filter_map (function - | p, ({ export = true; _ }, v) -> Some (p, v) - | _ -> None) + Variables.to_list t.exports |> List.map (fun (k, (_, v)) -> (k, v)) let locals t = match Stack.pop t.scopes with @@ -136,8 +166,11 @@ let locals t = | Some (vars, _) -> Variables.to_list vars |> List.map (fun (n, (_, v)) -> (n, v)) +let all_variables t = + Variables.union (fun _ e _ -> Some e) t.exports t.variables + let readonly t = - Variables.to_list t.variables + Variables.to_list (all_variables t) |> List.filter_map (function | p, ({ readonly = true; _ }, v) -> Some (p, v) | _ -> None) @@ -165,5 +198,5 @@ let pp_export fmt t = let dump ppf s = Fmt.pf ppf "Variables:[%a]\nLocals:%a" Fmt.(list ~sep:Fmt.comma pp_variable) - (Variables.to_list s.variables) + (Variables.to_list (all_variables s)) (Stack.pp pp_variables) s.scopes diff --git a/src/lib/types.ml b/src/lib/types.ml index 0a80f97..b5cd643 100644 --- a/src/lib/types.ml +++ b/src/lib/types.ml @@ -111,7 +111,7 @@ module type Exec = sig ?stdin:_ Eio.Flow.source -> ?stdout:_ Eio.Flow.sink -> ?stderr:_ Eio.Flow.sink -> - ?env:(string * string) list -> + ?env:string array -> mode:exec_mode -> pgid:int -> cwd:Eio.Fs.dir_ty Eio.Path.t ->