diff --git a/CHANGES.md b/CHANGES.md index 0cdf74b00b..53f8b50046 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -5,6 +5,9 @@ * Compiler: complain when runtime and compiler built-in primitives disagree (#1312) * Compiler: more efficient implementation of Js_traverse.freevar * Compiler: more efficient implementation of Js_traverse.rename_variable +* Compiler: --linkall now export all compilation units in addition to primitives (#1324) +* Compiler: improve --dynlink, one no longer need to pass --toplevel to use Dynlink (#1324) +* Compiler: toplevel runtime files "+toplevel.js" and "+dynlink.js" are added automatically (#1324) * Misc: switch to cmdliner.1.1.0 * Misc: remove old binaries jsoo_link, jsoo_fs * Misc: remove uchar dep diff --git a/compiler/bin-js_of_ocaml/build_fs.ml b/compiler/bin-js_of_ocaml/build_fs.ml index 5c48d7fb97..2b7bfd070a 100644 --- a/compiler/bin-js_of_ocaml/build_fs.ml +++ b/compiler/bin-js_of_ocaml/build_fs.ml @@ -77,7 +77,7 @@ function jsoo_create_file_extern(name,content){ ~standalone:true ~wrap_with_fun:`Iife pfs_fmt - (Parse_bytecode.Debug.create ~toplevel:false false) + (Parse_bytecode.Debug.create ~include_cmis:false false) code) let info = diff --git a/compiler/bin-js_of_ocaml/cmd_arg.ml b/compiler/bin-js_of_ocaml/cmd_arg.ml index 058d34dfca..84140cb8f2 100644 --- a/compiler/bin-js_of_ocaml/cmd_arg.ml +++ b/compiler/bin-js_of_ocaml/cmd_arg.ml @@ -58,7 +58,7 @@ type t = ; linkall : bool ; toplevel : bool ; export_file : string option - ; nocmis : bool + ; no_cmis : bool ; (* filesystem *) include_dirs : string list ; fs_files : string list @@ -180,22 +180,36 @@ let options = value & opt (enum options) Target_env.Isomorphic & info [ "target-env" ] ~docv ~doc) in let toplevel = - let doc = "Compile a toplevel." in + let doc = + "Compile a toplevel and embed necessary cmis (unless '--no-cmis' is provided). \ + Exported compilation units can be configured with '--export'. Note you you'll \ + also need to link against js_of_ocaml-toplevel." + in Arg.(value & flag & info [ "toplevel" ] ~docs:toplevel_section ~doc) in let export_file = - let doc = "File containing the list of unit to export in a toplevel." in + let doc = + "File containing the list of unit to export in a toplevel, with Dynlink or with \ + --linkall. If absent, all units will be exported." + in Arg.(value & opt (some string) None & info [ "export" ] ~docs:toplevel_section ~doc) in - let linkall = - let doc = "Link all primitives." in - Arg.(value & flag & info [ "linkall" ] ~doc) - in let dynlink = - let doc = "Enable dynlink." in + let doc = + "Enable dynlink of bytecode files. Use this if you want to be able to use the \ + Dynlink module. Note that you'll also need to link with \ + 'js_of_ocaml-compiler.dynlink'." + in Arg.(value & flag & info [ "dynlink" ] ~doc) in - let nocmis = + let linkall = + let doc = + "Link all primitives and compilation units. Exported compilation units can be \ + configured with '--export'." + in + Arg.(value & flag & info [ "linkall" ] ~doc) + in + let no_cmis = let doc = "Do not include cmis when compiling toplevel." in Arg.(value & flag & info [ "nocmis"; "no-cmis" ] ~docs:toplevel_section ~doc) in @@ -252,7 +266,7 @@ let options = fs_files fs_output fs_external - nocmis + no_cmis profile no_runtime runtime_only @@ -273,8 +287,7 @@ let options = then runtime_files @ [ input_file ] else runtime_files in - let linkall = linkall || toplevel || runtime_only in - let fs_external = fs_external || (toplevel && nocmis) || runtime_only in + let fs_external = fs_external || (toplevel && no_cmis) || runtime_only in let input_file = match input_file, runtime_only with | "-", _ | _, true -> None @@ -341,7 +354,7 @@ let options = ; fs_files ; fs_output ; fs_external - ; nocmis + ; no_cmis ; output_file ; input_file ; source_map @@ -363,7 +376,7 @@ let options = $ fs_files $ fs_output $ fs_external - $ nocmis + $ no_cmis $ profile $ noruntime $ runtime_only @@ -566,7 +579,7 @@ let options_runtime_only = ; fs_files ; fs_output ; fs_external - ; nocmis = true + ; no_cmis = true ; output_file ; input_file = None ; source_map diff --git a/compiler/bin-js_of_ocaml/cmd_arg.mli b/compiler/bin-js_of_ocaml/cmd_arg.mli index d9e3c36591..ee65275ccc 100644 --- a/compiler/bin-js_of_ocaml/cmd_arg.mli +++ b/compiler/bin-js_of_ocaml/cmd_arg.mli @@ -42,7 +42,7 @@ type t = ; linkall : bool ; toplevel : bool ; export_file : string option - ; nocmis : bool + ; no_cmis : bool ; (* filesystem *) include_dirs : string list ; fs_files : string list diff --git a/compiler/bin-js_of_ocaml/compile.ml b/compiler/bin-js_of_ocaml/compile.ml index dbe0b4c4bf..7d41658acf 100644 --- a/compiler/bin-js_of_ocaml/compile.ml +++ b/compiler/bin-js_of_ocaml/compile.ml @@ -43,7 +43,7 @@ let run ; linkall ; target_env ; toplevel - ; nocmis + ; no_cmis ; runtime_only ; include_dirs ; fs_files @@ -52,7 +52,7 @@ let run ; export_file ; keep_unit_names } = - let dynlink = dynlink || toplevel || runtime_only in + let include_cmis = toplevel && not no_cmis in let custom_header = common.Jsoo_cmdline.Arg.custom_header in Jsoo_cmdline.Arg.eval common; (match output_file with @@ -82,6 +82,13 @@ let run close_in ic; Some (Hashtbl.fold (fun cmi () acc -> cmi :: acc) t []) in + let runtime_files = + if toplevel || dynlink + then + let add_if_absent x l = if List.mem x ~set:l then l else x :: l in + runtime_files |> add_if_absent "+toplevel.js" |> add_if_absent "+dynlink.js" + else runtime_files + in let runtime_files, builtin = List.partition_map runtime_files ~f:(fun name -> match Builtins.find name with @@ -114,7 +121,6 @@ let run %!" in let pseudo_fs_instr prim debug cmis = - let cmis = if nocmis then StringSet.empty else cmis in let paths = include_dirs @ StringSet.elements (Parse_bytecode.Debug.paths debug ~units:cmis) in @@ -131,7 +137,7 @@ let run ; Let (Var.fresh (), Prim (Extern "caml_set_static_env", [ Pv var_k; Pv var_v ])) ]) in - let output (one : Parse_bytecode.one) ~standalone output_file = + let output (one : Parse_bytecode.one) ~linkall ~standalone output_file = check_debug one; let init_pseudo_fs = fs_external && standalone in (match output_file with @@ -150,7 +156,6 @@ let run ?profile ~linkall ~wrap_with_fun - ~dynlink ?source_map ?custom_header fmt @@ -177,7 +182,6 @@ let run ?profile ~linkall ~wrap_with_fun - ~dynlink ?source_map ?custom_header fmt @@ -198,15 +202,18 @@ let run code))); if times () then Format.eprintf "compilation: %a@." Timer.print t in + let output_partial code output_file = + output code ~standalone:false ~linkall:false output_file + in (if runtime_only then let code : Parse_bytecode.one = { code = Parse_bytecode.predefined_exceptions () ; cmis = StringSet.empty - ; debug = Parse_bytecode.Debug.create ~toplevel:false false + ; debug = Parse_bytecode.Debug.create ~include_cmis:false false } in - output code ~standalone:true (fst output_file) + output code ~standalone:true ~linkall:true (fst output_file) else let kind, ic, close_ic, include_dirs = match input_file with @@ -220,17 +227,25 @@ let run (match kind with | `Exe -> let t1 = Timer.make () in + (* The OCaml compiler can generate code using the + "caml_string_greaterthan" primitive but does not use it + itself. This is (was at some point at least) the only primitive + in this case. Ideally, Js_of_ocaml should parse the .mli files + for primitives as well as marking this primitive as potentially + used. But the -linkall option is probably good enough. *) + let linkall = linkall || toplevel || dynlink in let code = Parse_bytecode.from_exe ~includes:include_dirs - ~toplevel + ~include_cmis + ~link_info:(toplevel || dynlink) + ~linkall ?exported_unit - ~dynlink ~debug:need_debug ic in if times () then Format.eprintf " parsing: %a@." Timer.print t1; - output code ~standalone:true (fst output_file) + output code ~standalone:true ~linkall (fst output_file) | `Cmo cmo -> let output_file = match output_file, keep_unit_names with @@ -248,13 +263,13 @@ let run let code = Parse_bytecode.from_cmo ~includes:include_dirs - ~toplevel + ~include_cmis ~debug:need_debug cmo ic in if times () then Format.eprintf " parsing: %a@." Timer.print t1; - output code ~standalone:false output_file + output_partial code output_file | `Cma cma when keep_unit_names -> List.iter cma.lib_units ~f:(fun cmo -> let output_file = @@ -271,26 +286,26 @@ let run let code = Parse_bytecode.from_cmo ~includes:include_dirs - ~toplevel + ~include_cmis ~debug:need_debug cmo ic in if times () then Format.eprintf " parsing: %a (%s)@." Timer.print t1 cmo.cu_name; - output code ~standalone:false output_file) + output_partial code output_file) | `Cma cma -> let t1 = Timer.make () in let code = Parse_bytecode.from_cma ~includes:include_dirs - ~toplevel + ~include_cmis ~debug:need_debug cma ic in if times () then Format.eprintf " parsing: %a@." Timer.print t1; - output code ~standalone:false (fst output_file)); + output_partial code (fst output_file)); close_ic ()); Debug.stop_profiling () diff --git a/compiler/lib-dynlink/dune b/compiler/lib-dynlink/dune new file mode 100644 index 0000000000..4965e7c38f --- /dev/null +++ b/compiler/lib-dynlink/dune @@ -0,0 +1,9 @@ +(library + (name js_of_ocaml_compiler_dynlink) + (public_name js_of_ocaml-compiler.dynlink) + (synopsis "Js_of_ocaml compiler dynlink support") + (library_flags (-linkall)) + (libraries + js_of_ocaml-compiler + js_of_ocaml-compiler.runtime + compiler-libs.bytecomp)) diff --git a/compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.ml b/compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.ml new file mode 100644 index 0000000000..d51394cc49 --- /dev/null +++ b/compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.ml @@ -0,0 +1,70 @@ +open Js_of_ocaml_compiler.Stdlib +open Js_of_ocaml_compiler +module J = Jsoo_runtime.Js + +let split_primitives p = + let len = String.length p in + let rec split beg cur = + if cur >= len + then [] + else if Char.equal p.[cur] '\000' + then String.sub p ~pos:beg ~len:(cur - beg) :: split (cur + 1) (cur + 1) + else split beg (cur + 1) + in + Array.of_list (split 0 0) + +let () = + let global = J.pure_js_expr "globalThis" in + let initial_primitive_count = + Array.length (split_primitives (Symtable.data_primitive_names ())) + in + (* this needs to stay synchronized with toplevel.js *) + let toplevel_compile (s : bytes array) : unit -> J.t = + let s = String.concat ~sep:"" (List.map ~f:Bytes.to_string (Array.to_list s)) in + let prims = split_primitives (Symtable.data_primitive_names ()) in + let unbound_primitive p = + try + ignore (J.eval_string p); + false + with _ -> true + in + let stubs = ref [] in + Array.iteri prims ~f:(fun i p -> + if i >= initial_primitive_count && unbound_primitive p + then + stubs := + Format.sprintf "function %s(){caml_failwith(\"%s not implemented\")}" p p + :: !stubs); + let output_program = Driver.from_string prims s in + let b = Buffer.create 100 in + output_program (Pretty_print.to_buffer b); + Format.(pp_print_flush std_formatter ()); + Format.(pp_print_flush err_formatter ()); + flush stdout; + flush stderr; + let js = + let s = Buffer.contents b in + String.concat ~sep:"" !stubs ^ s + in + let res : string -> unit -> J.t = + Obj.magic (J.get global (J.string "toplevelEval")) + in + res (js : string) + in + let toplevel_eval (x : string) : unit -> J.t = + let f : J.t -> J.t = J.eval_string x in + fun () -> + let res = f global in + Format.(pp_print_flush std_formatter ()); + Format.(pp_print_flush err_formatter ()); + flush stdout; + flush stderr; + res + in + let toplevel_reloc (name : J.t) : int = + let name = J.to_string name in + Js_of_ocaml_compiler.Ocaml_compiler.Symtable.reloc_ident name + in + J.set global (J.string "toplevelCompile") (Obj.magic toplevel_compile) (*XXX HACK!*); + J.set global (J.string "toplevelEval") (Obj.magic toplevel_eval); + J.set global (J.string "toplevelReloc") (Obj.magic toplevel_reloc) diff --git a/compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.mli b/compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.mli new file mode 100644 index 0000000000..078d90e03a --- /dev/null +++ b/compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.mli @@ -0,0 +1,20 @@ +(* Js_of_ocaml library + * http://www.ocsigen.org/js_of_ocaml/ + * Copyright (C) 2022 Hugo Heuzard + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program 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. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + *) + +(** Deliberately empty *) diff --git a/compiler/lib/config.ml b/compiler/lib/config.ml index 9461ce1151..5f9f345aa2 100644 --- a/compiler/lib/config.ml +++ b/compiler/lib/config.ml @@ -72,8 +72,6 @@ module Flag = struct let improved_stacktrace = o ~name:"with-js-error" ~default:false - let include_cmis = o ~name:"withcmi" ~default:true - let warn_unused = o ~name:"warn-unused" ~default:false let inline_callgen = o ~name:"callgen" ~default:false diff --git a/compiler/lib/config.mli b/compiler/lib/config.mli index 4ccadbc051..b22fdfb9be 100644 --- a/compiler/lib/config.mli +++ b/compiler/lib/config.mli @@ -49,8 +49,6 @@ module Flag : sig val excwrap : unit -> bool - val include_cmis : unit -> bool - val improved_stacktrace : unit -> bool val warn_unused : unit -> bool diff --git a/compiler/lib/driver.ml b/compiler/lib/driver.ml index f3748a3878..26420d75fb 100644 --- a/compiler/lib/driver.ml +++ b/compiler/lib/driver.ml @@ -243,8 +243,7 @@ let gen_missing js missing = report_missing_primitives missing); (Statement (Variable_statement miss), N) :: js -let link ~standalone ~linkall ~export_runtime (js : Javascript.source_elements) : - Linker.output = +let link ~standalone ~linkall (js : Javascript.source_elements) : Linker.output = if not standalone then { runtime_code = js; always_required_codes = [] } else @@ -272,7 +271,7 @@ let link ~standalone ~linkall ~export_runtime (js : Javascript.source_elements) let js = if Config.Flag.genprim () then gen_missing js missing else js in if times () then Format.eprintf " linking: %a@." Timer.print t; let js = - if export_runtime + if linkall then let open Javascript in let all = Linker.all linkinfos in @@ -495,7 +494,6 @@ let full ~standalone ~wrap_with_fun ~profile - ~dynlink ~linkall ~source_map ~custom_header @@ -503,8 +501,6 @@ let full d p = let exported_runtime = not standalone in - let linkall = linkall || dynlink in - let opt = configure formatter +> specialize_js_once @@ -514,7 +510,7 @@ let full in let emit = generate d ~exported_runtime ~wrap_with_fun - +> link ~standalone ~linkall ~export_runtime:dynlink + +> link ~standalone ~linkall +> pack ~wrap_with_fun ~standalone +> coloring +> check_js @@ -530,7 +526,6 @@ let f ?(standalone = true) ?(wrap_with_fun = `Iife) ?(profile = o1) - ?(dynlink = false) ?(linkall = false) ?source_map ?custom_header @@ -541,7 +536,6 @@ let f ~standalone ~wrap_with_fun ~profile - ~dynlink ~linkall ~source_map ~custom_header @@ -555,7 +549,6 @@ let from_string prims s formatter = ~standalone:false ~wrap_with_fun:`Anonymous ~profile:o1 - ~dynlink:false ~linkall:false ~source_map:None ~custom_header:None diff --git a/compiler/lib/driver.mli b/compiler/lib/driver.mli index 0ff93bf9bd..21745a1ff2 100644 --- a/compiler/lib/driver.mli +++ b/compiler/lib/driver.mli @@ -24,7 +24,6 @@ val f : ?standalone:bool -> ?wrap_with_fun:[ `Iife | `Anonymous | `Named of string ] -> ?profile:profile - -> ?dynlink:bool -> ?linkall:bool -> ?source_map:string option * Source_map.t -> ?custom_header:string diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml index de64f83dd3..0dc8d88d02 100644 --- a/compiler/lib/parse_bytecode.ml +++ b/compiler/lib/parse_bytecode.ml @@ -37,8 +37,6 @@ module Debug : sig val names : t -> bool - val toplevel : t -> bool - val enabled : t -> bool val is_empty : t -> bool @@ -66,7 +64,7 @@ module Debug : sig -> in_channel -> unit - val create : toplevel:bool -> bool -> t + val create : include_cmis:bool -> bool -> t val fold : t -> (Code.Addr.t -> Instruct.debug_event -> 'a -> 'a) -> 'a -> 'a @@ -96,29 +94,27 @@ end = struct { events_by_pc : event_and_source Int_table.t ; units : (string * string option, ml_unit) Hashtbl.t ; pos_fname_to_source : string String_table.t - ; toplevel : bool ; names : bool ; enabled : bool + ; include_cmis : bool } let names t = t.names - let toplevel t = t.toplevel - let enabled t = t.enabled - let dbg_section_needed t = t.names || t.toplevel || t.enabled + let dbg_section_needed t = t.names || t.enabled || t.include_cmis let relocate_event orig ev = ev.ev_pos <- (orig + ev.ev_pos) / 4 - let create ~toplevel enabled = + let create ~include_cmis enabled = let names = enabled || Config.Flag.pretty () in { events_by_pc = Int_table.create 17 ; units = Hashtbl.create 17 ; pos_fname_to_source = String_table.create 17 ; names - ; toplevel ; enabled + ; include_cmis } let is_empty t = Int_table.length t.events_by_pc = 0 @@ -139,7 +135,7 @@ end = struct | None -> path in let read_paths ic : string list = List.map (input_value ic) ~f:rewrite_path in - fun { events_by_pc; units; pos_fname_to_source; toplevel = _; names; enabled } + fun { events_by_pc; units; pos_fname_to_source; names; enabled; include_cmis = _ } ~crcs ~includes ~orig @@ -372,7 +368,9 @@ end = struct let analyse debug_data code = let debug_data = - if Debug.enabled debug_data then debug_data else Debug.create ~toplevel:false false + if Debug.enabled debug_data + then debug_data + else Debug.create ~include_cmis:false false in let blocks = Addr.Set.empty in let len = String.length code / 4 in @@ -2294,12 +2292,13 @@ let read_primitives toc ic = let from_exe ?(includes = []) - ?(toplevel = false) + ~linkall + ~link_info + ~include_cmis ?exported_unit - ?(dynlink = false) ?(debug = false) ic = - let debug_data = Debug.create ~toplevel debug in + let debug_data = Debug.create ~include_cmis debug in let toc = Toc.read ic in let primitives = read_primitives toc ic in let primitive_table = Array.of_list primitives in @@ -2329,14 +2328,13 @@ let from_exe (fun id -> keep (Ident.name id)) orig_symbols in - (if not (Debug.dbg_section_needed debug_data) - then () - else + (if Debug.dbg_section_needed debug_data + then try ignore (Toc.seek_section toc ic "DBUG"); Debug.read debug_data ~crcs ~includes ic with Not_found -> - if Debug.enabled debug_data || Debug.toplevel debug_data + if Debug.enabled debug_data || include_cmis then warn "Warning: Program not linked with -g, original variable names and locations \ @@ -2350,22 +2348,14 @@ let from_exe globals.override.(i) <- Some v; if debug_parser () then Format.eprintf "overriding global %s@." name with Not_found -> ()); - if toplevel || dynlink + if linkall then (* export globals *) Ocaml_compiler.Symtable.GlobalMap.iter (fun id n -> globals.named_value.(n) <- Some (Ident.name id); globals.is_exported.(n) <- true) - symbols - (* @vouillon: *) - (* we should then use the -linkall option to build the toplevel. *) - (* The OCaml compiler can generate code using this primitive but *) - (* does not use it itself. This is the only primitive in this case. *) - (* Ideally, Js_of_ocaml should parse the .mli files for primitives as *) - (* well as marking this primitive as potentially used. But *) - (* the -linkall option is probably good enough. *) - (* Primitive.mark_used "caml_string_greaterthan" *); + symbols; let p = parse_bytecode code globals debug_data in (* register predefined exception *) let body = @@ -2384,7 +2374,7 @@ let from_exe | _ -> l) in let body = - if toplevel + if link_info then (* Include linking information *) let toc = @@ -2441,7 +2431,7 @@ let from_exe let exception_ids = List.fold_left predefined_exceptions ~init:(-1) ~f:(fun acc (i, _) -> max acc i) in - if toplevel && Config.Flag.include_cmis () + if include_cmis then Ocaml_compiler.Symtable.GlobalMap.fold (fun id num acc -> @@ -2456,7 +2446,7 @@ let from_exe match exported_unit with | None -> cmis | Some l -> - if toplevel && Config.Flag.include_cmis () + if include_cmis then List.fold_left l ~init:cmis ~f:(fun acc s -> StringSet.add s acc) else cmis in @@ -2466,7 +2456,7 @@ let from_exe (* As input: list of primitives + size of global table *) let from_bytes primitives (code : bytecode) = - let debug_data = Debug.create ~toplevel:false false in + let debug_data = Debug.create ~include_cmis:false false in let globals = make_globals 0 [||] primitives in let p = parse_bytecode code globals debug_data in let gdata = Var.fresh () in @@ -2579,7 +2569,7 @@ module Reloc = struct globals end -let from_compilation_units ~includes:_ ~toplevel ~debug_data l = +let from_compilation_units ~includes:_ ~include_cmis ~debug_data l = let reloc = Reloc.create () in List.iter l ~f:(fun (compunit, code) -> Reloc.step1 reloc compunit code); List.iter l ~f:(fun (compunit, code) -> Reloc.step2 reloc compunit code); @@ -2626,7 +2616,7 @@ let from_compilation_units ~includes:_ ~toplevel ~debug_data l = else body in let cmis = - if toplevel && Config.Flag.include_cmis () + if include_cmis then List.fold_left l ~init:StringSet.empty ~f:(fun acc (compunit, _) -> StringSet.add compunit.Cmo_format.cu_name acc) @@ -2634,37 +2624,35 @@ let from_compilation_units ~includes:_ ~toplevel ~debug_data l = in { code = prepend prog body; cmis; debug = debug_data } -let from_cmo ?(includes = []) ?(toplevel = false) ?(debug = false) compunit ic = - let debug_data = Debug.create ~toplevel debug in +let from_cmo ?(includes = []) ?(include_cmis = false) ?(debug = false) compunit ic = + let debug_data = Debug.create ~include_cmis debug in seek_in ic compunit.Cmo_format.cu_pos; let code = Bytes.create compunit.Cmo_format.cu_codesize in really_input ic code 0 compunit.Cmo_format.cu_codesize; - if (not (Debug.dbg_section_needed debug_data)) || compunit.Cmo_format.cu_debug = 0 - then () - else ( + if Debug.dbg_section_needed debug_data && compunit.Cmo_format.cu_debug <> 0 + then ( seek_in ic compunit.Cmo_format.cu_debug; Debug.read_event_list debug_data ~crcs:[] ~includes ~orig:0 ic); - let p = from_compilation_units ~toplevel ~includes ~debug_data [ compunit, code ] in + let p = from_compilation_units ~includes ~include_cmis ~debug_data [ compunit, code ] in Code.invariant p.code; p -let from_cma ?(includes = []) ?(toplevel = false) ?(debug = false) lib ic = - let debug_data = Debug.create ~toplevel debug in +let from_cma ?(includes = []) ?(include_cmis = false) ?(debug = false) lib ic = + let debug_data = Debug.create ~include_cmis debug in let orig = ref 0 in let units = List.map lib.Cmo_format.lib_units ~f:(fun compunit -> seek_in ic compunit.Cmo_format.cu_pos; let code = Bytes.create compunit.Cmo_format.cu_codesize in really_input ic code 0 compunit.Cmo_format.cu_codesize; - if (not (Debug.dbg_section_needed debug_data)) || compunit.Cmo_format.cu_debug = 0 - then () - else ( + if Debug.dbg_section_needed debug_data && compunit.Cmo_format.cu_debug <> 0 + then ( seek_in ic compunit.Cmo_format.cu_debug; Debug.read_event_list debug_data ~crcs:[] ~includes ~orig:!orig ic); orig := !orig + compunit.Cmo_format.cu_codesize; compunit, code) in - let p = from_compilation_units ~toplevel ~includes ~debug_data units in + let p = from_compilation_units ~includes ~include_cmis ~debug_data units in Code.invariant p.code; p diff --git a/compiler/lib/parse_bytecode.mli b/compiler/lib/parse_bytecode.mli index d67ac4a6af..9e07562fc4 100644 --- a/compiler/lib/parse_bytecode.mli +++ b/compiler/lib/parse_bytecode.mli @@ -23,7 +23,7 @@ open Stdlib module Debug : sig type t - val create : toplevel:bool -> bool -> t + val create : include_cmis:bool -> bool -> t val find_loc : t -> ?after:bool -> int -> Parse_info.t option @@ -48,16 +48,17 @@ val read_primitives : Toc.t -> in_channel -> string list val from_exe : ?includes:string list - -> ?toplevel:bool + -> linkall:bool + -> link_info:bool + -> include_cmis:bool -> ?exported_unit:string list - -> ?dynlink:bool -> ?debug:bool -> in_channel -> one val from_cmo : ?includes:string list - -> ?toplevel:bool + -> ?include_cmis:bool -> ?debug:bool -> Cmo_format.compilation_unit -> in_channel @@ -65,7 +66,7 @@ val from_cmo : val from_cma : ?includes:string list - -> ?toplevel:bool + -> ?include_cmis:bool -> ?debug:bool -> Cmo_format.library -> in_channel diff --git a/compiler/tests-dynlink-js/dune b/compiler/tests-dynlink-js/dune new file mode 100644 index 0000000000..064ea7b5a8 --- /dev/null +++ b/compiler/tests-dynlink-js/dune @@ -0,0 +1,33 @@ +(executable + (name main) + (modules main) + (libraries js_of_ocaml) + (modes byte)) + +(rule + (target main.js) + (action + (run %{bin:js_of_ocaml} --linkall -o %{target} %{dep:main.bc}))) + +(rule + (target plugin.cmo) + (action + (run %{bin:ocamlc} -c %{dep:./plugin.ml}))) + +(rule + (target plugin.js) + (action + (run %{bin:js_of_ocaml} %{dep:./plugin.cmo}))) + +(rule + (target main.out) + (deps plugin.js) + (action + (with-outputs-to + %{target} + (run %{bin:node} %{dep:./main.js})))) + +(rule + (alias runtest) + (action + (diff main.out.expected main.out))) diff --git a/compiler/tests-dynlink-js/main.ml b/compiler/tests-dynlink-js/main.ml new file mode 100644 index 0000000000..686016aaa1 --- /dev/null +++ b/compiler/tests-dynlink-js/main.ml @@ -0,0 +1,7 @@ +let () = print_endline "hello" + +let require s = + let open Js_of_ocaml in + (Js.Unsafe.js_expr "require" : Js.js_string Js.t -> unit) (Js.string s) + +let () = require "./plugin.js" diff --git a/compiler/tests-dynlink-js/main.out.expected b/compiler/tests-dynlink-js/main.out.expected new file mode 100644 index 0000000000..ba390cb600 --- /dev/null +++ b/compiler/tests-dynlink-js/main.out.expected @@ -0,0 +1,2 @@ +hello +plugin loaded diff --git a/compiler/tests-dynlink-js/plugin.ml b/compiler/tests-dynlink-js/plugin.ml new file mode 100644 index 0000000000..d3e61b9565 --- /dev/null +++ b/compiler/tests-dynlink-js/plugin.ml @@ -0,0 +1 @@ +let () = print_endline "plugin loaded" diff --git a/compiler/tests-dynlink/dune b/compiler/tests-dynlink/dune index 97501b0625..07e8b4e9e3 100644 --- a/compiler/tests-dynlink/dune +++ b/compiler/tests-dynlink/dune @@ -1,21 +1,19 @@ (executable (name main) (modules main) - (libraries dynlink js_of_ocaml-toplevel) + (libraries dynlink js_of_ocaml-compiler.dynlink) (modes byte)) (rule (target main.js) - (deps plugin.cmo) + (deps plugin.cmo export) (action (run %{bin:js_of_ocaml} --dynlink - +dynlink.js - --toplevel - +toplevel.js - --file - plugin.cmo + --export + export + --pretty -o %{target} %{dep:main.bc}))) @@ -27,6 +25,7 @@ (rule (target main.out) + (deps plugin.cmo) (action (with-outputs-to %{target} diff --git a/compiler/tests-dynlink/export b/compiler/tests-dynlink/export new file mode 100644 index 0000000000..f516f0a526 --- /dev/null +++ b/compiler/tests-dynlink/export @@ -0,0 +1,2 @@ +Stdlib +Stdlib__Buffer \ No newline at end of file diff --git a/compiler/tests-dynlink/main.ml b/compiler/tests-dynlink/main.ml index caa77f120a..8078153f43 100644 --- a/compiler/tests-dynlink/main.ml +++ b/compiler/tests-dynlink/main.ml @@ -1,7 +1,3 @@ let () = print_endline "hello" -let () = Js_of_ocaml_toplevel.JsooTop.initialize () - -let () = - Sys.interactive := false; - Dynlink.loadfile "/static/plugin.cmo" +let () = Dynlink.loadfile "./plugin.cmo" diff --git a/compiler/tests-dynlink/plugin.ml b/compiler/tests-dynlink/plugin.ml index d3e61b9565..3a896776db 100644 --- a/compiler/tests-dynlink/plugin.ml +++ b/compiler/tests-dynlink/plugin.ml @@ -1 +1,3 @@ let () = print_endline "plugin loaded" + +let b = Buffer.create 18 diff --git a/compiler/tests-toplevel/dune b/compiler/tests-toplevel/dune new file mode 100644 index 0000000000..4e1a49ba36 --- /dev/null +++ b/compiler/tests-toplevel/dune @@ -0,0 +1,25 @@ +(executables + (names test_toplevel) + (libraries js_of_ocaml-compiler.dynlink compiler-libs.toplevel) + (flags + (:standard -linkall)) + (modes byte)) + +(rule + (targets test_toplevel.js) + (action + (run %{bin:js_of_ocaml} --toplevel %{dep:test_toplevel.bc} -o %{targets}))) + +(rule + (target test_toplevel.referencejs) + (deps test_toplevel.js) + (action + (with-stdout-to + %{target} + (run node ./test_toplevel.js)))) + +(rule + (alias runtest) + (deps test_toplevel.reference test_toplevel.referencejs) + (action + (diff test_toplevel.reference test_toplevel.referencejs))) diff --git a/compiler/tests-toplevel/test_toplevel.ml b/compiler/tests-toplevel/test_toplevel.ml new file mode 100644 index 0000000000..e4a68f4d9c --- /dev/null +++ b/compiler/tests-toplevel/test_toplevel.ml @@ -0,0 +1,10 @@ +let () = + let content = {| +let () = print_endline "hello";; +1+;;|} in + Topdirs.dir_directory "/static/cmis"; + Toploop.initialize_toplevel_env (); + Toploop.input_name := "//toplevel//"; + let lexbuf = Lexing.from_string content in + let phr = !Toploop.parse_toplevel_phrase lexbuf in + ignore (Toploop.execute_phrase true Format.std_formatter phr) diff --git a/compiler/tests-toplevel/test_toplevel.reference b/compiler/tests-toplevel/test_toplevel.reference new file mode 100644 index 0000000000..ce01362503 --- /dev/null +++ b/compiler/tests-toplevel/test_toplevel.reference @@ -0,0 +1 @@ +hello diff --git a/dune-project b/dune-project index 5cec4f624a..a4a96b1a34 100644 --- a/dune-project +++ b/dune-project @@ -89,9 +89,7 @@ "Js_of_ocaml is a compiler from OCaml bytecode to JavaScript. It makes it possible to run pure OCaml programs in JavaScript environment like browsers and Node.js") (depends (ocaml (>= 4.04)) - (js_of_ocaml (= :version)) (js_of_ocaml-compiler (= :version)) - (js_of_ocaml-ppx (= :version)) (ocamlfind (>= 1.5.1)) (cohttp-lwt-unix :with-test) (graphics :with-test) diff --git a/js_of_ocaml-toplevel.opam b/js_of_ocaml-toplevel.opam index f6681472c6..6c2145cd69 100644 --- a/js_of_ocaml-toplevel.opam +++ b/js_of_ocaml-toplevel.opam @@ -13,9 +13,7 @@ bug-reports: "https://github.com/ocsigen/js_of_ocaml/issues" depends: [ "dune" {>= "3.2"} "ocaml" {>= "4.04"} - "js_of_ocaml" {= version} "js_of_ocaml-compiler" {= version} - "js_of_ocaml-ppx" {= version} "ocamlfind" {>= "1.5.1"} "cohttp-lwt-unix" {with-test} "graphics" {with-test} diff --git a/manual/build-toplevel.wiki b/manual/build-toplevel.wiki new file mode 100644 index 0000000000..87741e0623 --- /dev/null +++ b/manual/build-toplevel.wiki @@ -0,0 +1,46 @@ += How to build a toplevel = + +First, initialize the toplevel using {{{Js_of_ocaml_toplevel.JsooTop.initialize}}}. + +Then, build your bytecode program with debug enabled (**-g**) and linkall (**-linkall**). You should obviously link in all the libraries you want accessible in the final toplevel. + +Finaly, compile your toplevel to JavaScript passing the {{{--toplevel}}} flags to the js_of_ocaml compiler. + +If you want to limit the set of modules available in the toplevel, you can explicitly pass a list of compilation units that should be accessible using the {{{--export FILE}}} flag. +**FILE** must contain names of compilation unit to export - one per line. The **jsoo_listunits** tool, provided by the **js_of_ocaml-toplevel** opam package, can be used to generate this list +from a set of findlib libraries. + +For example, the following command will create a file **FILE** containing all compilation unit names provided by the findlib libraries **stdlib** and **str**. +{{{ + jsoo_listunits -o FILE stdlib str +}}} + + +Note that toplevels currently cannot be built using separate compilation. + + += How to build a program using the **Dynlink** library = + +OCaml supports dynlink of bytecode files using the **dynlink** library. In order to work when compiled to JavaScript, one need to follow the following steps: + +First, make sure to link **js_of_ocaml-compiler.dynlink** to initialize the support for dynlink (the initialization is done automatically by side-effect). + +Then, build your bytecode program with debug enabled (**-g**) and linkall (**-linkall**). + +Finaly, compile your program to JavaScript passing the {{{--dynlink}}} flags to the js_of_ocaml compiler. + +Here is an example showing how to compile and use a program using Dynlink: +{{{ + # cat main.ml + let () = Dynlink.loadfile "./plugin.cmo" + + # Compiling main program + ocamlfind ocamlc -linkpkg -package dynlink -package js_of_ocaml-compiler.dynlink main.ml -o main.bc + js_of_ocaml main.bc --dynlink + + # Compiling plugin + ocamlfind ocamlc -c plugin.ml + + # Test + node ./main.js +}}} diff --git a/manual/linker.wiki b/manual/linker.wiki index faab189fd9..619e29478a 100644 --- a/manual/linker.wiki +++ b/manual/linker.wiki @@ -4,9 +4,6 @@ The main purpose is to provide (external) primitives needed by the bytecode prog Most of the primitives from the standard library are already implemented and loaded by default. -Additionally, some other primitives are available but not loaded by default: - * "+toplevel.js" and "+dynlink.js" when compiling toplevel and/or using dynlink. - == Command-line Pass the JavaScript file (must have a ".js" extension) < Js.Unsafe.global##load_script_ name)); + (Toploop.Directive_string (fun name -> Js.Unsafe.global##load_script_ name)) + { section = "js_of_ocaml-toplevel-example"; doc = "Load the given javascript file" }; Sys.interactive := true; () diff --git a/toplevel/lib/dune b/toplevel/lib/dune index c329279297..8a9d23c492 100644 --- a/toplevel/lib/dune +++ b/toplevel/lib/dune @@ -4,8 +4,8 @@ (synopsis "Js_of_ocaml toplevel library") (libraries js_of_ocaml-compiler - js_of_ocaml + js_of_ocaml-compiler.dynlink compiler-libs.bytecomp compiler-libs.toplevel) (preprocess - (pps ppx_optcomp_light js_of_ocaml-ppx))) + (pps ppx_optcomp_light))) diff --git a/toplevel/lib/jsooTop.ml b/toplevel/lib/jsooTop.ml index 70b149a75c..6bfa0d3639 100644 --- a/toplevel/lib/jsooTop.ml +++ b/toplevel/lib/jsooTop.ml @@ -17,80 +17,34 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -open Js_of_ocaml open Js_of_ocaml_compiler open Js_of_ocaml_compiler.Stdlib -let split_primitives p = - let len = String.length p in - let rec split beg cur = - if cur >= len - then [] - else if Char.equal p.[cur] '\000' - then String.sub p ~pos:beg ~len:(cur - beg) :: split (cur + 1) (cur + 1) - else split beg (cur + 1) - in - Array.of_list (split 0 0) - -let new_directive name k = Hashtbl.add Toploop.directive_table name k - [@@alert "-deprecated"] - let setup = lazy (Topdirs.dir_directory "/static/cmis"; - new_directive "enable" (Toploop.Directive_string Config.Flag.enable); - new_directive "disable" (Toploop.Directive_string Config.Flag.disable); - new_directive "debug_on" (Toploop.Directive_string Debug.enable); - new_directive "debug_off" (Toploop.Directive_string Debug.disable); - new_directive "tailcall" (Toploop.Directive_string (Config.Param.set "tc")); - let initial_primitive_count = - Array.length (split_primitives (Symtable.data_primitive_names ())) - in - (* this needs to stay synchronized with toplevel.js *) - let compile (s : bytes array) = - let s = String.concat ~sep:"" (List.map ~f:Bytes.to_string (Array.to_list s)) in - let prims = split_primitives (Symtable.data_primitive_names ()) in - let unbound_primitive p = - try - ignore (Js.Unsafe.eval_string p); - false - with _ -> true - in - let stubs = ref [] in - Array.iteri prims ~f:(fun i p -> - if i >= initial_primitive_count && unbound_primitive p - then - stubs := - Format.sprintf "function %s(){caml_failwith(\"%s not implemented\")}" p p - :: !stubs); - let output_program = Driver.from_string prims s in - let b = Buffer.create 100 in - output_program (Pretty_print.to_buffer b); - Format.(pp_print_flush std_formatter ()); - Format.(pp_print_flush err_formatter ()); - flush stdout; - flush stderr; - let res = Buffer.contents b in - let res = String.concat ~sep:"" !stubs ^ res in - let res : unit -> _ = Js.Unsafe.global##toplevelEval (res : string) in - res - in - Js.Unsafe.global##.toplevelCompile := compile (*XXX HACK!*); - (Js.Unsafe.global##.toplevelEval - := fun (x : string) -> - let f : < .. > Js.t -> < .. > Js.t = Js.Unsafe.eval_string x in - fun () -> - let res = f Js.Unsafe.global in - Format.(pp_print_flush std_formatter ()); - Format.(pp_print_flush err_formatter ()); - flush stdout; - flush stderr; - res); - Js.Unsafe.global##.toplevelReloc - := Js.Unsafe.callback (fun name -> - let name = Js.to_string name in - Js_of_ocaml_compiler.Ocaml_compiler.Symtable.reloc_ident name); - ()) + Toploop.add_directive + "enable" + (Toploop.Directive_string Config.Flag.enable) + { section = "js_of_ocaml"; doc = "Enable the given flag" }; + Toploop.add_directive + "disable" + (Toploop.Directive_string Config.Flag.disable) + { section = "js_of_ocaml"; doc = "Disable the given flag" }; + Toploop.add_directive + "debug_on" + (Toploop.Directive_string Debug.enable) + { section = "js_of_ocaml"; doc = "Enable debug for the given section" }; + Toploop.add_directive + "debug_off" + (Toploop.Directive_string Debug.disable) + { section = "js_of_ocaml"; doc = "Disable debug for the given section" }; + Toploop.add_directive + "tailcall" + (Toploop.Directive_string (Config.Param.set "tc")) + { section = "js_of_ocaml" + ; doc = "Set the depth of tail calls before going through a trampoline" + }) let refill_lexbuf s p ppf buffer len = if !p = String.length s @@ -111,17 +65,23 @@ let refill_lexbuf s p ppf buffer len = p := !p + len''; len'' -let toploop_use_silently ffp name = Toploop.use_silently ffp name - [@@ocaml.warning "-32"] [@@if ocaml_version < (4, 14, 0)] - -let toploop_use_silently ffp name = Toploop.use_silently ffp (File name) - [@@ocaml.warning "-32"] [@@if ocaml_version >= (4, 14, 0)] - let use ffp content = - let name = "/dev/fake_stdin" in - if Sys.file_exists name then Sys.remove name; - Sys_js.create_file ~name ~content; - toploop_use_silently ffp name + let fname, oc = + Filename.open_temp_file ~mode:[ Open_binary ] "jsoo_toplevel" "fake_stdin" + in + output_string oc content; + close_out oc; + try + let b = Toploop.use_silently ffp fname in + Sys.remove fname; + b + with e -> + Sys.remove fname; + raise e + [@@if ocaml_version < (4, 14, 0)] + +let use ffp content = Toploop.use_silently ffp (String content) + [@@if ocaml_version >= (4, 14, 0)] let execute printval ?pp_code ?highlight_location pp_answer s = let lb = Lexing.from_function (refill_lexbuf s (ref 0) pp_code) in diff --git a/toplevel/test/dune b/toplevel/test/dune index 0ebf7ef20f..e7fe80e479 100644 --- a/toplevel/test/dune +++ b/toplevel/test/dune @@ -22,8 +22,6 @@ --toplevel --disable shortvar - +toplevel.js - +dynlink.js %{dep:test_toplevel.bc} -o %{targets})))