Skip to content

Commit 53ccf9e

Browse files
xclercxclerc
committed
Tweak the Cmm.Cextcall constructor.
1 parent 9e7c257 commit 53ccf9e

File tree

18 files changed

+82
-58
lines changed

18 files changed

+82
-58
lines changed

‎backend/afl_instrument.ml

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -103,11 +103,12 @@ let instrument_initialiser c dbg =
103103
calls *)
104104
with_afl_logging
105105
(Csequence
106-
(Cop (Cextcall { name = "caml_setup_afl";
106+
(Cop (Cextcall { func = "caml_setup_afl";
107107
builtin = false;
108+
returns = true;
108109
effects = Arbitrary_effects;
109110
coeffects = Has_coeffects;
110-
ret = typ_int; alloc = false; ty_args = []; },
111+
ty = typ_int; alloc = false; ty_args = []; },
111112
[Cconst_int (0, dbg ())],
112113
dbg ()),
113114
c))

‎backend/amd64/selection.ml

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -167,7 +167,7 @@ method is_immediate_test _cmp n = is_immediate n
167167

168168
method! is_simple_expr e =
169169
match e with
170-
| Cop(Cextcall { name = fn; }, args, _)
170+
| Cop(Cextcall { func = fn; }, args, _)
171171
when List.mem fn inline_ops ->
172172
(* inlined ops are simple if their arguments are *)
173173
List.for_all self#is_simple_expr args
@@ -176,7 +176,7 @@ method! is_simple_expr e =
176176

177177
method! effects_of e =
178178
match e with
179-
| Cop(Cextcall { name = fn; }, args, _)
179+
| Cop(Cextcall { func = fn; }, args, _)
180180
when List.mem fn inline_ops ->
181181
Selectgen.Effect_and_coeffect.join_list_map args self#effects_of
182182
| _ ->
@@ -233,7 +233,7 @@ method! select_operation op args dbg =
233233
self#select_floatarith true Imulf Ifloatmul args
234234
| Cdivf ->
235235
self#select_floatarith false Idivf Ifloatdiv args
236-
| Cextcall { name = "sqrt"; alloc = false; } ->
236+
| Cextcall { func = "sqrt"; alloc = false; } ->
237237
begin match args with
238238
[Cop(Cload ((Double as chunk), _), [loc], _dbg)] ->
239239
let (addr, arg) = self#select_addressing chunk loc in
@@ -243,8 +243,8 @@ method! select_operation op args dbg =
243243
| _ ->
244244
assert false
245245
end
246-
| Cextcall { name; builtin = true; ret; ty_args = _; } ->
247-
begin match name, ret with
246+
| Cextcall { func; builtin = true; ty = ret; ty_args = _; } ->
247+
begin match func, ret with
248248
| "caml_rdtsc_unboxed", [|Int|] -> Ispecific Irdtsc, args
249249
| "caml_rdpmc_unboxed", [|Int|] -> Ispecific Irdpmc, args
250250
| ("caml_int64_crc_unboxed", [|Int|]
@@ -263,12 +263,12 @@ method! select_operation op args dbg =
263263
| _ ->
264264
super#select_operation op args dbg
265265
end
266-
| Cextcall { name = "caml_bswap16_direct"; } ->
266+
| Cextcall { func = "caml_bswap16_direct"; } ->
267267
(Ispecific (Ibswap 16), args)
268-
| Cextcall { name = "caml_int32_direct_bswap"; } ->
268+
| Cextcall { func = "caml_int32_direct_bswap"; } ->
269269
(Ispecific (Ibswap 32), args)
270-
| Cextcall { name = "caml_int64_direct_bswap"; }
271-
| Cextcall { name = "caml_nativeint_direct_bswap"; } ->
270+
| Cextcall { func = "caml_int64_direct_bswap"; }
271+
| Cextcall { func = "caml_nativeint_direct_bswap"; } ->
272272
(Ispecific (Ibswap 64), args)
273273
(* Recognize sign extension *)
274274
| Casr ->

‎backend/cfg/cfg_intf.ml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,7 @@ module S = struct
4343
| External of
4444
{ func_symbol : string;
4545
alloc : bool;
46+
returns : bool;
4647
ty_res : Cmm.machtype;
4748
ty_args : Cmm.exttype list
4849
}

‎backend/cfg/cfg_to_linear.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -46,8 +46,8 @@ let from_basic (basic : Cfg.basic) : L.instruction_desc =
4646
| Call (F (Indirect)) -> Lop (Icall_ind)
4747
| Call (F (Direct { func_symbol; })) ->
4848
Lop (Icall_imm { func = func_symbol; })
49-
| Call (P (External { func_symbol; alloc; ty_args; ty_res; })) ->
50-
Lop (Iextcall { func = func_symbol; alloc; ty_args; ty_res; })
49+
| Call (P (External { func_symbol; alloc; ty_args; ty_res; returns; })) ->
50+
Lop (Iextcall { func = func_symbol; alloc; ty_args; ty_res; returns; })
5151
| Call
5252
(P
5353
(Checkbound { immediate = None; }))

‎backend/cfg/linear_to_cfg.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -400,8 +400,8 @@ let to_basic (mop : Mach.operation) : C.basic =
400400
| Icall_ind -> Call (F Indirect)
401401
| Icall_imm { func; } ->
402402
Call (F (Direct { func_symbol = func; }))
403-
| Iextcall { func; alloc; ty_args; ty_res; } ->
404-
Call (P (External { func_symbol = func; alloc; ty_args; ty_res }))
403+
| Iextcall { func; alloc; ty_args; ty_res; returns; } ->
404+
Call (P (External { func_symbol = func; alloc; ty_args; ty_res; returns }))
405405
| Iintop Icheckbound ->
406406
Call
407407
(P

‎backend/cmm.ml

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -167,13 +167,14 @@ type memory_chunk =
167167
and operation =
168168
Capply of machtype
169169
| Cextcall of
170-
{ name: string;
171-
ret: machtype;
170+
{ func: string;
171+
ty: machtype;
172+
ty_args : exttype list;
172173
alloc: bool;
173174
builtin: bool;
175+
returns: bool;
174176
effects: effects;
175177
coeffects: coeffects;
176-
ty_args : exttype list;
177178
}
178179
| Cload of memory_chunk * Asttypes.mutable_flag
179180
| Calloc

‎backend/cmm.mli

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -166,13 +166,14 @@ type memory_chunk =
166166
and operation =
167167
Capply of machtype
168168
| Cextcall of
169-
{ name: string;
170-
ret: machtype;
169+
{ func: string;
170+
ty: machtype;
171+
ty_args : exttype list;
171172
alloc: bool;
172173
builtin: bool;
174+
returns: bool;
173175
effects: effects;
174176
coeffects: coeffects;
175-
ty_args : exttype list;
176177
}
177178
(** The [machtype] is the machine type of the result.
178179
The [exttype list] describes the unboxing types of the arguments.

‎backend/cmm_helpers.ml

Lines changed: 27 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -612,7 +612,7 @@ let rec remove_unit = function
612612
| Cop(Capply _mty, args, dbg) ->
613613
Cop(Capply typ_void, args, dbg)
614614
| Cop(Cextcall c, args, dbg) ->
615-
Cop(Cextcall {c with ret = typ_void; }, args, dbg)
615+
Cop(Cextcall {c with ty = typ_void; }, args, dbg)
616616
| Cexit (_,_,_) as c -> c
617617
| Ctuple [] as c -> c
618618
| c -> Csequence(c, Ctuple [])
@@ -734,18 +734,20 @@ let float_array_ref arr ofs dbg =
734734
box_float dbg (unboxed_float_array_ref arr ofs dbg)
735735

736736
let addr_array_set arr ofs newval dbg =
737-
Cop(Cextcall { name = "caml_modify"; ret = typ_void; alloc = false;
737+
Cop(Cextcall { func = "caml_modify"; ty = typ_void; alloc = false;
738738
builtin = false;
739+
returns = true;
739740
effects = Arbitrary_effects;
740741
coeffects = Has_coeffects;
741742
ty_args = []},
742743
[array_indexing log2_size_addr arr ofs dbg; newval], dbg)
743744
let addr_array_initialize arr ofs newval dbg =
744-
Cop(Cextcall { name = "caml_initialize";
745+
Cop(Cextcall { func = "caml_initialize";
745746
builtin = false;
747+
returns = true;
746748
effects = Arbitrary_effects;
747749
coeffects = Has_coeffects;
748-
ret = typ_void; alloc = false; ty_args = []},
750+
ty = typ_void; alloc = false; ty_args = []},
749751
[array_indexing log2_size_addr arr ofs dbg; newval], dbg)
750752
let int_array_set arr ofs newval dbg =
751753
Cop(Cstore (Word_int, Lambda.Assignment),
@@ -781,8 +783,9 @@ let bigstring_length ba dbg =
781783

782784
let lookup_tag obj tag dbg =
783785
bind "tag" tag (fun tag ->
784-
Cop(Cextcall { name = "caml_get_public_method"; ret = typ_val;
786+
Cop(Cextcall { func = "caml_get_public_method"; ty = typ_val;
785787
builtin = false;
788+
returns = true;
786789
effects = Arbitrary_effects;
787790
coeffects = Has_coeffects;
788791
alloc = false; ty_args = [] },
@@ -815,8 +818,9 @@ let make_alloc_generic set_fn dbg tag wordsize args =
815818
| e1::el -> Csequence(set_fn (Cvar id) (Cconst_int (idx, dbg)) e1 dbg,
816819
fill_fields (idx + 2) el) in
817820
Clet(VP.create id,
818-
Cop(Cextcall { name = "caml_alloc"; ret = typ_val; alloc = true;
821+
Cop(Cextcall { func = "caml_alloc"; ty = typ_val; alloc = true;
819822
builtin = false;
823+
returns = true;
820824
effects = Arbitrary_effects;
821825
coeffects = Has_coeffects;
822826
ty_args = [] },
@@ -826,8 +830,9 @@ let make_alloc_generic set_fn dbg tag wordsize args =
826830

827831
let make_alloc dbg tag args =
828832
let addr_array_init arr ofs newval dbg =
829-
Cop(Cextcall { name = "caml_initialize"; ret = typ_void; alloc = false;
833+
Cop(Cextcall { func = "caml_initialize"; ty = typ_void; alloc = false;
830834
builtin = false;
835+
returns = true;
831836
effects = Arbitrary_effects;
832837
coeffects = Has_coeffects;
833838
ty_args = [] },
@@ -2177,20 +2182,22 @@ let bbswap bi arg dbg =
21772182
| Pint32 -> "int32", XInt32
21782183
| Pint64 -> "int64", XInt64
21792184
in
2180-
Cop(Cextcall { name = Printf.sprintf "caml_%s_direct_bswap" prim;
2185+
Cop(Cextcall { func = Printf.sprintf "caml_%s_direct_bswap" prim;
21812186
builtin = false;
2187+
returns = true;
21822188
effects = Arbitrary_effects;
21832189
coeffects = Has_coeffects;
2184-
ret = typ_int; alloc = false; ty_args = [tyarg]; },
2190+
ty = typ_int; alloc = false; ty_args = [tyarg]; },
21852191
[arg],
21862192
dbg)
21872193

21882194
let bswap16 arg dbg =
2189-
(Cop(Cextcall { name = "caml_bswap16_direct";
2195+
(Cop(Cextcall { func = "caml_bswap16_direct";
21902196
builtin = false;
2197+
returns = true;
21912198
effects = Arbitrary_effects;
21922199
coeffects = Has_coeffects;
2193-
ret = typ_int; alloc = false; ty_args = []; },
2200+
ty = typ_int; alloc = false; ty_args = []; },
21942201
[arg],
21952202
dbg))
21962203

@@ -2251,19 +2258,21 @@ let assignment_kind
22512258
let setfield n ptr init arg1 arg2 dbg =
22522259
match assignment_kind ptr init with
22532260
| Caml_modify ->
2254-
return_unit dbg (Cop(Cextcall { name = "caml_modify";
2255-
ret = typ_void; alloc = false;
2261+
return_unit dbg (Cop(Cextcall { func = "caml_modify";
2262+
ty = typ_void; alloc = false;
22562263
builtin = false;
2264+
returns = true;
22572265
effects = Arbitrary_effects;
22582266
coeffects = Has_coeffects;
22592267
ty_args = [] },
22602268
[field_address arg1 n dbg;
22612269
arg2],
22622270
dbg))
22632271
| Caml_initialize ->
2264-
return_unit dbg (Cop(Cextcall { name = "caml_initialize";
2265-
ret = typ_void; alloc = false;
2272+
return_unit dbg (Cop(Cextcall { func = "caml_initialize";
2273+
ty = typ_void; alloc = false;
22662274
builtin = false;
2275+
returns = true;
22672276
effects = Arbitrary_effects;
22682277
coeffects = Has_coeffects;
22692278
ty_args = [] },
@@ -2723,13 +2732,14 @@ let transl_builtin name args dbg =
27232732
| _ -> None
27242733

27252734
(* [cextcall] is called from [Cmmgen.transl_ccall] *)
2726-
let cextcall (prim : Primitive.description) args dbg ret ty_args =
2735+
let cextcall (prim : Primitive.description) args dbg ret ty_args returns =
27272736
let name = Primitive.native_name prim in
2728-
let default = Cop(Cextcall { name; ret;
2737+
let default = Cop(Cextcall { func = name; ty = ret;
27292738
builtin = prim.prim_c_builtin;
27302739
effects = Arbitrary_effects;
27312740
coeffects = Has_coeffects;
27322741
alloc = prim.prim_alloc;
2742+
returns;
27332743
ty_args },
27342744
args, dbg)
27352745
in

‎backend/cmm_helpers.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -579,7 +579,7 @@ val send :
579579
that corresponds to [prim]. If [prim] is a C builtin supported on the
580580
target, returns [Cmm.operation] variant for [prim]'s intrinsics. *)
581581
val cextcall : Primitive.description -> expression list -> Debuginfo.t ->
582-
machtype -> exttype list -> expression
582+
machtype -> exttype list -> bool -> expression
583583

584584
(** Generic Cmm fragments *)
585585

‎backend/cmmgen.ml

Lines changed: 10 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -768,11 +768,12 @@ and transl_catch env nfail ids body handler dbg =
768768
and transl_make_array dbg env kind args =
769769
match kind with
770770
| Pgenarray ->
771-
Cop(Cextcall { name = "caml_make_array";
771+
Cop(Cextcall { func = "caml_make_array";
772772
builtin = false;
773+
returns = true;
773774
effects = Arbitrary_effects;
774775
coeffects = Has_coeffects;
775-
ret = typ_val; alloc = true; ty_args = []},
776+
ty = typ_val; alloc = true; ty_args = []},
776777
[make_alloc dbg 0 (List.map (transl env) args)], dbg)
777778
| Paddrarray | Pintarray ->
778779
make_alloc dbg 0 (List.map (transl env) args)
@@ -821,11 +822,12 @@ and transl_ccall env prim args dbg =
821822
in
822823
let typ_args, args = transl_args prim.prim_native_repr_args args in
823824
wrap_result
824-
(Cop(Cextcall { name = Primitive.native_name prim;
825+
(Cop(Cextcall { func = Primitive.native_name prim;
825826
builtin = false;
827+
returns = true;
826828
effects = Arbitrary_effects;
827829
coeffects = Has_coeffects;
828-
ret = typ_res; alloc = prim.prim_alloc;
830+
ty = typ_res; alloc = prim.prim_alloc;
829831
ty_args = typ_args },
830832
args, dbg))
831833

@@ -1369,8 +1371,9 @@ and transl_letrec env bindings cont =
13691371
bindings
13701372
in
13711373
let op_alloc prim args =
1372-
Cop(Cextcall { name = prim; ret = typ_val; alloc = true;
1374+
Cop(Cextcall { func = prim; ty = typ_val; alloc = true;
13731375
builtin = false;
1376+
returns = true;
13741377
effects = Arbitrary_effects;
13751378
coeffects = Has_coeffects;
13761379
ty_args = [] },
@@ -1400,8 +1403,9 @@ and transl_letrec env bindings cont =
14001403
| [] -> cont
14011404
| (id, exp, (RHS_block _ | RHS_infix _ | RHS_floatblock _)) :: rem ->
14021405
let op =
1403-
Cop(Cextcall { name = "caml_update_dummy"; ret = typ_void;
1406+
Cop(Cextcall { func = "caml_update_dummy"; ty = typ_void;
14041407
builtin = false;
1408+
returns = true;
14051409
effects = Arbitrary_effects;
14061410
coeffects = Has_coeffects;
14071411
alloc = false; ty_args = [] },

‎backend/linearize.ml

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -158,7 +158,8 @@ let linear i n contains_calls =
158158
let rec linear env i n =
159159
match i.Mach.desc with
160160
Iend -> n
161-
| Iop(Itailcall_ind | Itailcall_imm _ as op) ->
161+
| Iop(Itailcall_ind | Itailcall_imm _ as op)
162+
| Iop((Iextcall { returns = false; _ }) as op) ->
162163
copy_instr (Lop op) i (linear env i.Mach.next n)
163164
| Iop(Imove | Ireload | Ispill)
164165
when i.Mach.arg.(0).loc = i.Mach.res.(0).loc ->

‎backend/liveness.ml

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -73,6 +73,9 @@ let rec live env i finally =
7373
let across_after = Reg.diff_set_array after i.res in
7474
let across =
7575
match op with
76+
| Iextcall { returns = false; _ } ->
77+
(* extcalls that never return can raise an exception *)
78+
env.at_raise
7679
| Icall_ind | Icall_imm _ | Iextcall _ | Ialloc _
7780
| Iprobe _
7881
| Iintop (Icheckbound) | Iintop_imm(Icheckbound, _) ->

‎backend/mach.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,7 @@ type operation =
5757
| Itailcall_imm of { func : string; }
5858
| Iextcall of { func : string;
5959
ty_res : Cmm.machtype; ty_args : Cmm.exttype list;
60-
alloc : bool; }
60+
alloc : bool; returns : bool; }
6161
| Istackoffset of int
6262
| Iload of Cmm.memory_chunk * Arch.addressing_mode
6363
| Istore of Cmm.memory_chunk * Arch.addressing_mode * bool

‎backend/mach.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,7 @@ type operation =
6060
| Itailcall_imm of { func : string; }
6161
| Iextcall of { func : string;
6262
ty_res : Cmm.machtype; ty_args : Cmm.exttype list;
63-
alloc : bool; }
63+
alloc : bool; returns : bool; }
6464
| Istackoffset of int
6565
| Iload of Cmm.memory_chunk * Arch.addressing_mode
6666
| Istore of Cmm.memory_chunk * Arch.addressing_mode * bool

‎backend/printcmm.ml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -137,7 +137,7 @@ let trywith_kind ppf kind =
137137

138138
let operation d = function
139139
| Capply _ty -> "app" ^ location d
140-
| Cextcall { name = lbl; _ } ->
140+
| Cextcall { func = lbl; _ } ->
141141
Printf.sprintf "extcall \"%s\"%s" lbl (location d)
142142
| Cload (c, Asttypes.Immutable) -> Printf.sprintf "load %s" (chunk c)
143143
| Cload (c, Asttypes.Mutable) -> Printf.sprintf "load_mut %s" (chunk c)
@@ -246,8 +246,8 @@ let rec expr ppf = function
246246
List.iter (fun e -> fprintf ppf "@ %a" expr e) el;
247247
begin match op with
248248
| Capply mty -> fprintf ppf "@ %a" machtype mty
249-
| Cextcall { ret; ty_args; alloc = _; name = _; } ->
250-
fprintf ppf "@ %a" extcall_signature (ret, ty_args)
249+
| Cextcall { ty; ty_args; alloc = _; func = _; } ->
250+
fprintf ppf "@ %a" extcall_signature (ty, ty_args)
251251
| _ -> ()
252252
end;
253253
fprintf ppf ")@]"

0 commit comments

Comments
 (0)