PR#5986 continued: check string and array lengths if Compat_32 requested.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13724 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 16 insertions, 0 deletions

diff --git a/byterun/extern.c b/byterun/extern.c
index 61ad352a90..1e2789b864 100644
--- a/byterun/extern.c
+++ b/byterun/extern.c
@@ -435,6 +435,11 @@ static void extern_rec(value v)
       } else if (len < 0x100) {
         writecode8(CODE_STRING8, len);
       } else {
+#ifdef ARCH_SIXTYFOUR
+        if (len > 0xFFFFFB && (extern_flags & COMPAT_32))
+          extern_failwith("output_value: string cannot be read back on "
+                          "32-bit platform");
+#endif
         writecode32(CODE_STRING32, len);
       }
       writeblock(String_val(v), len);
@@ -461,6 +466,11 @@ static void extern_rec(value v)
       if (nfloats < 0x100) {
         writecode8(CODE_DOUBLE_ARRAY8_NATIVE, nfloats);
       } else {
+#ifdef ARCH_SIXTYFOUR
+        if (nfloats > 0x1FFFFF && (extern_flags & COMPAT_32))
+          extern_failwith("output_value: float array cannot be read back on "
+                          "32-bit platform");
+#endif
         writecode32(CODE_DOUBLE_ARRAY32_NATIVE, nfloats);
       }
       writeblock_float8((double *) v, nfloats);
@@ -498,9 +508,15 @@ static void extern_rec(value v)
         Write(PREFIX_SMALL_BLOCK + tag + (sz << 4));
 #ifdef ARCH_SIXTYFOUR
       } else if (hd >= ((uintnat)1 << 32)) {
+        /* Is this case useful?  The overflow check in extern_value will fail.*/
         writecode64(CODE_BLOCK64, Whitehd_hd (hd));
 #endif
       } else {
+#ifdef ARCH_SIXTYFOUR
+        if (sz > 0x3FFFFF && (extern_flags & COMPAT_32))
+          extern_failwith("output_value: array cannot be read back on "
+                          "32-bit platform");
+#endif
         writecode32(CODE_BLOCK32, Whitehd_hd (hd));
       }
       size_32 += 1 + sz;