@@ -117,6 +117,10 @@ let drop n (vs : 'a stack) at =
117117 * c : config
118118 *)
119119
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))
123+
120124let rec step (c : config ) : config =
121125 let {frame; code = vs, es; _} = c in
122126 let e = List. hd es in
@@ -198,11 +202,13 @@ let rec step (c : config) : config =
198202 with Global. NotMutable -> Crash. error e.at " write to immutable global"
199203 | Global. Type -> Crash. error e.at " type mismatch at global write" )
200204
205+ (* TODO: turn into small-step, but needs reference values *)
201206 | TableCopy , I32 n :: I32 s :: I32 d :: vs' ->
202207 let tab = table frame.inst (0l @@ e.at) in
203208 (try Table. copy tab d s n; vs', []
204209 with exn -> vs', [Trapping (table_error e.at exn ) @@ e.at])
205210
211+ (* TODO: turn into small-step, but needs reference values *)
206212 | TableInit x , I32 n :: I32 s :: I32 d :: vs' ->
207213 let tab = table frame.inst (0l @@ e.at) in
208214 (match ! (elem frame.inst x) with
@@ -253,30 +259,97 @@ let rec step (c : config) : config =
253259 with Memory. SizeOverflow | Memory. SizeLimit | Memory. OutOfMemory -> - 1l
254260 in I32 result :: vs', []
255261
256- | MemoryFill , I32 n :: I32 b :: I32 i :: vs' ->
257- let mem = memory frame.inst (0l @@ e.at) in
258- let addr = I64_convert. extend_i32_u i in
259- (try Memory. fill mem addr (Int32. to_int b) n; vs', []
260- with exn -> vs', [Trapping (memory_error e.at exn ) @@ e.at])
262+ | MemoryFill , I32 0l :: v :: I32 i :: vs' ->
263+ vs', []
261264
262- | MemoryCopy , I32 n :: I32 s :: I32 d :: vs' ->
263- let mem = memory frame.inst (0l @@ e.at) in
264- let dst = I64_convert. extend_i32_u d in
265- let src = I64_convert. extend_i32_u s in
266- (try Memory. copy mem dst src n; vs', []
267- with exn -> vs', [Trapping (memory_error e.at exn ) @@ e.at])
265+ | MemoryFill , I32 1l :: v :: I32 i :: vs' ->
266+ vs', List. map (at e.at) [
267+ Plain (Const (I32 i @@ e.at));
268+ Plain (Const (v @@ e.at));
269+ Plain (Store
270+ {ty = I32Type ; align = 0 ; offset = 0l ; sz = Some Memory. Pack8 });
271+ ]
272+
273+ | MemoryFill , I32 n :: v :: I32 i :: vs' ->
274+ vs', List. map (at e.at) [
275+ Plain (Const (I32 i @@ e.at));
276+ Plain (Const (v @@ e.at));
277+ Plain (Const (I32 1l @@ e.at));
278+ Plain (MemoryFill );
279+ const_i32_add i 1l e.at (memory_error e.at Memory. Bounds );
280+ Plain (Const (v @@ e.at));
281+ Plain (Const (I32 (I32. sub n 1l ) @@ e.at));
282+ Plain (MemoryFill );
283+ ]
284+
285+ | MemoryCopy , I32 0l :: I32 s :: I32 d :: vs' ->
286+ vs', []
268287
269- | MemoryInit x , I32 n :: I32 s :: I32 d :: vs' ->
270- let mem = memory frame.inst (0l @@ e.at) in
288+ | MemoryCopy , I32 1l :: I32 s :: I32 d :: vs' ->
289+ vs', List. map (at e.at) [
290+ Plain (Const (I32 d @@ e.at));
291+ Plain (Const (I32 s @@ e.at));
292+ Plain (Load
293+ {ty = I32Type ; align = 0 ; offset = 0l ; sz = Some Memory. (Pack8 , ZX )});
294+ Plain (Store
295+ {ty = I32Type ; align = 0 ; offset = 0l ; sz = Some Memory. Pack8 });
296+ ]
297+
298+ | MemoryCopy , I32 n :: I32 s :: I32 d :: vs' when s > = d ->
299+ vs', List. map (at e.at) [
300+ Plain (Const (I32 d @@ e.at));
301+ Plain (Const (I32 s @@ e.at));
302+ Plain (Const (I32 1l @@ e.at));
303+ Plain (MemoryCopy );
304+ const_i32_add d 1l e.at (memory_error e.at Memory. Bounds );
305+ const_i32_add s 1l e.at (memory_error e.at Memory. Bounds );
306+ Plain (Const (I32 (I32. sub n 1l ) @@ e.at));
307+ Plain (MemoryCopy );
308+ ]
309+
310+ | MemoryCopy , I32 n :: I32 s :: I32 d :: vs' when s < d ->
311+ vs', List. map (at e.at) [
312+ const_i32_add d (I32. sub n 1l ) e.at (memory_error e.at Memory. Bounds );
313+ const_i32_add s (I32. sub n 1l ) e.at (memory_error e.at Memory. Bounds );
314+ Plain (Const (I32 1l @@ e.at));
315+ Plain (MemoryCopy );
316+ Plain (Const (I32 d @@ e.at));
317+ Plain (Const (I32 s @@ e.at));
318+ Plain (Const (I32 (I32. sub n 1l ) @@ e.at));
319+ Plain (MemoryCopy );
320+ ]
321+
322+ | MemoryInit x , I32 0l :: I32 s :: I32 d :: vs' ->
323+ vs', []
324+
325+ | MemoryInit x , I32 1l :: I32 s :: I32 d :: vs' ->
271326 (match ! (data frame.inst x) with
327+ | None ->
328+ vs', [Trapping " data segment dropped" @@ e.at]
329+ | Some bs when Int32. to_int s > = String. length bs ->
330+ vs', [Trapping " out of bounds data segment access" @@ e.at]
272331 | Some bs ->
273- let dst = I64_convert. extend_i32_u d in
274- let src = I64_convert. extend_i32_u s in
275- (try Memory. init mem bs dst src n; vs', []
276- with exn -> vs', [Trapping (memory_error e.at exn ) @@ e.at])
277- | None -> vs', [Trapping " data segment dropped" @@ e.at]
332+ let b = Int32. of_int (Char. code bs.[Int32. to_int s]) in
333+ vs', List. map (at e.at) [
334+ Plain (Const (I32 d @@ e.at));
335+ Plain (Const (I32 b @@ e.at));
336+ Plain (
337+ Store {ty = I32Type ; align = 0 ; offset = 0l ; sz = Some Memory. Pack8 });
338+ ]
278339 )
279340
341+ | MemoryInit x , I32 n :: I32 s :: I32 d :: vs' ->
342+ vs', List. map (at e.at) [
343+ Plain (Const (I32 d @@ e.at));
344+ Plain (Const (I32 s @@ e.at));
345+ Plain (Const (I32 1l @@ e.at));
346+ Plain (MemoryInit x);
347+ const_i32_add d 1l e.at (memory_error e.at Memory. Bounds );
348+ const_i32_add s 1l e.at (memory_error e.at Memory. Bounds );
349+ Plain (Const (I32 (I32. sub n 1l ) @@ e.at));
350+ Plain (MemoryInit x);
351+ ]
352+
280353 | DataDrop x , vs ->
281354 let seg = data frame.inst x in
282355 (match ! seg with
0 commit comments