@@ -117,9 +117,27 @@ let drop n (vs : 'a stack) at =
117
117
* c : config
118
118
*)
119
119
120
- let const_i32_add i j at msg =
121
- let k = I32. add i j in
122
- if I32. lt_u k i then Trapping msg else Plain (Const (I32 k @@ at))
120
+ let mem_oob frame x i n =
121
+ I64. gt_u (I64. add (I64_convert. extend_i32_u i) (I64_convert. extend_i32_u n))
122
+ (Memory. bound (memory frame.inst x))
123
+
124
+ let data_oob frame x i n =
125
+ match ! (data frame.inst x) with
126
+ | None -> false
127
+ | Some bs ->
128
+ I64. gt_u (I64. add (I64_convert. extend_i32_u i) (I64_convert. extend_i32_u n))
129
+ (I64. of_int_u (String. length bs))
130
+
131
+ let table_oob frame x i n =
132
+ I64. gt_u (I64. add (I64_convert. extend_i32_u i) (I64_convert. extend_i32_u n))
133
+ (I64_convert. extend_i32_u (Table. size (table frame.inst x)))
134
+
135
+ let elem_oob frame x i n =
136
+ match ! (elem frame.inst x) with
137
+ | None -> false
138
+ | Some es ->
139
+ I64. gt_u (I64. add (I64_convert. extend_i32_u i) (I64_convert. extend_i32_u n))
140
+ (I64. of_int_u (List. length es))
123
141
124
142
let rec step (c : config ) : config =
125
143
let {frame; code = vs, es; _} = c in
@@ -205,6 +223,10 @@ let rec step (c : config) : config =
205
223
| TableCopy , I32 0l :: I32 s :: I32 d :: vs' ->
206
224
vs', []
207
225
226
+ | TableCopy , I32 n :: I32 s :: I32 d :: vs'
227
+ when table_oob frame (0l @@ e.at) s n || table_oob frame (0l @@ e.at) d n ->
228
+ vs', [Trapping (table_error e.at Table. Bounds ) @@ e.at]
229
+
208
230
(* TODO: turn into small-step, but needs reference values *)
209
231
| TableCopy , I32 n :: I32 s :: I32 d :: vs' ->
210
232
let tab = table frame.inst (0l @@ e.at) in
@@ -214,6 +236,10 @@ let rec step (c : config) : config =
214
236
| TableInit x , I32 0l :: I32 s :: I32 d :: vs' ->
215
237
vs', []
216
238
239
+ | TableInit x, I32 n :: I32 s :: I32 d :: vs'
240
+ when table_oob frame (0l @@ e.at) d n || elem_oob frame x s n ->
241
+ vs', [Trapping (table_error e.at Table. Bounds ) @@ e.at]
242
+
217
243
(* TODO: turn into small-step, but needs reference values *)
218
244
| TableInit x , I32 n :: I32 s :: I32 d :: vs' ->
219
245
let tab = table frame.inst (0l @@ e.at) in
@@ -233,22 +259,22 @@ let rec step (c : config) : config =
233
259
234
260
| Load {offset; ty; sz; _} , I32 i :: vs' ->
235
261
let mem = memory frame.inst (0l @@ e.at) in
236
- let addr = I64_convert. extend_i32_u i in
262
+ let a = I64_convert. extend_i32_u i in
237
263
(try
238
264
let v =
239
265
match sz with
240
- | None -> Memory. load_value mem addr offset ty
241
- | Some (sz , ext ) -> Memory. load_packed sz ext mem addr offset ty
266
+ | None -> Memory. load_value mem a offset ty
267
+ | Some (sz , ext ) -> Memory. load_packed sz ext mem a offset ty
242
268
in v :: vs', []
243
269
with exn -> vs', [Trapping (memory_error e.at exn ) @@ e.at])
244
270
245
271
| Store {offset; sz; _} , v :: I32 i :: vs' ->
246
272
let mem = memory frame.inst (0l @@ e.at) in
247
- let addr = I64_convert. extend_i32_u i in
273
+ let a = I64_convert. extend_i32_u i in
248
274
(try
249
275
(match sz with
250
- | None -> Memory. store_value mem addr offset v
251
- | Some sz -> Memory. store_packed sz mem addr offset v
276
+ | None -> Memory. store_value mem a offset v
277
+ | Some sz -> Memory. store_packed sz mem a offset v
252
278
);
253
279
vs', []
254
280
with exn -> vs', [Trapping (memory_error e.at exn ) @@ e.at]);
@@ -268,21 +294,17 @@ let rec step (c : config) : config =
268
294
| MemoryFill , I32 0l :: v :: I32 i :: vs' ->
269
295
vs', []
270
296
271
- | MemoryFill , I32 1l :: v :: I32 i :: vs' ->
272
- vs', List. map (at e.at) [
273
- Plain (Const (I32 i @@ e.at));
274
- Plain (Const (v @@ e.at));
275
- Plain (Store
276
- {ty = I32Type ; align = 0 ; offset = 0l ; sz = Some Memory. Pack8 });
277
- ]
297
+ | MemoryFill , I32 n :: v :: I32 i :: vs'
298
+ when mem_oob frame (0l @@ e.at) i n ->
299
+ vs', [Trapping (memory_error e.at Memory. Bounds ) @@ e.at]
278
300
279
301
| MemoryFill , I32 n :: v :: I32 i :: vs' ->
280
302
vs', List. map (at e.at) [
281
303
Plain (Const (I32 i @@ e.at));
282
304
Plain (Const (v @@ e.at));
283
- Plain (Const ( I32 1l @@ e.at));
284
- Plain ( MemoryFill );
285
- const_i32_add i 1l e.at (memory_error e.at Memory. Bounds );
305
+ Plain (Store
306
+ {ty = I32Type ; align = 0 ; offset = 0l ; sz = Some Memory. Pack8 } );
307
+ Plain ( Const ( I32 ( I32. add i 1l ) @@ e.at) );
286
308
Plain (Const (v @@ e.at));
287
309
Plain (Const (I32 (I32. sub n 1l ) @@ e.at));
288
310
Plain (MemoryFill );
@@ -291,71 +313,63 @@ let rec step (c : config) : config =
291
313
| MemoryCopy , I32 0l :: I32 s :: I32 d :: vs' ->
292
314
vs', []
293
315
294
- | MemoryCopy , I32 1l :: I32 s :: I32 d :: vs' ->
316
+ | MemoryCopy , I32 n :: I32 s :: I32 d :: vs'
317
+ when mem_oob frame (0l @@ e.at) s n || mem_oob frame (0l @@ e.at) d n ->
318
+ vs', [Trapping (memory_error e.at Memory. Bounds ) @@ e.at]
319
+
320
+ | MemoryCopy , I32 n :: I32 s :: I32 d :: vs' when d < = s ->
295
321
vs', List. map (at e.at) [
296
322
Plain (Const (I32 d @@ e.at));
297
323
Plain (Const (I32 s @@ e.at));
298
324
Plain (Load
299
325
{ty = I32Type ; align = 0 ; offset = 0l ; sz = Some Memory. (Pack8 , ZX )});
300
326
Plain (Store
301
327
{ty = I32Type ; align = 0 ; offset = 0l ; sz = Some Memory. Pack8 });
302
- ]
303
-
304
- | MemoryCopy , I32 n :: I32 s :: I32 d :: vs' when d < = s ->
305
- vs', List. map (at e.at) [
306
- Plain (Const (I32 d @@ e.at));
307
- Plain (Const (I32 s @@ e.at));
308
- Plain (Const (I32 1l @@ e.at));
309
- Plain (MemoryCopy );
310
- const_i32_add d 1l e.at (memory_error e.at Memory. Bounds );
311
- const_i32_add s 1l e.at (memory_error e.at Memory. Bounds );
328
+ Plain (Const (I32 (I32. add d 1l ) @@ e.at));
329
+ Plain (Const (I32 (I32. add s 1l ) @@ e.at));
312
330
Plain (Const (I32 (I32. sub n 1l ) @@ e.at));
313
331
Plain (MemoryCopy );
314
332
]
315
333
316
334
| MemoryCopy , I32 n :: I32 s :: I32 d :: vs' when s < d ->
317
335
vs', List. map (at e.at) [
318
- const_i32_add d (I32. sub n 1l ) e.at (memory_error e.at Memory. Bounds );
319
- const_i32_add s (I32. sub n 1l ) e.at (memory_error e.at Memory. Bounds );
320
- Plain (Const (I32 1l @@ e.at));
336
+ Plain ( Const (I32 ( I32. add d 1l ) @@ e.at) );
337
+ Plain ( Const (I32 ( I32. add s 1l ) @@ e.at) );
338
+ Plain (Const (I32 ( I32. sub n 1l ) @@ e.at));
321
339
Plain (MemoryCopy );
322
340
Plain (Const (I32 d @@ e.at));
323
341
Plain (Const (I32 s @@ e.at));
324
- Plain (Const (I32 (I32. sub n 1l ) @@ e.at));
325
- Plain (MemoryCopy );
342
+ Plain (Load
343
+ {ty = I32Type ; align = 0 ; offset = 0l ; sz = Some Memory. (Pack8 , ZX )});
344
+ Plain (Store
345
+ {ty = I32Type ; align = 0 ; offset = 0l ; sz = Some Memory. Pack8 });
326
346
]
327
347
328
348
| MemoryInit x , I32 0l :: I32 s :: I32 d :: vs' ->
329
349
vs', []
330
350
331
- | MemoryInit x , I32 1l :: I32 s :: I32 d :: vs' ->
351
+ | MemoryInit x, I32 n :: I32 s :: I32 d :: vs'
352
+ when mem_oob frame (0l @@ e.at) d n || data_oob frame x s n ->
353
+ vs', [Trapping (memory_error e.at Memory. Bounds ) @@ e.at]
354
+
355
+ | MemoryInit x , I32 n :: I32 s :: I32 d :: vs' ->
332
356
(match ! (data frame.inst x) with
333
357
| None ->
334
358
vs', [Trapping " data segment dropped" @@ e.at]
335
- | Some bs when Int32. to_int s > = String. length bs ->
336
- vs', [Trapping " out of bounds data segment access" @@ e.at]
337
359
| Some bs ->
338
360
let b = Int32. of_int (Char. code bs.[Int32. to_int s]) in
339
361
vs', List. map (at e.at) [
340
362
Plain (Const (I32 d @@ e.at));
341
363
Plain (Const (I32 b @@ e.at));
342
364
Plain (
343
365
Store {ty = I32Type ; align = 0 ; offset = 0l ; sz = Some Memory. Pack8 });
366
+ Plain (Const (I32 (I32. add d 1l ) @@ e.at));
367
+ Plain (Const (I32 (I32. add s 1l ) @@ e.at));
368
+ Plain (Const (I32 (I32. sub n 1l ) @@ e.at));
369
+ Plain (MemoryInit x);
344
370
]
345
371
)
346
372
347
- | MemoryInit x , I32 n :: I32 s :: I32 d :: vs' ->
348
- vs', List. map (at e.at) [
349
- Plain (Const (I32 d @@ e.at));
350
- Plain (Const (I32 s @@ e.at));
351
- Plain (Const (I32 1l @@ e.at));
352
- Plain (MemoryInit x);
353
- const_i32_add d 1l e.at (memory_error e.at Memory. Bounds );
354
- const_i32_add s 1l e.at (memory_error e.at Memory. Bounds );
355
- Plain (Const (I32 (I32. sub n 1l ) @@ e.at));
356
- Plain (MemoryInit x);
357
- ]
358
-
359
373
| DataDrop x , vs ->
360
374
let seg = data frame.inst x in
361
375
(match ! seg with
0 commit comments