1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
open Js_of_ocaml_compiler.Stdlib
open Js_of_ocaml_compiler
module J = Jsoo_runtime.Js
type bytecode_sections =
{ symb : Ocaml_compiler.Symtable.GlobalMap.t
; crcs : (string * Digest.t option) list
; prim : string list
; dlpt : string list
}
[@@ocaml.warning "-unused-field"]
external get_bytecode_sections : unit -> bytecode_sections = "jsoo_get_bytecode_sections"
external toplevel_init_compile :
(string -> Instruct.debug_event list array -> unit -> J.t) -> unit
= "jsoo_toplevel_init_compile"
external toplevel_init_reloc : (J.t -> int) -> unit = "jsoo_toplevel_init_reloc"
let eval_ref = ref (fun (_ : string) -> failwith "toplevel: eval not initialized")
let normalize_bytecode code =
match Ocaml_version.compare Ocaml_version.current [ 5; 2 ] < 0 with
| true -> code
| false ->
(* starting with ocaml 5.2, The toplevel no longer append [RETURN 1] *)
let { Instr.opcode; _ } = Instr.find RETURN in
let len = String.length code in
let b = Bytes.create (len + 8) in
Bytes.blit_string ~src:code ~src_pos:0 ~dst:b ~dst_pos:0 ~len;
Bytes.set_int32_le b len (Int32.of_int opcode);
Bytes.set_int32_le b (len + 4) 1l;
Bytes.to_string b
let () =
(match Sys.backend_type with
| Sys.Other "js_of_ocaml" -> Config.set_target `JavaScript
| Sys.(Native | Bytecode | Other _) -> failwith "Expected backend `js_of_ocaml`");
let global = J.pure_js_expr "globalThis" in
Config.Flag.set "use-js-string" (Jsoo_runtime.Sys.Config.use_js_string ());
Config.Flag.set "effects" (Jsoo_runtime.Sys.Config.effects ());
Linker.reset ();
(* this needs to stay synchronized with toplevel.js *)
let toplevel_compile (s : string) (debug : Instruct.debug_event list array) :
unit -> J.t =
let s = normalize_bytecode s in
let prims = Array.of_list (Ocaml_compiler.Symtable.all_primitives ()) in
let b = Buffer.create 100 in
let fmt = Pretty_print.to_buffer b in
Driver.configure fmt;
Driver.from_string ~prims ~debug s fmt;
Format.(pp_print_flush std_formatter ());
Format.(pp_print_flush err_formatter ());
flush stdout;
flush stderr;
let js = Buffer.contents b in
!eval_ref js
in
let toplevel_eval (x : string) : unit -> J.t =
let f : J.t = J.eval_string x in
fun () ->
let res = J.fun_call f [| global |] in
Format.(pp_print_flush std_formatter ());
Format.(pp_print_flush err_formatter ());
flush stdout;
flush stderr;
res
in
let toc = get_bytecode_sections () in
let sym =
let t : Ocaml_compiler.Symtable.GlobalMap.t = toc.symb in
Ocaml_compiler.Symtable.GlobalMap.fold
(fun i n acc -> StringMap.add (Ocaml_compiler.Symtable.Global.name i) n acc)
t
StringMap.empty
in
let toplevel_reloc (name : J.t) : int =
let name = J.to_string name in
match StringMap.find_opt name sym with
| Some i -> i
| None -> Js_of_ocaml_compiler.Ocaml_compiler.Symtable.reloc_ident name
in
eval_ref := toplevel_eval;
toplevel_init_compile toplevel_compile;
toplevel_init_reloc toplevel_reloc
|
