Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Compiler: introduce Targetint #1693

Merged
merged 4 commits into from
Sep 30, 2024
Merged

Compiler: introduce Targetint #1693

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
d89268b
Test: move test_int31
hhugo Sep 28, 2024
74672ae
Tests: more test for int31
hhugo Sep 30, 2024
35fd786
Compiler: introduce Targetint
hhugo Sep 27, 2024
232bf60
Misc: Changes
hhugo Sep 30, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 5 additions & 3 deletions CHANGES.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,19 +6,21 @@
* 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)
* 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
Expand Down
7 changes: 4 additions & 3 deletions compiler/lib/code.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 *)
Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion compiler/lib/code.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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. *)
Expand Down
3 changes: 3 additions & 0 deletions compiler/lib/config.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 ])
11 changes: 7 additions & 4 deletions compiler/lib/effects.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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) ->
Expand Down Expand Up @@ -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
Expand Down
171 changes: 57 additions & 114 deletions compiler/lib/eval.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,81 +29,29 @@ let set_static_env s value = Hashtbl.add static_env s value

let get_static_env s = try Some (Hashtbl.find static_env s) with Not_found -> None

module type Int = sig
include Arith_ops

val int_unop : constant list -> (t -> t) -> constant option

val int_binop : constant list -> (t -> t -> t) -> constant option

val shift_op : constant list -> (t -> int -> t) -> constant option

val of_int32_warning_on_overflow : int32 -> t

val to_int32 : t -> int32

val numbits : int
end

module Int32 = struct
include Int32

let int_unop l f =
match l with
| [ Int i ] -> Some (Int (f i))
| _ -> None

let int_binop l f =
match l with
| [ Int i; Int j ] -> Some (Int (f i j))
| _ -> None

(* For when the underlying function takes an [int] (not [t]) as its second argument *)
let shift_op l f =
match l with
| [ Int i; Int j ] -> Some (Int (f i (to_int j)))
| _ -> None

let numbits = 32

let of_int32_warning_on_overflow = Fun.id

let to_int32 = Fun.id
end

module Int31 : Int = struct
include Int31

let int_unop l f =
match l with
| [ Int i ] -> Some (Int (to_int32 (f (of_int32_warning_on_overflow i))))
| _ -> None

let int_binop l f =
match l with
| [ Int i; Int j ] ->
Some
(Int
(to_int32
(f (of_int32_warning_on_overflow i) (of_int32_warning_on_overflow j))))
| _ -> None
let int_unop l f =
match l with
| [ Int i ] -> Some (Int (f i))
| _ -> None

let shift_op l f =
match l with
| [ Int i; Int j ] ->
Some (Int (to_int32 (f (of_int32_warning_on_overflow i) (Int32.to_int j))))
| _ -> None
let int_binop l f =
match l with
| [ Int i; Int j ] -> Some (Int (f i j))
| _ -> None

let numbits = 31
end
(* For when the underlying function takes an [int] (not [t]) as its second argument *)
let shift_op l f =
match l with
| [ Int i; Int j ] -> Some (Int (f i (Targetint.to_int_exn j)))
| _ -> None

let float_binop_aux (l : constant list) (f : float -> float -> 'a) : 'a option =
let args =
match l with
| [ Float i; Float j ] -> Some (i, j)
| [ Int i; Int j ] -> Some (Int32.to_float i, Int32.to_float j)
| [ Int i; Float j ] -> Some (Int32.to_float i, j)
| [ Float i; Int j ] -> Some (i, Int32.to_float j)
| [ Int i; Int j ] -> Some (Targetint.to_float i, Targetint.to_float j)
| [ Int i; Float j ] -> Some (Targetint.to_float i, j)
| [ Float i; Int j ] -> Some (i, Targetint.to_float j)
| _ -> None
in
match args with
Expand All @@ -118,10 +66,10 @@ let float_binop (l : constant list) (f : float -> float -> float) : constant opt
let float_unop (l : constant list) (f : float -> float) : constant option =
match l with
| [ Float i ] -> Some (Float (f i))
| [ Int i ] -> Some (Float (f (Int32.to_float i)))
| [ Int i ] -> Some (Float (f (Targetint.to_float i)))
| _ -> None

let bool' b = Int (if b then 1l else 0l)
let bool' b = Int Targetint.(if b then one else zero)

let bool b = Some (bool' b)

Expand All @@ -130,36 +78,31 @@ let float_binop_bool l f =
| Some b -> bool b
| None -> None

let eval_prim ~target x =
let eval_prim x =
match x with
| Not, [ Int i ] -> bool Int32.(i = 0l)
| Lt, [ Int i; Int j ] -> bool Int32.(i < j)
| Le, [ Int i; Int j ] -> bool Int32.(i <= j)
| Eq, [ Int i; Int j ] -> bool Int32.(i = j)
| Neq, [ Int i; Int j ] -> bool Int32.(i <> j)
| Ult, [ Int i; Int j ] -> bool (Int32.(j < 0l) || Int32.(i < j))
| Not, [ Int i ] -> bool (Targetint.is_zero i)
| Lt, [ Int i; Int j ] -> bool Targetint.(i < j)
| Le, [ Int i; Int j ] -> bool Targetint.(i <= j)
| Eq, [ Int i; Int j ] -> bool Targetint.(i = j)
| Neq, [ Int i; Int j ] -> bool Targetint.(i <> j)
| Ult, [ Int i; Int j ] -> bool (Targetint.(j < zero) || Targetint.(i < j))
| Extern name, l -> (
let (module Int : Int) =
match target with
| `JavaScript -> (module Int32)
| `Wasm -> (module Int31)
in
let name = Primitive.resolve name in
match name, l with
(* int *)
| "%int_add", _ -> Int.int_binop l Int.add
| "%int_sub", _ -> Int.int_binop l Int.sub
| "%direct_int_mul", _ -> Int.int_binop l Int.mul
| "%direct_int_div", [ _; Int 0l ] -> None
| "%direct_int_div", _ -> Int.int_binop l Int.div
| "%direct_int_mod", _ -> Int.int_binop l Int.rem
| "%int_and", _ -> Int.int_binop l Int.logand
| "%int_or", _ -> Int.int_binop l Int.logor
| "%int_xor", _ -> Int.int_binop l Int.logxor
| "%int_lsl", _ -> Int.shift_op l Int.shift_left
| "%int_lsr", _ -> Int.shift_op l Int.shift_right_logical
| "%int_asr", _ -> Int.shift_op l Int.shift_right
| "%int_neg", _ -> Int.int_unop l Int.neg
| "%int_add", _ -> int_binop l Targetint.add
| "%int_sub", _ -> int_binop l Targetint.sub
| "%direct_int_mul", _ -> int_binop l Targetint.mul
| "%direct_int_div", [ _; Int x ] when Targetint.is_zero x -> None
| "%direct_int_div", _ -> int_binop l Targetint.div
| "%direct_int_mod", _ -> int_binop l Targetint.rem
| "%int_and", _ -> int_binop l Targetint.logand
| "%int_or", _ -> int_binop l Targetint.logor
| "%int_xor", _ -> int_binop l Targetint.logxor
| "%int_lsl", _ -> shift_op l Targetint.shift_left
| "%int_lsr", _ -> shift_op l Targetint.shift_right_logical
| "%int_asr", _ -> shift_op l Targetint.shift_right
| "%int_neg", _ -> int_unop l Targetint.neg
(* float *)
| "caml_eq_float", _ -> float_binop_bool l Float.( = )
| "caml_neq_float", _ -> float_binop_bool l Float.( <> )
Expand All @@ -172,9 +115,10 @@ let eval_prim ~target x =
| "caml_mul_float", _ -> float_binop l ( *. )
| "caml_div_float", _ -> float_binop l ( /. )
| "caml_fmod_float", _ -> float_binop l mod_float
| "caml_int_of_float", [ Float f ] ->
Some
(Int (Int32.of_float f |> Int.of_int32_warning_on_overflow |> Int.to_int32))
| "caml_int_of_float", [ Float f ] -> (
match Targetint.of_float_opt f with
| None -> None
| Some f -> Some (Int f))
(* Math *)
| "caml_neg_float", _ -> float_unop l ( ~-. )
| "caml_abs_float", _ -> float_unop l abs_float
Expand All @@ -192,9 +136,9 @@ let eval_prim ~target x =
| "caml_sqrt_float", _ -> float_unop l sqrt
| "caml_tan_float", _ -> float_unop l tan
| ("caml_string_get" | "caml_string_unsafe_get"), [ String s; Int pos ] ->
let pos = Int32.to_int pos in
let pos = Targetint.to_int_exn pos in
if Config.Flag.safe_string () && pos >= 0 && pos < String.length s
then Some (Int (Int32.of_int (Char.code s.[pos])))
then Some (Int (Targetint.of_int_exn (Char.code s.[pos])))
else None
| "caml_string_equal", [ String s1; String s2 ] -> bool (String.equal s1 s2)
| "caml_string_notequal", [ String s1; String s2 ] ->
Expand All @@ -203,10 +147,11 @@ let eval_prim ~target x =
match get_static_env s with
| Some env -> Some (String env)
| None -> None)
| "caml_sys_const_word_size", [ _ ] -> Some (Int 32l)
| "caml_sys_const_int_size", [ _ ] -> Some (Int (Int32.of_int Int.numbits))
| "caml_sys_const_big_endian", [ _ ] -> Some (Int 0l)
| "caml_sys_const_naked_pointers_checked", [ _ ] -> Some (Int 0l)
| "caml_sys_const_word_size", [ _ ] -> Some (Int (Targetint.of_int_exn 32))
| "caml_sys_const_int_size", [ _ ] ->
Some (Int (Targetint.of_int_exn (Targetint.num_bits ())))
| "caml_sys_const_big_endian", [ _ ] -> Some (Int Targetint.zero)
| "caml_sys_const_naked_pointers_checked", [ _ ] -> Some (Int Targetint.zero)
| _ -> None)
| _ -> None

Expand All @@ -215,14 +160,14 @@ let the_length_of ~target info x =
info
(fun x ->
match Flow.Info.def info x with
| Some (Constant (String s)) -> Some (Int32.of_int (String.length s))
| Some (Constant (String s)) -> Some (Targetint.of_int_exn (String.length s))
| Some (Prim (Extern "caml_create_string", [ arg ]))
| Some (Prim (Extern "caml_create_bytes", [ arg ])) -> the_int ~target info arg
| None | Some _ -> None)
None
(fun u v ->
match u, v with
| Some l, Some l' when Int32.(l = l') -> Some l
| Some l, Some l' when Targetint.(l = l') -> Some l
| _ -> None)
x

Expand Down Expand Up @@ -292,7 +237,7 @@ let the_cont_of info x (a : cont array) =
(fun x ->
match Flow.Info.def info x with
| Some (Prim (Extern "%direct_obj_tag", [ b ])) -> the_tag_of info b get
| Some (Constant (Int j)) -> get (Int32.to_int j)
| Some (Constant (Int j)) -> get (Targetint.to_int_exn j)
| None | Some _ -> None)
None
(fun u v ->
Expand All @@ -304,7 +249,7 @@ let the_cont_of info x (a : cont array) =
(* If [constant_js_equal a b = Some v], then [caml_js_equals a b = v]). *)
let constant_js_equal a b =
match a, b with
| Int i, Int j -> Some (Int32.equal i j)
| Int i, Int j -> Some (Targetint.equal i j)
| Float a, Float b -> Some (Float.ieee_equal a b)
| NativeString a, NativeString b -> Some (Native_string.equal a b)
| String a, String b when Config.Flag.use_js_string () -> Some (String.equal a b)
Expand Down Expand Up @@ -356,7 +301,7 @@ let eval_instr ~target info ((x, loc) as i) =
| Let (x, Prim (Extern "caml_ml_string_length", [ s ])) -> (
let c =
match s with
| Pc (String s) -> Some (Int32.of_int (String.length s))
| Pc (String s) -> Some (Targetint.of_int_exn (String.length s))
| Pv v -> the_length_of ~target info v
| _ -> None
in
Expand Down Expand Up @@ -391,7 +336,7 @@ let eval_instr ~target info ((x, loc) as i) =
| Let (x, Prim (Extern "%direct_obj_tag", [ y ])) -> (
match the_tag_of info y (fun x -> Some x) with
| Some tag ->
let c = Constant (Int (Int32.of_int tag)) in
let c = Constant (Int (Targetint.of_int_exn tag)) in
Flow.Info.update_def info x c;
[ Let (x, c), loc ]
| None -> [ i ])
Expand All @@ -415,7 +360,6 @@ let eval_instr ~target info ((x, loc) as i) =
| _ -> false)
then
eval_prim
~target
( prim
, List.map prim_args' ~f:(function
| Some c -> c
Expand Down Expand Up @@ -461,11 +405,10 @@ let the_cond_of info x =
info
(fun x ->
match Flow.Info.def info x with
| Some (Constant (Int 0l)) -> Zero
| Some (Constant (Int x)) -> if Targetint.is_zero x then Zero else Non_zero
| Some
(Constant
( Int _
| Int32 _
( Int32 _
| NativeInt _
| Float _
| Tuple _
Expand Down
Loading