Skip to content

Commit b470a74

Browse files
gaschedijkstracula
gasche
authored and
dijkstracula
committed
Merge pull request ocaml#14010 from mshinwell/string-ops-machtypes
Fix miscompilation / liveness errors for string operations
1 parent 3499e57 commit b470a74

1 file changed

Lines changed: 75 additions & 40 deletions

File tree

‎asmcomp/cmm_helpers.ml‎

Lines changed: 75 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -148,6 +148,14 @@ let rec add_const c n dbg =
148148
let incr_int c dbg = add_const c 1 dbg
149149
let decr_int c dbg = add_const c (-1) dbg
150150

151+
let offset_addr c1 c2 dbg =
152+
match c1, c2 with
153+
| c, Cconst_int (0, _) -> c
154+
| c, Cconst_natint (0n, _) -> c
155+
| Cop(Cadda, [c; Cconst_int(n1, _)], _), _ ->
156+
Cop(Cadda, [c; add_const c2 n1 dbg], dbg)
157+
| _, _ -> Cop (Cadda, [c1; c2], dbg)
158+
151159
let rec add_int c1 c2 dbg =
152160
match (c1, c2) with
153161
| (Cconst_int (n, _), c) | (c, Cconst_int (n, _)) ->
@@ -1100,20 +1108,21 @@ let make_unsigned_int bi arg dbg =
11001108

11011109
let unaligned_load_16 ptr idx dbg =
11021110
if Arch.allow_unaligned_access
1103-
then Cop(mk_load_mut Sixteen_unsigned, [add_int ptr idx dbg], dbg)
1111+
then Cop(mk_load_mut Sixteen_unsigned, [offset_addr ptr idx dbg], dbg)
11041112
else
11051113
let cconst_int i = Cconst_int (i, dbg) in
1106-
let v1 = Cop(mk_load_mut Byte_unsigned, [add_int ptr idx dbg], dbg) in
1114+
let v1 = Cop(mk_load_mut Byte_unsigned, [offset_addr ptr idx dbg], dbg) in
11071115
let v2 = Cop(mk_load_mut Byte_unsigned,
1108-
[add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg) in
1116+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 1) dbg],
1117+
dbg) in
11091118
let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in
11101119
Cop(Cor, [lsl_int b1 (cconst_int 8) dbg; b2], dbg)
11111120

11121121
let unaligned_set_16 ptr idx newval dbg =
11131122
if Arch.allow_unaligned_access
11141123
then
11151124
Cop(Cstore (Sixteen_unsigned, Assignment),
1116-
[add_int ptr idx dbg; newval], dbg)
1125+
[offset_addr ptr idx dbg; newval], dbg)
11171126
else
11181127
let cconst_int i = Cconst_int (i, dbg) in
11191128
let v1 =
@@ -1123,24 +1132,29 @@ let unaligned_set_16 ptr idx newval dbg =
11231132
let v2 = Cop(Cand, [newval; cconst_int 0xFF], dbg) in
11241133
let b1, b2 = if Arch.big_endian then v1, v2 else v2, v1 in
11251134
Csequence(
1126-
Cop(Cstore (Byte_unsigned, Assignment), [add_int ptr idx dbg; b1], dbg),
1135+
Cop(Cstore (Byte_unsigned, Assignment), [offset_addr ptr idx dbg; b1],
1136+
dbg),
11271137
Cop(Cstore (Byte_unsigned, Assignment),
1128-
[add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2], dbg))
1138+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 1) dbg; b2],
1139+
dbg))
11291140

11301141
let unaligned_load_32 ptr idx dbg =
11311142
if Arch.allow_unaligned_access
1132-
then Cop(mk_load_mut Thirtytwo_unsigned, [add_int ptr idx dbg], dbg)
1143+
then Cop(mk_load_mut Thirtytwo_unsigned, [offset_addr ptr idx dbg], dbg)
11331144
else
11341145
let cconst_int i = Cconst_int (i, dbg) in
1135-
let v1 = Cop(mk_load_mut Byte_unsigned, [add_int ptr idx dbg], dbg) in
1146+
let v1 = Cop(mk_load_mut Byte_unsigned, [offset_addr ptr idx dbg], dbg) in
11361147
let v2 = Cop(mk_load_mut Byte_unsigned,
1137-
[add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg)
1148+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 1) dbg],
1149+
dbg)
11381150
in
11391151
let v3 = Cop(mk_load_mut Byte_unsigned,
1140-
[add_int (add_int ptr idx dbg) (cconst_int 2) dbg], dbg)
1152+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 2) dbg],
1153+
dbg)
11411154
in
11421155
let v4 = Cop(mk_load_mut Byte_unsigned,
1143-
[add_int (add_int ptr idx dbg) (cconst_int 3) dbg], dbg)
1156+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 3) dbg],
1157+
dbg)
11441158
in
11451159
let b1, b2, b3, b4 =
11461160
if Arch.big_endian
@@ -1155,15 +1169,18 @@ let unaligned_load_32 ptr idx dbg =
11551169
let unaligned_set_32 ptr idx newval dbg =
11561170
if Arch.allow_unaligned_access
11571171
then
1158-
Cop(Cstore (Thirtytwo_unsigned, Assignment), [add_int ptr idx dbg; newval],
1172+
Cop(Cstore (Thirtytwo_unsigned, Assignment),
1173+
[offset_addr ptr idx dbg; newval],
11591174
dbg)
11601175
else
11611176
let cconst_int i = Cconst_int (i, dbg) in
11621177
let v1 =
1163-
Cop(Cand, [Cop(Clsr, [newval; cconst_int 24], dbg); cconst_int 0xFF], dbg)
1178+
Cop(Cand, [Cop(Clsr, [newval; cconst_int 24], dbg); cconst_int 0xFF],
1179+
dbg)
11641180
in
11651181
let v2 =
1166-
Cop(Cand, [Cop(Clsr, [newval; cconst_int 16], dbg); cconst_int 0xFF], dbg)
1182+
Cop(Cand, [Cop(Clsr, [newval; cconst_int 16], dbg); cconst_int 0xFF],
1183+
dbg)
11671184
in
11681185
let v3 =
11691186
Cop(Cand, [Cop(Clsr, [newval; cconst_int 8], dbg); cconst_int 0xFF], dbg)
@@ -1176,38 +1193,48 @@ let unaligned_set_32 ptr idx newval dbg =
11761193
Csequence(
11771194
Csequence(
11781195
Cop(Cstore (Byte_unsigned, Assignment),
1179-
[add_int ptr idx dbg; b1], dbg),
1196+
[offset_addr ptr idx dbg; b1], dbg),
11801197
Cop(Cstore (Byte_unsigned, Assignment),
1181-
[add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2],
1198+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 1) dbg;
1199+
b2],
11821200
dbg)),
11831201
Csequence(
11841202
Cop(Cstore (Byte_unsigned, Assignment),
1185-
[add_int (add_int ptr idx dbg) (cconst_int 2) dbg; b3],
1203+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 2) dbg;
1204+
b3],
11861205
dbg),
11871206
Cop(Cstore (Byte_unsigned, Assignment),
1188-
[add_int (add_int ptr idx dbg) (cconst_int 3) dbg; b4],
1207+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 3) dbg;
1208+
b4],
11891209
dbg)))
11901210

11911211
let unaligned_load_64 ptr idx dbg =
11921212
if Arch.allow_unaligned_access
1193-
then Cop(mk_load_mut Word_int, [add_int ptr idx dbg], dbg)
1213+
then Cop(mk_load_mut Word_int, [offset_addr ptr idx dbg], dbg)
11941214
else
11951215
let cconst_int i = Cconst_int (i, dbg) in
1196-
let v1 = Cop(mk_load_mut Byte_unsigned, [add_int ptr idx dbg], dbg) in
1216+
let v1 = Cop(mk_load_mut Byte_unsigned, [offset_addr ptr idx dbg], dbg) in
11971217
let v2 = Cop(mk_load_mut Byte_unsigned,
1198-
[add_int (add_int ptr idx dbg) (cconst_int 1) dbg], dbg) in
1218+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 1) dbg],
1219+
dbg) in
11991220
let v3 = Cop(mk_load_mut Byte_unsigned,
1200-
[add_int (add_int ptr idx dbg) (cconst_int 2) dbg], dbg) in
1221+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 2) dbg],
1222+
dbg) in
12011223
let v4 = Cop(mk_load_mut Byte_unsigned,
1202-
[add_int (add_int ptr idx dbg) (cconst_int 3) dbg], dbg) in
1224+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 3) dbg],
1225+
dbg) in
12031226
let v5 = Cop(mk_load_mut Byte_unsigned,
1204-
[add_int (add_int ptr idx dbg) (cconst_int 4) dbg], dbg) in
1227+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 4) dbg],
1228+
dbg) in
12051229
let v6 = Cop(mk_load_mut Byte_unsigned,
1206-
[add_int (add_int ptr idx dbg) (cconst_int 5) dbg], dbg) in
1230+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 5) dbg],
1231+
dbg) in
12071232
let v7 = Cop(mk_load_mut Byte_unsigned,
1208-
[add_int (add_int ptr idx dbg) (cconst_int 6) dbg], dbg) in
1233+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 6) dbg],
1234+
dbg) in
12091235
let v8 = Cop(mk_load_mut Byte_unsigned,
1210-
[add_int (add_int ptr idx dbg) (cconst_int 7) dbg], dbg) in
1236+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 7) dbg],
1237+
dbg) in
12111238
let b1, b2, b3, b4, b5, b6, b7, b8 =
12121239
if Arch.big_endian
12131240
then v1, v2, v3, v4, v5, v6, v7, v8
@@ -1228,7 +1255,8 @@ let unaligned_load_64 ptr idx dbg =
12281255

12291256
let unaligned_set_64 ptr idx newval dbg =
12301257
if Arch.allow_unaligned_access
1231-
then Cop(Cstore (Word_int, Assignment), [add_int ptr idx dbg; newval], dbg)
1258+
then
1259+
Cop(Cstore (Word_int, Assignment), [offset_addr ptr idx dbg; newval], dbg)
12321260
else
12331261
let cconst_int i = Cconst_int (i, dbg) in
12341262
let v1 =
@@ -1268,32 +1296,39 @@ let unaligned_set_64 ptr idx newval dbg =
12681296
Csequence(
12691297
Csequence(
12701298
Cop(Cstore (Byte_unsigned, Assignment),
1271-
[add_int ptr idx dbg; b1],
1299+
[offset_addr ptr idx dbg; b1],
12721300
dbg),
12731301
Cop(Cstore (Byte_unsigned, Assignment),
1274-
[add_int (add_int ptr idx dbg) (cconst_int 1) dbg; b2],
1302+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 1)
1303+
dbg; b2],
12751304
dbg)),
12761305
Csequence(
12771306
Cop(Cstore (Byte_unsigned, Assignment),
1278-
[add_int (add_int ptr idx dbg) (cconst_int 2) dbg; b3],
1307+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 2)
1308+
dbg; b3],
12791309
dbg),
12801310
Cop(Cstore (Byte_unsigned, Assignment),
1281-
[add_int (add_int ptr idx dbg) (cconst_int 3) dbg; b4],
1311+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 3)
1312+
dbg; b4],
12821313
dbg))),
12831314
Csequence(
12841315
Csequence(
12851316
Cop(Cstore (Byte_unsigned, Assignment),
1286-
[add_int (add_int ptr idx dbg) (cconst_int 4) dbg; b5],
1317+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 4)
1318+
dbg; b5],
12871319
dbg),
12881320
Cop(Cstore (Byte_unsigned, Assignment),
1289-
[add_int (add_int ptr idx dbg) (cconst_int 5) dbg; b6],
1321+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 5)
1322+
dbg; b6],
12901323
dbg)),
12911324
Csequence(
12921325
Cop(Cstore (Byte_unsigned, Assignment),
1293-
[add_int (add_int ptr idx dbg) (cconst_int 6) dbg; b7],
1326+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 6)
1327+
dbg; b7],
12941328
dbg),
12951329
Cop(Cstore (Byte_unsigned, Assignment),
1296-
[add_int (add_int ptr idx dbg) (cconst_int 7) dbg; b8],
1330+
[offset_addr (offset_addr ptr idx dbg) (cconst_int 7)
1331+
dbg; b8],
12971332
dbg))))
12981333

12991334
let max_or_zero a dbg =
@@ -2217,7 +2252,7 @@ let int_comp_caml cmp arg1 arg2 dbg =
22172252

22182253
let stringref_unsafe arg1 arg2 dbg =
22192254
tag_int(Cop(mk_load_mut Byte_unsigned,
2220-
[add_int arg1 (untag_int arg2 dbg) dbg],
2255+
[offset_addr arg1 (untag_int arg2 dbg) dbg],
22212256
dbg)) dbg
22222257

22232258
let stringref_safe arg1 arg2 dbg =
@@ -2227,7 +2262,7 @@ let stringref_safe arg1 arg2 dbg =
22272262
Csequence(
22282263
make_checkbound dbg [string_length str dbg; idx],
22292264
Cop(mk_load_mut Byte_unsigned,
2230-
[add_int str idx dbg], dbg))))) dbg
2265+
[offset_addr str idx dbg], dbg))))) dbg
22312266

22322267
let string_load size unsafe arg1 arg2 dbg =
22332268
box_sized size dbg
@@ -2335,7 +2370,7 @@ let setfield_computed ptr init arg1 arg2 arg3 dbg =
23352370

23362371
let bytesset_unsafe arg1 arg2 arg3 dbg =
23372372
return_unit dbg (Cop(Cstore (Byte_unsigned, Assignment),
2338-
[add_int arg1 (untag_int arg2 dbg) dbg;
2373+
[offset_addr arg1 (untag_int arg2 dbg) dbg;
23392374
ignore_high_bit_int (untag_int arg3 dbg)], dbg))
23402375

23412376
let bytesset_safe arg1 arg2 arg3 dbg =
@@ -2346,7 +2381,7 @@ let bytesset_safe arg1 arg2 arg3 dbg =
23462381
Csequence(
23472382
make_checkbound dbg [string_length str dbg; idx],
23482383
Cop(Cstore (Byte_unsigned, Assignment),
2349-
[add_int str idx dbg; newval],
2384+
[offset_addr str idx dbg; newval],
23502385
dbg))))))
23512386

23522387
let arrayset_unsafe kind arg1 arg2 arg3 dbg =

0 commit comments

Comments
 (0)