Skip to content

Commit

Permalink
Compiler: fix for 12430
Browse files Browse the repository at this point in the history
  • Loading branch information
hhugo committed Jan 21, 2024
1 parent bfedc8a commit 2ce8593
Show file tree
Hide file tree
Showing 3 changed files with 30 additions and 0 deletions.
23 changes: 23 additions & 0 deletions compiler/lib-dynlink/js_of_ocaml_compiler_dynlink.ml
Original file line number Diff line number Diff line change
Expand Up @@ -12,13 +12,36 @@ type bytecode_sections =

external get_bytecode_sections : unit -> bytecode_sections = "jsoo_get_bytecode_sections"

let normalize_bytecode code =
match Ocaml_version.v with
| `V4_08
| `V4_09
| `V4_10
| `V4_11
| `V4_12
| `V4_13
| `V4_14
| `V5_00
| `V5_01
| `V5_02 -> code
| `V5_03 ->
(* starting with ocaml 5.3. 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 () =
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 ());
(* 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
Expand Down
5 changes: 5 additions & 0 deletions compiler/lib/instr.ml
Original file line number Diff line number Diff line change
Expand Up @@ -367,6 +367,11 @@ let ops =
in
ops

let find i =
match Array.find_opt ~f:(fun { code; _ } -> Poly.(i = code)) ops with
| None -> assert false
| Some x -> x

let get code i = Char.code code.[i]

let getu code pc =
Expand Down
2 changes: 2 additions & 0 deletions compiler/lib/instr.mli
Original file line number Diff line number Diff line change
Expand Up @@ -197,6 +197,8 @@ type desc =
; opcode : int
}

val find : t -> desc

val get_instr_exn : string -> int -> desc

val gets : string -> int -> int
Expand Down

0 comments on commit 2ce8593

Please sign in to comment.