Skip to content

Commit 38abfd5

Browse files
vouillonvouillon
committed
Move boxing/unboxing outside of some runtime primitives
This makes it visible to binaryen, which than is able to eliminate so unncessary boxing.
1 parent 548a3b2 commit 38abfd5

File tree

7 files changed

+240
-227
lines changed

7 files changed

+240
-227
lines changed

‎compiler/lib/wasm/wa_generate.ml‎

Lines changed: 92 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,71 @@ module Generate (Target : Wa_target_sig.S) = struct
3838
; debug : Parse_bytecode.Debug.t
3939
}
4040

41+
type repr =
42+
| Value
43+
| Float
44+
| Int32
45+
| Nativeint
46+
| Int64
47+
48+
let repr_type r =
49+
match r with
50+
| Value -> Value.value
51+
| Float -> F64
52+
| Int32 -> I32
53+
| Nativeint -> I32
54+
| Int64 -> I64
55+
56+
let specialized_func_type (params, result) =
57+
{ W.params = List.map ~f:repr_type params; result = [ repr_type result ] }
58+
59+
let box_value r e =
60+
match r with
61+
| Value -> e
62+
| Float -> Memory.box_float e
63+
| Int32 -> Memory.box_int32 e
64+
| Nativeint -> Memory.box_nativeint e
65+
| Int64 -> Memory.box_int64 e
66+
67+
let unbox_value r e =
68+
match r with
69+
| Value -> e
70+
| Float -> Memory.unbox_float e
71+
| Int32 -> Memory.unbox_int32 e
72+
| Nativeint -> Memory.unbox_nativeint e
73+
| Int64 -> Memory.unbox_int64 e
74+
75+
let specialized_primitives =
76+
let h = Hashtbl.create 18 in
77+
List.iter
78+
~f:(fun (nm, typ) -> Hashtbl.add h nm typ)
79+
[ "caml_int32_bswap", ([ Int32 ], Int32)
80+
; "caml_nativeint_bswap", ([ Nativeint ], Nativeint)
81+
; "caml_int64_bswap", ([ Int64 ], Int64)
82+
; "caml_int32_compare", ([ Int32; Int32 ], Value)
83+
; "caml_nativeint_compare", ([ Nativeint; Nativeint ], Value)
84+
; "caml_int64_compare", ([ Int64; Int64 ], Value)
85+
; "caml_string_get32", ([ Value; Value ], Int32)
86+
; "caml_string_get64", ([ Value; Value ], Int64)
87+
; "caml_bytes_get32", ([ Value; Value ], Int32)
88+
; "caml_bytes_get64", ([ Value; Value ], Int64)
89+
; "caml_bytes_set32", ([ Value; Value; Int32 ], Value)
90+
; "caml_bytes_set64", ([ Value; Value; Int64 ], Value)
91+
; "caml_lxm_next", ([ Value ], Int64)
92+
; "caml_ba_uint8_get32", ([ Value; Value ], Int32)
93+
; "caml_ba_uint8_get64", ([ Value; Value ], Int64)
94+
; "caml_ba_uint8_set32", ([ Value; Value; Int32 ], Value)
95+
; "caml_ba_uint8_set64", ([ Value; Value; Int64 ], Value)
96+
; "caml_nextafter_float", ([ Float; Float ], Float)
97+
; "caml_classify_float", ([ Float ], Value)
98+
; "caml_ldexp_float", ([ Float; Value ], Float)
99+
; "caml_signbit_float", ([ Float ], Value)
100+
; "caml_erf_float", ([ Float ], Float)
101+
; "caml_erfc_float", ([ Float ], Float)
102+
; "caml_float_compare", ([ Float; Float ], Value)
103+
];
104+
h
105+
41106
let func_type n =
42107
{ W.params = List.init ~len:n ~f:(fun _ -> Value.value); result = [ Value.value ] }
43108

@@ -386,6 +451,10 @@ module Generate (Target : Wa_target_sig.S) = struct
386451
int32_shift_op (Shr U) i j
387452
| Extern "caml_int32_to_int", [ i ] -> Value.val_int (Memory.unbox_int32 i)
388453
| Extern "caml_int32_of_int", [ i ] -> Memory.box_int32 (Value.int_val i)
454+
| Extern "caml_nativeint_of_int32", [ i ] ->
455+
Memory.box_nativeint (Memory.unbox_int32 i)
456+
| Extern "caml_nativeint_to_int32", [ i ] ->
457+
Memory.box_int32 (Memory.unbox_nativeint i)
389458
| Extern "caml_int64_bits_of_float", [ f ] ->
390459
let* f = Memory.unbox_float f in
391460
Memory.box_int64 (return (W.UnOp (I64 ReinterpretF, f)))
@@ -565,18 +634,30 @@ module Generate (Target : Wa_target_sig.S) = struct
565634
~init:(return [])
566635
in
567636
Memory.allocate ~tag:0 l
568-
| Extern name, l ->
637+
| Extern name, l -> (
569638
let name = Primitive.resolve name in
570-
(*ZZZ Different calling convention when large number of parameters *)
571-
let* f = register_import ~name (Fun (func_type (List.length l))) in
572-
let rec loop acc l =
573-
match l with
574-
| [] -> return (W.Call (f, List.rev acc))
575-
| x :: r ->
576-
let* x = x in
577-
loop (x :: acc) r
578-
in
579-
loop [] l
639+
try
640+
let typ = Hashtbl.find specialized_primitives name in
641+
let* f = register_import ~name (Fun (specialized_func_type typ)) in
642+
let rec loop acc arg_typ l =
643+
match arg_typ, l with
644+
| [], [] -> box_value (snd typ) (return (W.Call (f, List.rev acc)))
645+
| repr :: rem, x :: r ->
646+
let* x = unbox_value repr x in
647+
loop (x :: acc) rem r
648+
| [], _ :: _ | _ :: _, [] -> assert false
649+
in
650+
loop [] (fst typ) l
651+
with Not_found ->
652+
let* f = register_import ~name (Fun (func_type (List.length l))) in
653+
let rec loop acc l =
654+
match l with
655+
| [] -> return (W.Call (f, List.rev acc))
656+
| x :: r ->
657+
let* x = x in
658+
loop (x :: acc) r
659+
in
660+
loop [] l)
580661
| Not, [ x ] -> Value.not x
581662
| Lt, [ x; y ] -> Value.lt x y
582663
| Le, [ x; y ] -> Value.le x y

‎runtime/wasm/bigarray.wat‎

Lines changed: 52 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -1919,7 +1919,7 @@
19191919
(i32.const 8)))))
19201920

19211921
(func (export "caml_ba_uint8_get32")
1922-
(param $vba (ref eq)) (param $i (ref eq)) (result (ref eq))
1922+
(param $vba (ref eq)) (param $i (ref eq)) (result i32)
19231923
(local $ba (ref $bigarray))
19241924
(local $data (ref extern))
19251925
(local $p i32)
@@ -1933,23 +1933,22 @@
19331933
(struct.get $bigarray $ba_dim (local.get $ba))
19341934
(i32.const 0)))
19351935
(then (call $caml_bound_error)))
1936-
(return_call $caml_copy_int32
1936+
(i32.or
1937+
(i32.or
1938+
(call $ta_get_ui8 (local.get $data) (local.get $p))
1939+
(i32.shl (call $ta_get_ui8 (local.get $data)
1940+
(i32.add (local.get $p) (i32.const 1)))
1941+
(i32.const 8)))
19371942
(i32.or
1938-
(i32.or
1939-
(call $ta_get_ui8 (local.get $data) (local.get $p))
1940-
(i32.shl (call $ta_get_ui8 (local.get $data)
1941-
(i32.add (local.get $p) (i32.const 1)))
1942-
(i32.const 8)))
1943-
(i32.or
1944-
(i32.shl (call $ta_get_ui8 (local.get $data)
1945-
(i32.add (local.get $p) (i32.const 2)))
1946-
(i32.const 16))
1947-
(i32.shl (call $ta_get_ui8 (local.get $data)
1948-
(i32.add (local.get $p) (i32.const 3)))
1949-
(i32.const 24))))))
1943+
(i32.shl (call $ta_get_ui8 (local.get $data)
1944+
(i32.add (local.get $p) (i32.const 2)))
1945+
(i32.const 16))
1946+
(i32.shl (call $ta_get_ui8 (local.get $data)
1947+
(i32.add (local.get $p) (i32.const 3)))
1948+
(i32.const 24)))))
19501949

19511950
(func (export "caml_ba_uint8_get64")
1952-
(param $vba (ref eq)) (param $i (ref eq)) (result (ref eq))
1951+
(param $vba (ref eq)) (param $i (ref eq)) (result i64)
19531952
(local $ba (ref $bigarray))
19541953
(local $data (ref extern))
19551954
(local $p i32)
@@ -1963,44 +1962,43 @@
19631962
(struct.get $bigarray $ba_dim (local.get $ba))
19641963
(i32.const 0)))
19651964
(then (call $caml_bound_error)))
1966-
(return_call $caml_copy_int64
1965+
(i64.or
1966+
(i64.or
1967+
(i64.or
1968+
(i64.extend_i32_u
1969+
(call $ta_get_ui8 (local.get $data) (local.get $p)))
1970+
(i64.shl (i64.extend_i32_u
1971+
(call $ta_get_ui8 (local.get $data)
1972+
(i32.add (local.get $p) (i32.const 1))))
1973+
(i64.const 8)))
1974+
(i64.or
1975+
(i64.shl (i64.extend_i32_u
1976+
(call $ta_get_ui8 (local.get $data)
1977+
(i32.add (local.get $p) (i32.const 2))))
1978+
(i64.const 16))
1979+
(i64.shl (i64.extend_i32_u
1980+
(call $ta_get_ui8 (local.get $data)
1981+
(i32.add (local.get $p) (i32.const 3))))
1982+
(i64.const 24))))
19671983
(i64.or
19681984
(i64.or
1969-
(i64.or
1970-
(i64.extend_i32_u
1971-
(call $ta_get_ui8 (local.get $data) (local.get $p)))
1972-
(i64.shl (i64.extend_i32_u
1973-
(call $ta_get_ui8 (local.get $data)
1974-
(i32.add (local.get $p) (i32.const 1))))
1975-
(i64.const 8)))
1976-
(i64.or
1977-
(i64.shl (i64.extend_i32_u
1978-
(call $ta_get_ui8 (local.get $data)
1979-
(i32.add (local.get $p) (i32.const 2))))
1980-
(i64.const 16))
1981-
(i64.shl (i64.extend_i32_u
1982-
(call $ta_get_ui8 (local.get $data)
1983-
(i32.add (local.get $p) (i32.const 3))))
1984-
(i64.const 24))))
1985+
(i64.shl (i64.extend_i32_u
1986+
(call $ta_get_ui8 (local.get $data)
1987+
(i32.add (local.get $p) (i32.const 4))))
1988+
(i64.const 32))
1989+
(i64.shl (i64.extend_i32_u
1990+
(call $ta_get_ui8 (local.get $data)
1991+
(i32.add (local.get $p) (i32.const 5))))
1992+
(i64.const 40)))
19851993
(i64.or
1986-
(i64.or
1987-
(i64.shl (i64.extend_i32_u
1988-
(call $ta_get_ui8 (local.get $data)
1989-
(i32.add (local.get $p) (i32.const 4))))
1990-
(i64.const 32))
1991-
(i64.shl (i64.extend_i32_u
1992-
(call $ta_get_ui8 (local.get $data)
1993-
(i32.add (local.get $p) (i32.const 5))))
1994-
(i64.const 40)))
1995-
(i64.or
1996-
(i64.shl (i64.extend_i32_u
1997-
(call $ta_get_ui8 (local.get $data)
1998-
(i32.add (local.get $p) (i32.const 6))))
1999-
(i64.const 48))
2000-
(i64.shl (i64.extend_i32_u
2001-
(call $ta_get_ui8 (local.get $data)
2002-
(i32.add (local.get $p) (i32.const 7))))
2003-
(i64.const 56)))))))
1994+
(i64.shl (i64.extend_i32_u
1995+
(call $ta_get_ui8 (local.get $data)
1996+
(i32.add (local.get $p) (i32.const 6))))
1997+
(i64.const 48))
1998+
(i64.shl (i64.extend_i32_u
1999+
(call $ta_get_ui8 (local.get $data)
2000+
(i32.add (local.get $p) (i32.const 7))))
2001+
(i64.const 56))))))
20042002

20052003
(func (export "caml_ba_uint8_set16")
20062004
(param $vba (ref eq)) (param $i (ref eq)) (param $v (ref eq))
@@ -2026,15 +2024,14 @@
20262024
(ref.i31 (i32.const 0)))
20272025

20282026
(func (export "caml_ba_uint8_set32")
2029-
(param $vba (ref eq)) (param $i (ref eq)) (param $v (ref eq))
2027+
(param $vba (ref eq)) (param $i (ref eq)) (param $d i32)
20302028
(result (ref eq))
20312029
(local $ba (ref $bigarray))
20322030
(local $data (ref extern))
2033-
(local $p i32) (local $d i32)
2031+
(local $p i32)
20342032
(local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
20352033
(local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
20362034
(local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
2037-
(local.set $d (call $Int32_val (local.get $v)))
20382035
(if (i32.lt_s (local.get $p) (i32.const 0))
20392036
(then (call $caml_bound_error)))
20402037
(if (i32.ge_u (i32.add (local.get $p) (i32.const 3))
@@ -2056,15 +2053,14 @@
20562053
(ref.i31 (i32.const 0)))
20572054

20582055
(func (export "caml_ba_uint8_set64")
2059-
(param $vba (ref eq)) (param $i (ref eq)) (param $v (ref eq))
2056+
(param $vba (ref eq)) (param $i (ref eq)) (param $d i64)
20602057
(result (ref eq))
20612058
(local $ba (ref $bigarray))
20622059
(local $data (ref extern))
2063-
(local $p i32) (local $d i64)
2060+
(local $p i32)
20642061
(local.set $ba (ref.cast (ref $bigarray) (local.get $vba)))
20652062
(local.set $data (struct.get $bigarray $ba_data (local.get $ba)))
20662063
(local.set $p (i31.get_s (ref.cast (ref i31) (local.get $i))))
2067-
(local.set $d (call $Int64_val (local.get $v)))
20682064
(if (i32.lt_s (local.get $p) (i32.const 0))
20692065
(then (call $caml_bound_error)))
20702066
(if (i32.ge_u (i32.add (local.get $p) (i32.const 7))

‎runtime/wasm/float.wat‎

Lines changed: 21 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -661,32 +661,29 @@
661661
(return (ref.i31 (i32.const 0))))
662662

663663
(func (export "caml_nextafter_float")
664-
(param (ref eq)) (param (ref eq)) (result (ref eq))
665-
(local $x f64) (local $y f64) (local $i i64) (local $j i64)
666-
(local.set $x (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))
667-
(local.set $y (struct.get $float 0 (ref.cast (ref $float) (local.get 1))))
668-
(if (f64.ne (local.get $x) (local.get $x)) (then (return (local.get 0))))
669-
(if (f64.ne (local.get $y) (local.get $y)) (then (return (local.get 1))))
664+
(param $x f64) (param $y f64) (result f64)
665+
(local $i i64) (local $j i64)
666+
(if (f64.ne (local.get $x) (local.get $x)) (then (return (local.get $x))))
667+
(if (f64.ne (local.get $y) (local.get $y)) (then (return (local.get $y))))
670668
(if (f64.eq (local.get $x) (local.get $y))
671-
(then (return (local.get 1))))
672-
(if (result (ref eq)) (f64.eq (local.get $x) (f64.const 0))
669+
(then (return (local.get $y))))
670+
(if (f64.eq (local.get $x) (f64.const 0))
673671
(then
674672
(if (f64.ge (local.get $y) (f64.const 0))
675-
(then (return (struct.new $float (f64.const 0x1p-1074))))
676-
(else (return (struct.new $float (f64.const -0x1p-1074))))))
673+
(then (return (f64.const 0x1p-1074)))
674+
(else (return (f64.const -0x1p-1074)))))
677675
(else
678676
(local.set $i (i64.reinterpret_f64 (local.get $x)))
679677
(local.set $j (i64.reinterpret_f64 (local.get $y)))
680678
(if (i32.and (i64.lt_s (local.get $i) (local.get $j))
681679
(i64.lt_u (local.get $i) (local.get $j)))
682680
(then (local.set $i (i64.add (local.get $i) (i64.const 1))))
683681
(else (local.set $i (i64.sub (local.get $i) (i64.const 1)))))
684-
(return (struct.new $float (f64.reinterpret_i64 (local.get $i)))))))
682+
(return (f64.reinterpret_i64 (local.get $i))))))
685683

686-
(func (export "caml_classify_float") (param (ref eq)) (result (ref eq))
684+
(func (export "caml_classify_float") (param $x f64) (result (ref eq))
687685
(local $a f64)
688-
(local.set $a
689-
(f64.abs (struct.get $float 0 (ref.cast (ref $float) (local.get 0)))))
686+
(local.set $a (f64.abs (local.get $x)))
690687
(ref.i31
691688
(if (result i32) (f64.ge (local.get $a) (f64.const 0x1p-1022))
692689
(then
@@ -753,11 +750,10 @@
753750
(i64.const 52)))))
754751

755752
(func (export "caml_ldexp_float")
756-
(param (ref eq)) (param (ref eq)) (result (ref eq))
757-
(struct.new $float
758-
(call $ldexp
759-
(struct.get $float 0 (ref.cast (ref $float) (local.get 0)))
760-
(i31.get_s (ref.cast (ref i31) (local.get 1))))))
753+
(param $x f64) (param $i (ref eq)) (result f64)
754+
(call $ldexp
755+
(local.get $x)
756+
(i31.get_s (ref.cast (ref i31) (local.get $i)))))
761757

762758
(func $frexp (param $x f64) (result f64 i32)
763759
(local $y i64)
@@ -799,15 +795,12 @@
799795
(struct.new $float (tuple.extract 2 0 (local.get $r)))
800796
(ref.i31 (tuple.extract 2 1 (local.get $r)))))
801797

802-
(func (export "caml_signbit_float") (param (ref eq)) (result (ref eq))
798+
(func (export "caml_signbit_float") (param $x f64) (result (ref eq))
803799
(ref.i31
804800
(i32.wrap_i64
805-
(i64.shr_u
806-
(i64.reinterpret_f64
807-
(struct.get $float 0 (ref.cast (ref $float) (local.get 0))))
808-
(i64.const 63)))))
801+
(i64.shr_u (i64.reinterpret_f64 (local.get $x)) (i64.const 63)))))
809802

810-
(func $erf (param $x f64) (result f64)
803+
(func $erf (export "caml_erf_float") (param $x f64) (result f64)
811804
(local $a1 f64) (local $a2 f64) (local $a3 f64)
812805
(local $a4 f64) (local $a5 f64) (local $p f64)
813806
(local $t f64) (local $y f64)
@@ -844,16 +837,8 @@
844837
(f64.neg (f64.mul (local.get $x) (local.get $x))))))))
845838
(f64.copysign (local.get $y) (local.get $x)))
846839

847-
(func (export "caml_erf_float") (param (ref eq)) (result (ref eq))
848-
(struct.new $float
849-
(call $erf
850-
(struct.get $float 0 (ref.cast (ref $float) (local.get 0))))))
851-
852-
(func (export "caml_erfc_float") (param (ref eq)) (result (ref eq))
853-
(struct.new $float
854-
(f64.sub (f64.const 1)
855-
(call $erf
856-
(struct.get $float 0 (ref.cast (ref $float) (local.get 0)))))))
840+
(func (export "caml_erfc_float") (param $x f64) (result f64)
841+
(f64.sub (f64.const 1) (call $erf (local.get $x))))
857842

858843
(func (export "caml_fma_float")
859844
(param $vx (ref eq)) (param $vy (ref eq)) (param $vz (ref eq))
@@ -1154,10 +1139,7 @@
11541139
(struct.new $float (local.get $y)))
11551140

11561141
(func (export "caml_float_compare")
1157-
(param (ref eq)) (param (ref eq)) (result (ref eq))
1158-
(local $x f64) (local $y f64)
1159-
(local.set $x (struct.get $float 0 (ref.cast (ref $float) (local.get 0))))
1160-
(local.set $y (struct.get $float 0 (ref.cast (ref $float) (local.get 1))))
1142+
(param $x f64) (param $y f64) (result (ref eq))
11611143
(ref.i31
11621144
(i32.add
11631145
(i32.sub (f64.gt (local.get $x) (local.get $y))

0 commit comments

Comments
 (0)