Merge pull request #96 from ocaml-wasm/targetint

Get latest changes from js_of_ocaml

Author: vouillon

.github/workflows/build.yml

@@ -37,6 +37,11 @@ jobs:
             skip-effects: true
             skip-test: false
             skip-doc: true
+          - os: ubuntu-latest
+            ocaml-compiler: "ocaml-variants.4.14.2+options,ocaml-option-32bit"
+            skip-effects: true
+            skip-test: false
+            skip-doc: true
           - os: macos-latest
             ocaml-compiler: "4.14"
             skip-effects: true
@@ -73,6 +78,19 @@ jobs:
           git config --global core.eol lf
           git config --global core.ignorecase false
 
+        # EJGA: Note that I tried to fix this upstream as depext is
+        # getting much better, but no luck yet, c.f:
+        # https://github.com/ocaml/opam-repository/pull/26626
+      - name: Install apt 32-bit dependencies
+        if: matrix.ocaml-compiler == 'ocaml-variants.4.14.2+options,ocaml-option-32bit'
+        run: |
+          sudo apt-get install aptitude
+          sudo dpkg --add-architecture i386
+          sudo aptitude -o Acquire::Retries=30 update -q
+          # Note we also install the 64-bit versions here as opam will
+          # try to install them anyways, so we save an apt-roundtrip.
+          sudo aptitude -o Acquire::Retries=30 install gcc-multilib g++-multilib pkg-config libgmp-dev libgmp-dev:i386 libx11-dev:i386 -y
+
       - name: Checkout tree
         uses: actions/checkout@v4
 

CHANGES.md

@@ -6,19 +6,22 @@
 * Misc: yojson is no longer optional
 * Misc: reduce the diff with the wasm_of_ocaml fork
 * Compiler: speedup global_flow/global_deadcode pass on large bytecode
+* Compiler: improved global dead code elimination (#2206)
 * Compiler: speedup json parsing, relying on Yojson.Raw (#1640)
 * Compiler: Decode sourcemap mappings only when necessary (#1664)
 * Compiler: make indirect call using sequence instead of using the call method
   [f.call(null, args)] becomes [(0,f)(args)]
 * Compiler: mark [TextEncoder] as reserved
+* Compiler: add support for the Wasm backend in parts of the pipeline, in
+  prevision for the merge of wasm_of_ocaml
+* Compiler: introduce a Targetint module
+  that follows the semantic of the backend (js or wasm)
+* Compiler: warn on joo_global_object
 * Runtime: change Sys.os_type on windows (Cygwin -> Win32)
 * Runtime: backtraces are really expensive, they need to be be explicitly
   requested at compile time (--enable with-js-error) or at startup (OCAMLRUNPARAM=b=1)
 * Runtime: allow dynlink of precompiled js with separate compilation (#1676)
 * Lib: Modify Typed_array API for compatibility with WebAssembly
-* Compiler: improved global dead code elimination (#2206)
-* Compiler: add support for the Wasm backend in parts of the pipeline, in
-  prevision for the merge of wasm_of_ocaml
 
 
 ## Bug fixes

benchmarks/sources/ml/splay.ml

@@ -186,15 +186,24 @@ let rec generatePayloadTree depth tag =
 
 let random =
   let seed = ref 49734321 in
+  let mask_32bit =
+    match Sys.int_size with
+    | 31 | 32 -> -1
+    | _ -> int_of_string "0xffffffff"
+  in
+  let l_0xc761c23c = int_of_string "0xc761c23c" in
+  let l_0xd3a2646c = int_of_string "0xd3a2646c" in
+  let l_0xfd7046c5 = int_of_string "0xfd7046c5" in
+  let l_0xb55a4f09 = int_of_string "0xb55a4f09" in
   fun () ->
     (*    // Robert Jenkins' 32 bit integer hash function. *)
     let s = !seed in
-    let s = (s + 0x7ed55d16 + (s lsl 12)) land 0xffffffff in
-    let s = s lxor 0xc761c23c lxor (s lsr 19) in
+    let s = (s + 0x7ed55d16 + (s lsl 12)) land mask_32bit in
+    let s = s lxor l_0xc761c23c lxor (s lsr 19) in
     let s = s + 0x165667b1 + (s lsl 5) in
-    let s = (s + 0xd3a2646c) lxor (s lsl 9) in
-    let s = (s + 0xfd7046c5 + (s lsl 3)) land 0xffffffff in
-    let s = s lxor 0xb55a4f09 lxor (s lsr 16) in
+    let s = (s + l_0xd3a2646c) lxor (s lsl 9) in
+    let s = (s + l_0xfd7046c5 + (s lsl 3)) land mask_32bit in
+    let s = s lxor l_0xb55a4f09 lxor (s lsr 16) in
     seed := s;
     float (s land 0xfffffff) /. float 0x10000000
 

compiler/bin-js_of_ocaml/build_fs.ml

@@ -61,6 +61,7 @@ function jsoo_create_file_extern(name,content){
 }
 |}
   in
+  Config.set_target `JavaScript;
   let fragments = Linker.Fragment.parse_string code in
   Linker.load_fragments ~target_env:Isomorphic ~filename:"<dummy>" fragments;
   Linker.check_deps ();

compiler/bin-js_of_ocaml/js_of_ocaml.ml

@@ -109,7 +109,9 @@ let () =
         comp;
       exit 1
   | Failure s ->
+      let backtrace = Printexc.get_backtrace () in
       Format.eprintf "%s: Error: %s@." Sys.argv.(0) s;
+      prerr_string backtrace;
       exit 1
   | exc ->
       let backtrace = Printexc.get_backtrace () in

compiler/bin-wasm_of_ocaml/link.ml

@@ -79,6 +79,7 @@ let options =
   Term.ret t
 
 let f { common; output_file; files; linkall; enable_source_maps; mklib } =
+  Js_of_ocaml_compiler.Config.set_target `Wasm;
   Jsoo_cmdline.Arg.eval common;
   Wa_link.link ~output_file ~linkall ~mklib ~enable_source_maps ~files
 

compiler/lib/code.ml

@@ -327,7 +327,7 @@ type constant =
   | NativeString of Native_string.t
   | Float of float
   | Float_array of float array
-  | Int of Int32.t
+  | Int of Targetint.t
   | Int32 of Int32.t
   | Int64 of Int64.t
   | NativeInt of Int32.t (* Native int are 32bit on all known backend *)
@@ -352,7 +352,8 @@ module Constant = struct
             | Some s, Some c -> same := Some (s && c)
           done;
           !same
-    | Int a, Int b | Int32 a, Int32 b -> Some (Int32.equal a b)
+    | Int a, Int b -> Some (Targetint.equal a b)
+    | Int32 a, Int32 b -> Some (Int32.equal a b)
     | Int64 a, Int64 b -> Some (Int64.equal a b)
     | NativeInt a, NativeInt b -> Some (Int32.equal a b)
     | Float_array a, Float_array b -> Some (Array.equal Float.ieee_equal a b)
@@ -497,7 +498,7 @@ module Print = struct
           Format.fprintf f "%.12g" a.(i)
         done;
         Format.fprintf f "|]"
-    | Int i -> Format.fprintf f "%ld" i
+    | Int i -> Format.fprintf f "%s" (Targetint.to_string i)
     | Int32 i -> Format.fprintf f "%ldl" i
     | Int64 i -> Format.fprintf f "%LdL" i
     | NativeInt i -> Format.fprintf f "%ldn" i

compiler/lib/code.mli

@@ -173,7 +173,7 @@ type constant =
   | NativeString of Native_string.t
   | Float of float
   | Float_array of float array
-  | Int of Int32.t
+  | Int of Targetint.t
   | Int32 of Int32.t  (** Only produced when compiling to WebAssembly. *)
   | Int64 of Int64.t
   | NativeInt of Int32.t  (** Only produced when compiling to WebAssembly. *)

compiler/lib/config.ml

@@ -191,4 +191,7 @@ let target () =
   | (`JavaScript | `Wasm) as t -> t
 
 let set_target (t : [ `JavaScript | `Wasm ]) =
+  (match t with
+  | `JavaScript -> Targetint.set_num_bits 32
+  | `Wasm -> Targetint.set_num_bits 31);
   target_ := (t :> [ `JavaScript | `Wasm | `None ])

compiler/lib/effects.ml

@@ -300,7 +300,7 @@ let cps_branch ~st ~src (pc, args) loc =
           (* We are jumping to a block that is also used as a continuation.
              We pass it a dummy argument. *)
           let x = Var.fresh () in
-          [ x ], [ Let (x, Constant (Int 0l)), noloc ]
+          [ x ], [ Let (x, Constant (Int Targetint.zero)), noloc ]
         else args, []
       in
       (* We check the stack depth only for backward edges (so, at
@@ -402,7 +402,9 @@ let cps_last ~st ~alloc_jump_closures pc ((last, last_loc) : last * loc) ~k :
                         ( x'
                         , Prim
                             ( Extern "caml_maybe_attach_backtrace"
-                            , [ Pv x; Pc (Int (if force then 1l else 0l)) ] ) )
+                            , [ Pv x
+                              ; Pc (Int (if force then Targetint.one else Targetint.zero))
+                              ] ) )
                     , noloc )
                   ]
                 in
@@ -483,7 +485,8 @@ let cps_instr ~st (instr : instr) : instr =
       | Pc (Int a) ->
           Let
             ( x
-            , Prim (Extern "caml_alloc_dummy_function", [ size; Pc (Int (Int32.succ a)) ])
+            , Prim
+                (Extern "caml_alloc_dummy_function", [ size; Pc (Int (Targetint.succ a)) ])
             )
       | _ -> assert false)
   | Let (x, Apply { f; args; _ }) when not (Var.Set.mem x st.cps_needed) ->
@@ -562,7 +565,7 @@ let cps_block ~st ~k pc block =
               [ arg; k' ]
               loc)
     | Prim (Extern "%perform", [ Pv effect_ ]) ->
-        perform_effect ~effect_ ~continuation:(Pc (Int 0l)) loc
+        perform_effect ~effect_ ~continuation:(Pc (Int Targetint.zero)) loc
     | Prim (Extern "%reperform", [ Pv effect_; continuation ]) ->
         perform_effect ~effect_ ~continuation loc
     | _ -> None