Compiler: consume hints for unsafe string/bytes/ba get/set

Author: hhugo

compiler/lib-wasm/generate.ml

@@ -110,16 +110,26 @@ module Generate (Target : Target_sig.S) = struct
       ; "caml_nativeint_compare", (`Pure, [ Nativeint; Nativeint ], Value)
       ; "caml_int64_compare", (`Pure, [ Int64; Int64 ], Value)
       ; "caml_string_get32", (`Mutator, [ Value; Value ], Int32)
+      ; "caml_string_get32u", (`Mutator, [ Value; Value ], Int32)
       ; "caml_string_get64", (`Mutator, [ Value; Value ], Int64)
+      ; "caml_string_get64u", (`Mutator, [ Value; Value ], Int64)
       ; "caml_bytes_get32", (`Mutator, [ Value; Value ], Int32)
+      ; "caml_bytes_get32u", (`Mutator, [ Value; Value ], Int32)
       ; "caml_bytes_get64", (`Mutator, [ Value; Value ], Int64)
+      ; "caml_bytes_get64u", (`Mutator, [ Value; Value ], Int64)
       ; "caml_bytes_set32", (`Mutator, [ Value; Value; Int32 ], Value)
+      ; "caml_bytes_set32u", (`Mutator, [ Value; Value; Int32 ], Value)
       ; "caml_bytes_set64", (`Mutator, [ Value; Value; Int64 ], Value)
+      ; "caml_bytes_set64u", (`Mutator, [ Value; Value; Int64 ], Value)
       ; "caml_lxm_next", (`Pure, [ Value ], Int64)
       ; "caml_ba_uint8_get32", (`Mutator, [ Value; Value ], Int32)
+      ; "caml_ba_uint8_get32u", (`Mutator, [ Value; Value ], Int32)
       ; "caml_ba_uint8_get64", (`Mutator, [ Value; Value ], Int64)
+      ; "caml_ba_uint8_get64u", (`Mutator, [ Value; Value ], Int64)
       ; "caml_ba_uint8_set32", (`Mutator, [ Value; Value; Int32 ], Value)
+      ; "caml_ba_uint8_set32u", (`Mutator, [ Value; Value; Int32 ], Value)
       ; "caml_ba_uint8_set64", (`Mutator, [ Value; Value; Int64 ], Value)
+      ; "caml_ba_uint8_set64u", (`Mutator, [ Value; Value; Int64 ], Value)
       ; "caml_nextafter_float", (`Pure, [ Float; Float ], Float)
       ; "caml_classify_float", (`Pure, [ Float ], Value)
       ; "caml_ldexp_float", (`Pure, [ Float; Value ], Float)

compiler/lib/parse_bytecode.ml

@@ -1971,7 +1971,23 @@ and compile infos pc state (instrs : instr list) =
         let y = State.accu state in
         let z = State.peek 0 state in
         let x, state = State.fresh_var state in
-
+        let prim =
+          match prim with
+          | "caml_ba_uint8_get16"
+          | "caml_ba_uint8_get32"
+          | "caml_ba_uint8_get64"
+          | "caml_string_get16"
+          | "caml_string_get32"
+          | "caml_string_get64"
+          | "caml_bytes_get16"
+          | "caml_bytes_get32"
+          | "caml_bytes_get64" ->
+              let hints = Hints.find infos.hints pc in
+              if List.mem ~eq:Hints.equal Hints.Hint_unsafe hints
+              then prim ^ "u"
+              else prim
+          | _ -> prim
+        in
         if debug_parser ()
         then
           Format.printf
@@ -1994,7 +2010,20 @@ and compile infos pc state (instrs : instr list) =
         let z = State.peek 0 state in
         let t = State.peek 1 state in
         let x, state = State.fresh_var state in
-
+        let prim =
+          match prim with
+          | "caml_ba_uint8_set16"
+          | "caml_ba_uint8_set32"
+          | "caml_ba_uint8_set64"
+          | "caml_bytes_set16"
+          | "caml_bytes_set32"
+          | "caml_bytes_set64" ->
+              let hints = Hints.find infos.hints pc in
+              if List.mem ~eq:Hints.equal Hints.Hint_unsafe hints
+              then prim ^ "u"
+              else prim
+          | _ -> prim
+        in
         if debug_parser ()
         then
           Format.printf

compiler/tests-full/stdlib.cma.expected.js

@@ -4817,11 +4817,13 @@
     caml_bswap16 = runtime.caml_bswap16,
     caml_bytes_get = runtime.caml_bytes_get,
     caml_bytes_get16 = runtime.caml_bytes_get16,
+    caml_bytes_get16u = runtime.caml_bytes_get16u,
     caml_bytes_get32 = runtime.caml_bytes_get32,
     caml_bytes_get64 = runtime.caml_bytes_get64,
     caml_bytes_of_string = runtime.caml_bytes_of_string,
     caml_bytes_set = runtime.caml_bytes_set,
     caml_bytes_set16 = runtime.caml_bytes_set16,
+    caml_bytes_set16u = runtime.caml_bytes_set16u,
     caml_bytes_set32 = runtime.caml_bytes_set32,
     caml_bytes_set64 = runtime.caml_bytes_set64,
     caml_bytes_unsafe_get = runtime.caml_bytes_unsafe_get,
@@ -5607,14 +5609,14 @@
    function unsafe_get_uint16_le(b, i){
      /*<<bytes.ml:470:2>>*/ return Stdlib_Sys[11]
             ?  /*<<bytes.ml:471:40>>*/ caml_bswap16
-              ( /*<<bytes.ml:471:14>>*/ caml_bytes_get16(b, i))
-            :  /*<<bytes.ml:472:7>>*/ caml_bytes_get16(b, i) /*<<bytes.ml:472:31>>*/ ;
+              ( /*<<bytes.ml:471:14>>*/ caml_bytes_get16u(b, i))
+            :  /*<<bytes.ml:472:7>>*/ caml_bytes_get16u(b, i) /*<<bytes.ml:472:31>>*/ ;
    }
    function unsafe_get_uint16_be(b, i){
      /*<<bytes.ml:475:2>>*/ return Stdlib_Sys[11]
-            ?  /*<<bytes.ml:476:7>>*/ caml_bytes_get16(b, i)
+            ?  /*<<bytes.ml:476:7>>*/ caml_bytes_get16u(b, i)
             :  /*<<bytes.ml:477:40>>*/ caml_bswap16
-              ( /*<<bytes.ml:477:14>>*/ caml_bytes_get16(b, i)) /*<<bytes.ml:477:40>>*/ ;
+              ( /*<<bytes.ml:477:14>>*/ caml_bytes_get16u(b, i)) /*<<bytes.ml:477:40>>*/ ;
    }
    function get_int8(b, i){
     var
@@ -5678,17 +5680,17 @@
    }
    function unsafe_set_uint16_le(b, i, x){
      /*<<bytes.ml:516:2>>*/ if(Stdlib_Sys[11]){
-      /*<<bytes.ml:517:7>>*/ caml_bytes_set16(b, i, caml_bswap16(x));
+      /*<<bytes.ml:517:7>>*/ caml_bytes_set16u(b, i, caml_bswap16(x));
       /*<<bytes.ml:517:42>>*/ return;
     }
-     /*<<bytes.ml:518:7>>*/ caml_bytes_set16(b, i, x);
+     /*<<bytes.ml:518:7>>*/ caml_bytes_set16u(b, i, x);
     /*<<bytes.ml:518:33>>*/ }
    function unsafe_set_uint16_be(b, i, x){
      /*<<bytes.ml:521:2>>*/ if(Stdlib_Sys[11]){
-      /*<<bytes.ml:522:7>>*/ caml_bytes_set16(b, i, x);
+      /*<<bytes.ml:522:7>>*/ caml_bytes_set16u(b, i, x);
       /*<<bytes.ml:522:33>>*/ return;
     }
-     /*<<bytes.ml:523:2>>*/ caml_bytes_set16(b, i, caml_bswap16(x));
+     /*<<bytes.ml:523:2>>*/ caml_bytes_set16u(b, i, caml_bswap16(x));
     /*<<bytes.ml:523:37>>*/ }
    function set_int16_le(b, i, x){
      /*<<bytes.ml:526:2>>*/ return Stdlib_Sys[11]
@@ -12456,9 +12458,6 @@
     caml_bswap16 = runtime.caml_bswap16,
     caml_bytes_get = runtime.caml_bytes_get,
     caml_bytes_set = runtime.caml_bytes_set,
-    caml_bytes_set16 = runtime.caml_bytes_set16,
-    caml_bytes_set32 = runtime.caml_bytes_set32,
-    caml_bytes_set64 = runtime.caml_bytes_set64,
     caml_bytes_unsafe_set = runtime.caml_bytes_unsafe_set,
     caml_create_bytes = runtime.caml_create_bytes,
     caml_int32_bswap = runtime.caml_int32_bswap,
@@ -12945,10 +12944,10 @@
      new_position =  /*<<buffer.ml:353:2>>*/ position + 2 | 0;
      /*<<buffer.ml:354:2>>*/ if(length < new_position){
       /*<<buffer.ml:355:4>>*/ resize(b, 2);
-      /*<<buffer.ml:356:4>>*/ caml_bytes_set16(b[1][1], b[2], x);
+      /*<<buffer.ml:356:4>>*/ runtime.caml_bytes_set16(b[1][1], b[2], x);
     }
     else
-      /*<<buffer.ml:358:4>>*/ caml_bytes_set16(buffer, position, x);
+      /*<<buffer.ml:358:4>>*/ runtime.caml_bytes_set16u(buffer, position, x);
      /*<<buffer.ml:359:2>>*/ b[2] = new_position;
     return 0;
     /*<<buffer.ml:359:28>>*/ }
@@ -12961,10 +12960,10 @@
      new_position =  /*<<buffer.ml:364:2>>*/ position + 4 | 0;
      /*<<buffer.ml:365:2>>*/ if(length < new_position){
       /*<<buffer.ml:366:4>>*/ resize(b, 4);
-      /*<<buffer.ml:367:4>>*/ caml_bytes_set32(b[1][1], b[2], x);
+      /*<<buffer.ml:367:4>>*/ runtime.caml_bytes_set32(b[1][1], b[2], x);
     }
     else
-      /*<<buffer.ml:369:4>>*/ caml_bytes_set32(buffer, position, x);
+      /*<<buffer.ml:369:4>>*/ runtime.caml_bytes_set32u(buffer, position, x);
      /*<<buffer.ml:370:2>>*/ b[2] = new_position;
     return 0;
     /*<<buffer.ml:370:28>>*/ }
@@ -12977,10 +12976,10 @@
      new_position =  /*<<buffer.ml:375:2>>*/ position + 8 | 0;
      /*<<buffer.ml:376:2>>*/ if(length < new_position){
       /*<<buffer.ml:377:4>>*/ resize(b, 8);
-      /*<<buffer.ml:378:4>>*/ caml_bytes_set64(b[1][1], b[2], x);
+      /*<<buffer.ml:378:4>>*/ runtime.caml_bytes_set64(b[1][1], b[2], x);
     }
     else
-      /*<<buffer.ml:380:4>>*/ caml_bytes_set64(buffer, position, x);
+      /*<<buffer.ml:380:4>>*/ runtime.caml_bytes_set64u(buffer, position, x);
      /*<<buffer.ml:381:2>>*/ b[2] = new_position;
     return 0;
     /*<<buffer.ml:381:28>>*/ }

runtime/js/bigarray.js

@@ -548,6 +548,14 @@ function caml_ba_get_generic(ba, i) {
   return ba.get(ofs);
 }
 
+
+//Provides: caml_ba_uint8_get16u
+function caml_ba_uint8_get16u(ba, i0) {
+  var ofs = ba.offset(i0);
+  var b1 = ba.get(ofs);
+  var b2 = ba.get(ofs + 1);
+  return b1 | (b2 << 8);
+}
 //Provides: caml_ba_uint8_get16
 //Requires: caml_array_bound_error
 function caml_ba_uint8_get16(ba, i0) {
@@ -558,6 +566,16 @@ function caml_ba_uint8_get16(ba, i0) {
   return b1 | (b2 << 8);
 }
 
+//Provides: caml_ba_uint8_get32u
+function caml_ba_uint8_get32u(ba, i0) {
+  var ofs = ba.offset(i0);
+  var b1 = ba.get(ofs + 0);
+  var b2 = ba.get(ofs + 1);
+  var b3 = ba.get(ofs + 2);
+  var b4 = ba.get(ofs + 3);
+  return (b1 << 0) | (b2 << 8) | (b3 << 16) | (b4 << 24);
+}
+
 //Provides: caml_ba_uint8_get32
 //Requires: caml_array_bound_error
 function caml_ba_uint8_get32(ba, i0) {
@@ -570,6 +588,21 @@ function caml_ba_uint8_get32(ba, i0) {
   return (b1 << 0) | (b2 << 8) | (b3 << 16) | (b4 << 24);
 }
 
+//Provides: caml_ba_uint8_get64u
+//Requires: caml_int64_of_bytes
+function caml_ba_uint8_get64u(ba, i0) {
+  var ofs = ba.offset(i0);
+  var b1 = ba.get(ofs + 0);
+  var b2 = ba.get(ofs + 1);
+  var b3 = ba.get(ofs + 2);
+  var b4 = ba.get(ofs + 3);
+  var b5 = ba.get(ofs + 4);
+  var b6 = ba.get(ofs + 5);
+  var b7 = ba.get(ofs + 6);
+  var b8 = ba.get(ofs + 7);
+  return caml_int64_of_bytes([b8, b7, b6, b5, b4, b3, b2, b1]);
+}
+
 //Provides: caml_ba_uint8_get64
 //Requires: caml_array_bound_error, caml_int64_of_bytes
 function caml_ba_uint8_get64(ba, i0) {
@@ -608,6 +641,14 @@ function caml_ba_set_generic(ba, i, v) {
   return 0;
 }
 
+//Provides: caml_ba_uint8_set16u
+function caml_ba_uint8_set16u(ba, i0, v) {
+  var ofs = ba.offset(i0);
+  ba.set(ofs + 0, v & 0xff);
+  ba.set(ofs + 1, (v >>> 8) & 0xff);
+  return 0;
+}
+
 //Provides: caml_ba_uint8_set16
 //Requires: caml_array_bound_error
 function caml_ba_uint8_set16(ba, i0, v) {
@@ -618,6 +659,15 @@ function caml_ba_uint8_set16(ba, i0, v) {
   return 0;
 }
 
+//Provides: caml_ba_uint8_set32u
+function caml_ba_uint8_set32u(ba, i0, v) {
+  var ofs = ba.offset(i0);
+  ba.set(ofs + 0, v & 0xff);
+  ba.set(ofs + 1, (v >>> 8) & 0xff);
+  ba.set(ofs + 2, (v >>> 16) & 0xff);
+  ba.set(ofs + 3, (v >>> 24) & 0xff);
+  return 0;
+}
 //Provides: caml_ba_uint8_set32
 //Requires: caml_array_bound_error
 function caml_ba_uint8_set32(ba, i0, v) {
@@ -630,6 +680,15 @@ function caml_ba_uint8_set32(ba, i0, v) {
   return 0;
 }
 
+//Provides: caml_ba_uint8_set64u
+//Requires: caml_int64_to_bytes
+function caml_ba_uint8_set64u(ba, i0, v) {
+  var ofs = ba.offset(i0);
+  var v = caml_int64_to_bytes(v);
+  for (var i = 0; i < 8; i++) ba.set(ofs + i, v[7 - i]);
+  return 0;
+}
+
 //Provides: caml_ba_uint8_set64
 //Requires: caml_array_bound_error, caml_int64_to_bytes
 function caml_ba_uint8_set64(ba, i0, v) {