2016-02-18 07:11:59 -08:00
|
|
|
/**************************************************************************/
|
|
|
|
/* */
|
|
|
|
/* OCaml */
|
|
|
|
/* */
|
|
|
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
|
|
|
/* */
|
|
|
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
|
|
|
/* en Automatique. */
|
|
|
|
/* */
|
|
|
|
/* All rights reserved. This file is distributed under the terms of */
|
|
|
|
/* the GNU Lesser General Public License version 2.1, with the */
|
|
|
|
/* special exception on linking described in the file LICENSE. */
|
|
|
|
/* */
|
|
|
|
/**************************************************************************/
|
1995-08-09 08:06:35 -07:00
|
|
|
|
2016-07-04 10:00:57 -07:00
|
|
|
#define CAML_INTERNALS
|
|
|
|
|
1995-05-04 03:15:53 -07:00
|
|
|
/* Operations on strings */
|
|
|
|
|
|
|
|
#include <string.h>
|
1999-05-15 08:08:11 -07:00
|
|
|
#include <ctype.h>
|
2014-04-15 10:09:13 -07:00
|
|
|
#include <stdio.h>
|
|
|
|
#include <stdarg.h>
|
2014-12-27 06:41:49 -08:00
|
|
|
#include "caml/alloc.h"
|
|
|
|
#include "caml/fail.h"
|
2017-02-16 10:57:09 -08:00
|
|
|
#include "caml/memory.h"
|
2014-12-27 06:41:49 -08:00
|
|
|
#include "caml/mlvalues.h"
|
|
|
|
#include "caml/misc.h"
|
1995-05-04 03:15:53 -07:00
|
|
|
|
2014-12-12 07:18:04 -08:00
|
|
|
/* returns a number of bytes (chars) */
|
2003-12-16 10:09:44 -08:00
|
|
|
CAMLexport mlsize_t caml_string_length(value s)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
|
|
|
mlsize_t temp;
|
|
|
|
temp = Bosize_val(s) - 1;
|
2017-03-10 08:29:21 -08:00
|
|
|
CAMLassert (Byte (s, temp - Byte (s, temp)) == 0);
|
1995-05-04 03:15:53 -07:00
|
|
|
return temp - Byte (s, temp);
|
|
|
|
}
|
|
|
|
|
2014-12-12 07:18:04 -08:00
|
|
|
/* returns a value that represents a number of bytes (chars) */
|
2003-12-16 10:09:44 -08:00
|
|
|
CAMLprim value caml_ml_string_length(value s)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
|
|
|
mlsize_t temp;
|
|
|
|
temp = Bosize_val(s) - 1;
|
2017-03-10 08:29:21 -08:00
|
|
|
CAMLassert (Byte (s, temp - Byte (s, temp)) == 0);
|
1995-05-04 03:15:53 -07:00
|
|
|
return Val_long(temp - Byte (s, temp));
|
|
|
|
}
|
|
|
|
|
2016-08-07 07:51:35 -07:00
|
|
|
CAMLprim value caml_ml_bytes_length(value s)
|
|
|
|
{
|
|
|
|
return caml_ml_string_length(s);
|
|
|
|
}
|
|
|
|
|
2015-11-11 08:07:44 -08:00
|
|
|
CAMLexport int caml_string_is_c_safe (value s)
|
|
|
|
{
|
|
|
|
return strlen(String_val(s)) == caml_string_length(s);
|
|
|
|
}
|
|
|
|
|
2016-08-07 07:51:35 -07:00
|
|
|
/**
|
2016-08-08 08:02:19 -07:00
|
|
|
* [caml_create_string] is deprecated,
|
2016-08-07 07:51:35 -07:00
|
|
|
* use [caml_create_bytes] instead
|
|
|
|
*/
|
2003-12-16 10:09:44 -08:00
|
|
|
CAMLprim value caml_create_string(value len)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
|
|
|
mlsize_t size = Long_val(len);
|
2004-01-01 08:42:43 -08:00
|
|
|
if (size > Bsize_wsize (Max_wosize) - 1){
|
|
|
|
caml_invalid_argument("String.create");
|
|
|
|
}
|
2003-12-29 14:15:02 -08:00
|
|
|
return caml_alloc_string(size);
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
|
2016-08-07 07:51:35 -07:00
|
|
|
/* [len] is a value that represents a number of bytes (chars) */
|
|
|
|
CAMLprim value caml_create_bytes(value len)
|
|
|
|
{
|
|
|
|
mlsize_t size = Long_val(len);
|
|
|
|
if (size > Bsize_wsize (Max_wosize) - 1){
|
|
|
|
caml_invalid_argument("Bytes.create");
|
|
|
|
}
|
|
|
|
return caml_alloc_string(size);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
2003-12-16 10:09:44 -08:00
|
|
|
CAMLprim value caml_string_get(value str, value index)
|
1995-06-15 01:09:30 -07:00
|
|
|
{
|
2005-09-22 07:21:50 -07:00
|
|
|
intnat idx = Long_val(index);
|
2004-01-02 11:23:29 -08:00
|
|
|
if (idx < 0 || idx >= caml_string_length(str)) caml_array_bound_error();
|
1995-06-15 01:09:30 -07:00
|
|
|
return Val_int(Byte_u(str, idx));
|
|
|
|
}
|
|
|
|
|
2016-08-07 07:51:35 -07:00
|
|
|
CAMLprim value caml_bytes_get(value str, value index)
|
|
|
|
{
|
|
|
|
return caml_string_get(str, index);
|
|
|
|
}
|
2016-08-08 08:02:19 -07:00
|
|
|
|
|
|
|
CAMLprim value caml_bytes_set(value str, value index, value newval)
|
1995-06-15 01:09:30 -07:00
|
|
|
{
|
2005-09-22 07:21:50 -07:00
|
|
|
intnat idx = Long_val(index);
|
2004-01-02 11:23:29 -08:00
|
|
|
if (idx < 0 || idx >= caml_string_length(str)) caml_array_bound_error();
|
1995-06-15 01:09:30 -07:00
|
|
|
Byte_u(str, idx) = Int_val(newval);
|
|
|
|
return Val_unit;
|
|
|
|
}
|
|
|
|
|
2016-08-08 08:02:19 -07:00
|
|
|
/**
|
|
|
|
* [caml_string_set] is deprecated,
|
|
|
|
* use [caml_bytes_set] instead
|
|
|
|
*/
|
|
|
|
CAMLprim value caml_string_set(value str, value index, value newval)
|
2016-08-07 07:51:35 -07:00
|
|
|
{
|
2016-08-09 03:30:27 -07:00
|
|
|
return caml_bytes_set(str,index,newval);
|
2016-08-07 07:51:35 -07:00
|
|
|
}
|
|
|
|
|
|
|
|
|
2012-11-09 08:15:29 -08:00
|
|
|
CAMLprim value caml_string_get16(value str, value index)
|
|
|
|
{
|
2012-12-19 08:22:30 -08:00
|
|
|
intnat res;
|
|
|
|
unsigned char b1, b2;
|
2012-11-09 08:15:29 -08:00
|
|
|
intnat idx = Long_val(index);
|
bound checking bug with caml_string_{get,set}{16,32,64}: fix the runtime C code
As notified by Nicolas Trangez, the following program behaves in an
unexpected way by returning 0 instead of failing with an out-of-bound
exception:
external get16 : string -> int -> int = "%caml_string_get16"
let test = get16 "" 0
caml_string_get16(str, idx) will access indices (idx) and (idx+1). The
bound-checking code is currently implemented as:
if (idx < 0 || idx >= caml_string_length(str) - 1) caml_array_bound_error();
This is wrong as caml_string_length returns an mlsize_t which is
unsigned, so substracting 1 gets buggy when the size is 0. The test
should be written as follow:
if (idx < 0 || idx + 1 >= caml_string_length(str)) caml_array_bound_error();
Note 1: we can exploit this bug to make out-of-bound access to
a string, but I think get16 examples will run into the padding
characters of OCaml strings and behave in a not-too-wrong way. It may
also be the case of get32, but get64 will access 7 bytes, so access
memory outside the string:
# external set64: string -> int -> int -> unit = "%caml_string_get64";;
external set64 : string -> int -> int -> unit = "%caml_string_get64"
# set64 "" 0 0;;
Segmentation fault
Note 2: this first commit only fixes the C code in byterun/str.c. Only
ocamlc actually uses these functions when the compiler primitive is
used ("%caml_string_get16" instead of "caml_string_get16"). ocamlopt
generates ocaml code directly, and this part has yet to be fixed in
a following commit.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14267 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2013-11-05 03:09:29 -08:00
|
|
|
if (idx < 0 || idx + 1 >= caml_string_length(str)) caml_array_bound_error();
|
2012-12-19 08:22:30 -08:00
|
|
|
b1 = Byte_u(str, idx);
|
|
|
|
b2 = Byte_u(str, idx + 1);
|
2012-11-09 08:15:29 -08:00
|
|
|
#ifdef ARCH_BIG_ENDIAN
|
|
|
|
res = b1 << 8 | b2;
|
|
|
|
#else
|
|
|
|
res = b2 << 8 | b1;
|
|
|
|
#endif
|
|
|
|
return Val_int(res);
|
|
|
|
}
|
|
|
|
|
2018-02-16 23:48:58 -08:00
|
|
|
CAMLprim value caml_bytes_get16(value str, value index)
|
|
|
|
{
|
|
|
|
return caml_string_get16(str,index);
|
|
|
|
}
|
|
|
|
|
2012-11-09 08:15:29 -08:00
|
|
|
CAMLprim value caml_string_get32(value str, value index)
|
|
|
|
{
|
Cleaning up the C code (#1812)
Running Clang 6.0 and GCC 8 with full warnings on suggests a few simple improvements and clean-ups to the C code of OCaml. This commit implements them.
* Remove old-style, unprototyped function declarations
It's `int f(void)`, not `int f()`. [-Wstrict-prototypes]
* Be more explicit about conversions involving `float` and `double`
byterun/bigarray.c, byterun/ints.c:
add explicit casts to clarify the intent
renamed float field of conversion union from `d` to `f`.
byterun/compact.c, byterun/gc_ctrl.c:
some local variables were of type `float` while all FP computations
here are done in double precision;
turned these variables into `double`.
[-Wdouble-promotion -Wfloat-conversion]
*Add explicit initialization of struct field `compare_ext`
[-Wmissing-field-initializers]
* Declare more functions "noreturn"
[-Wmissing-noreturn]
* Make CAMLassert compliant with ISO C
In `e1 ? e2 : e3`, expressions `e2` and `e3` must have the same type.
`e2` of type `void` and `e3` of type `int`, as in the original code,
is a GNU extension.
* Remove or conditionalize unused macros
Some macros were defined and never used.
Some other macros were always defined but conditionally used.
[-Wunused-macros]
* Replace some uses of `int` by more appropriate types like `intnat`
On a 64-bit platform, `int` is only 32 bits and may not represent correctly
the length of a string or the size of an OCaml heap block.
This commit replaces a number of uses of `int` by other types that
are 64-bit wide on 64-bit architectures, such as `intnat` or `uintnat`
or `size_t` or `mlsize_t`.
Sometimes an `intnat` was used as an `int` and is intended as a Boolean
(0 or 1); then it was replaced by an `int`.
There are many remaining cases where we assign a 64-bit quantity to a
32-bit `int` variable. Either I believe these cases are safe
(e.g. the 64-bit quantity is the difference between two pointers
within an I/O buffer, something that always fits in 32 bits), or
the code change was not obvious and too risky.
[-Wshorten-64-to-32]
* Put `inline` before return type
`static inline void f(void)` is cleaner than `static void inline f(void)`.
[-Wold-style-declaration]
* Unused assignment to unused parameter
Looks very useless. [-Wunused-but-set-parameter]
2018-06-07 03:55:09 -07:00
|
|
|
int32_t res;
|
2012-12-19 08:22:30 -08:00
|
|
|
unsigned char b1, b2, b3, b4;
|
2012-11-09 08:15:29 -08:00
|
|
|
intnat idx = Long_val(index);
|
bound checking bug with caml_string_{get,set}{16,32,64}: fix the runtime C code
As notified by Nicolas Trangez, the following program behaves in an
unexpected way by returning 0 instead of failing with an out-of-bound
exception:
external get16 : string -> int -> int = "%caml_string_get16"
let test = get16 "" 0
caml_string_get16(str, idx) will access indices (idx) and (idx+1). The
bound-checking code is currently implemented as:
if (idx < 0 || idx >= caml_string_length(str) - 1) caml_array_bound_error();
This is wrong as caml_string_length returns an mlsize_t which is
unsigned, so substracting 1 gets buggy when the size is 0. The test
should be written as follow:
if (idx < 0 || idx + 1 >= caml_string_length(str)) caml_array_bound_error();
Note 1: we can exploit this bug to make out-of-bound access to
a string, but I think get16 examples will run into the padding
characters of OCaml strings and behave in a not-too-wrong way. It may
also be the case of get32, but get64 will access 7 bytes, so access
memory outside the string:
# external set64: string -> int -> int -> unit = "%caml_string_get64";;
external set64 : string -> int -> int -> unit = "%caml_string_get64"
# set64 "" 0 0;;
Segmentation fault
Note 2: this first commit only fixes the C code in byterun/str.c. Only
ocamlc actually uses these functions when the compiler primitive is
used ("%caml_string_get16" instead of "caml_string_get16"). ocamlopt
generates ocaml code directly, and this part has yet to be fixed in
a following commit.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14267 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2013-11-05 03:09:29 -08:00
|
|
|
if (idx < 0 || idx + 3 >= caml_string_length(str)) caml_array_bound_error();
|
2012-12-19 08:22:30 -08:00
|
|
|
b1 = Byte_u(str, idx);
|
|
|
|
b2 = Byte_u(str, idx + 1);
|
|
|
|
b3 = Byte_u(str, idx + 2);
|
|
|
|
b4 = Byte_u(str, idx + 3);
|
2012-11-09 08:15:29 -08:00
|
|
|
#ifdef ARCH_BIG_ENDIAN
|
|
|
|
res = b1 << 24 | b2 << 16 | b3 << 8 | b4;
|
|
|
|
#else
|
|
|
|
res = b4 << 24 | b3 << 16 | b2 << 8 | b1;
|
|
|
|
#endif
|
|
|
|
return caml_copy_int32(res);
|
|
|
|
}
|
|
|
|
|
2018-02-16 23:48:58 -08:00
|
|
|
CAMLprim value caml_bytes_get32(value str, value index)
|
|
|
|
{
|
|
|
|
return caml_string_get32(str,index);
|
|
|
|
}
|
|
|
|
|
2012-11-09 08:15:29 -08:00
|
|
|
CAMLprim value caml_string_get64(value str, value index)
|
|
|
|
{
|
2014-08-27 02:58:33 -07:00
|
|
|
uint64_t res;
|
2012-12-19 08:22:30 -08:00
|
|
|
unsigned char b1, b2, b3, b4, b5, b6, b7, b8;
|
|
|
|
intnat idx = Long_val(index);
|
bound checking bug with caml_string_{get,set}{16,32,64}: fix the runtime C code
As notified by Nicolas Trangez, the following program behaves in an
unexpected way by returning 0 instead of failing with an out-of-bound
exception:
external get16 : string -> int -> int = "%caml_string_get16"
let test = get16 "" 0
caml_string_get16(str, idx) will access indices (idx) and (idx+1). The
bound-checking code is currently implemented as:
if (idx < 0 || idx >= caml_string_length(str) - 1) caml_array_bound_error();
This is wrong as caml_string_length returns an mlsize_t which is
unsigned, so substracting 1 gets buggy when the size is 0. The test
should be written as follow:
if (idx < 0 || idx + 1 >= caml_string_length(str)) caml_array_bound_error();
Note 1: we can exploit this bug to make out-of-bound access to
a string, but I think get16 examples will run into the padding
characters of OCaml strings and behave in a not-too-wrong way. It may
also be the case of get32, but get64 will access 7 bytes, so access
memory outside the string:
# external set64: string -> int -> int -> unit = "%caml_string_get64";;
external set64 : string -> int -> int -> unit = "%caml_string_get64"
# set64 "" 0 0;;
Segmentation fault
Note 2: this first commit only fixes the C code in byterun/str.c. Only
ocamlc actually uses these functions when the compiler primitive is
used ("%caml_string_get16" instead of "caml_string_get16"). ocamlopt
generates ocaml code directly, and this part has yet to be fixed in
a following commit.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14267 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2013-11-05 03:09:29 -08:00
|
|
|
if (idx < 0 || idx + 7 >= caml_string_length(str)) caml_array_bound_error();
|
2012-12-19 08:22:30 -08:00
|
|
|
b1 = Byte_u(str, idx);
|
|
|
|
b2 = Byte_u(str, idx + 1);
|
|
|
|
b3 = Byte_u(str, idx + 2);
|
|
|
|
b4 = Byte_u(str, idx + 3);
|
|
|
|
b5 = Byte_u(str, idx + 4);
|
|
|
|
b6 = Byte_u(str, idx + 5);
|
|
|
|
b7 = Byte_u(str, idx + 6);
|
|
|
|
b8 = Byte_u(str, idx + 7);
|
2012-11-09 08:15:29 -08:00
|
|
|
#ifdef ARCH_BIG_ENDIAN
|
2014-08-27 02:58:33 -07:00
|
|
|
res = (uint64_t) b1 << 56 | (uint64_t) b2 << 48
|
|
|
|
| (uint64_t) b3 << 40 | (uint64_t) b4 << 32
|
|
|
|
| (uint64_t) b5 << 24 | (uint64_t) b6 << 16
|
|
|
|
| (uint64_t) b7 << 8 | (uint64_t) b8;
|
2012-11-09 08:15:29 -08:00
|
|
|
#else
|
2014-08-27 02:58:33 -07:00
|
|
|
res = (uint64_t) b8 << 56 | (uint64_t) b7 << 48
|
|
|
|
| (uint64_t) b6 << 40 | (uint64_t) b5 << 32
|
|
|
|
| (uint64_t) b4 << 24 | (uint64_t) b3 << 16
|
|
|
|
| (uint64_t) b2 << 8 | (uint64_t) b1;
|
2012-11-09 08:15:29 -08:00
|
|
|
#endif
|
2014-04-15 10:09:13 -07:00
|
|
|
return caml_copy_int64(res);
|
2012-11-09 08:15:29 -08:00
|
|
|
}
|
|
|
|
|
2018-02-16 23:48:58 -08:00
|
|
|
CAMLprim value caml_bytes_get64(value str, value index)
|
|
|
|
{
|
|
|
|
return caml_string_get64(str,index);
|
|
|
|
}
|
|
|
|
|
|
|
|
CAMLprim value caml_bytes_set16(value str, value index, value newval)
|
2012-11-09 08:15:29 -08:00
|
|
|
{
|
2012-12-19 08:22:30 -08:00
|
|
|
unsigned char b1, b2;
|
|
|
|
intnat val;
|
2012-11-09 08:15:29 -08:00
|
|
|
intnat idx = Long_val(index);
|
bound checking bug with caml_string_{get,set}{16,32,64}: fix the runtime C code
As notified by Nicolas Trangez, the following program behaves in an
unexpected way by returning 0 instead of failing with an out-of-bound
exception:
external get16 : string -> int -> int = "%caml_string_get16"
let test = get16 "" 0
caml_string_get16(str, idx) will access indices (idx) and (idx+1). The
bound-checking code is currently implemented as:
if (idx < 0 || idx >= caml_string_length(str) - 1) caml_array_bound_error();
This is wrong as caml_string_length returns an mlsize_t which is
unsigned, so substracting 1 gets buggy when the size is 0. The test
should be written as follow:
if (idx < 0 || idx + 1 >= caml_string_length(str)) caml_array_bound_error();
Note 1: we can exploit this bug to make out-of-bound access to
a string, but I think get16 examples will run into the padding
characters of OCaml strings and behave in a not-too-wrong way. It may
also be the case of get32, but get64 will access 7 bytes, so access
memory outside the string:
# external set64: string -> int -> int -> unit = "%caml_string_get64";;
external set64 : string -> int -> int -> unit = "%caml_string_get64"
# set64 "" 0 0;;
Segmentation fault
Note 2: this first commit only fixes the C code in byterun/str.c. Only
ocamlc actually uses these functions when the compiler primitive is
used ("%caml_string_get16" instead of "caml_string_get16"). ocamlopt
generates ocaml code directly, and this part has yet to be fixed in
a following commit.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14267 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2013-11-05 03:09:29 -08:00
|
|
|
if (idx < 0 || idx + 1 >= caml_string_length(str)) caml_array_bound_error();
|
2012-12-19 08:22:30 -08:00
|
|
|
val = Long_val(newval);
|
2012-11-09 08:15:29 -08:00
|
|
|
#ifdef ARCH_BIG_ENDIAN
|
|
|
|
b1 = 0xFF & val >> 8;
|
|
|
|
b2 = 0xFF & val;
|
|
|
|
#else
|
|
|
|
b2 = 0xFF & val >> 8;
|
|
|
|
b1 = 0xFF & val;
|
|
|
|
#endif
|
|
|
|
Byte_u(str, idx) = b1;
|
|
|
|
Byte_u(str, idx + 1) = b2;
|
|
|
|
return Val_unit;
|
|
|
|
}
|
|
|
|
|
2018-02-16 23:48:58 -08:00
|
|
|
CAMLprim value caml_bytes_set32(value str, value index, value newval)
|
2012-11-09 08:15:29 -08:00
|
|
|
{
|
2012-12-19 08:22:30 -08:00
|
|
|
unsigned char b1, b2, b3, b4;
|
|
|
|
intnat val;
|
2012-11-09 08:15:29 -08:00
|
|
|
intnat idx = Long_val(index);
|
bound checking bug with caml_string_{get,set}{16,32,64}: fix the runtime C code
As notified by Nicolas Trangez, the following program behaves in an
unexpected way by returning 0 instead of failing with an out-of-bound
exception:
external get16 : string -> int -> int = "%caml_string_get16"
let test = get16 "" 0
caml_string_get16(str, idx) will access indices (idx) and (idx+1). The
bound-checking code is currently implemented as:
if (idx < 0 || idx >= caml_string_length(str) - 1) caml_array_bound_error();
This is wrong as caml_string_length returns an mlsize_t which is
unsigned, so substracting 1 gets buggy when the size is 0. The test
should be written as follow:
if (idx < 0 || idx + 1 >= caml_string_length(str)) caml_array_bound_error();
Note 1: we can exploit this bug to make out-of-bound access to
a string, but I think get16 examples will run into the padding
characters of OCaml strings and behave in a not-too-wrong way. It may
also be the case of get32, but get64 will access 7 bytes, so access
memory outside the string:
# external set64: string -> int -> int -> unit = "%caml_string_get64";;
external set64 : string -> int -> int -> unit = "%caml_string_get64"
# set64 "" 0 0;;
Segmentation fault
Note 2: this first commit only fixes the C code in byterun/str.c. Only
ocamlc actually uses these functions when the compiler primitive is
used ("%caml_string_get16" instead of "caml_string_get16"). ocamlopt
generates ocaml code directly, and this part has yet to be fixed in
a following commit.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14267 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2013-11-05 03:09:29 -08:00
|
|
|
if (idx < 0 || idx + 3 >= caml_string_length(str)) caml_array_bound_error();
|
2012-12-19 08:22:30 -08:00
|
|
|
val = Int32_val(newval);
|
2012-11-09 08:15:29 -08:00
|
|
|
#ifdef ARCH_BIG_ENDIAN
|
|
|
|
b1 = 0xFF & val >> 24;
|
|
|
|
b2 = 0xFF & val >> 16;
|
|
|
|
b3 = 0xFF & val >> 8;
|
|
|
|
b4 = 0xFF & val;
|
|
|
|
#else
|
|
|
|
b4 = 0xFF & val >> 24;
|
|
|
|
b3 = 0xFF & val >> 16;
|
|
|
|
b2 = 0xFF & val >> 8;
|
|
|
|
b1 = 0xFF & val;
|
|
|
|
#endif
|
|
|
|
Byte_u(str, idx) = b1;
|
|
|
|
Byte_u(str, idx + 1) = b2;
|
|
|
|
Byte_u(str, idx + 2) = b3;
|
|
|
|
Byte_u(str, idx + 3) = b4;
|
|
|
|
return Val_unit;
|
|
|
|
}
|
|
|
|
|
2018-02-16 23:48:58 -08:00
|
|
|
CAMLprim value caml_bytes_set64(value str, value index, value newval)
|
2012-11-09 08:15:29 -08:00
|
|
|
{
|
|
|
|
unsigned char b1, b2, b3, b4, b5, b6, b7, b8;
|
2014-08-27 02:58:33 -07:00
|
|
|
int64_t val;
|
2012-12-19 08:22:30 -08:00
|
|
|
intnat idx = Long_val(index);
|
bound checking bug with caml_string_{get,set}{16,32,64}: fix the runtime C code
As notified by Nicolas Trangez, the following program behaves in an
unexpected way by returning 0 instead of failing with an out-of-bound
exception:
external get16 : string -> int -> int = "%caml_string_get16"
let test = get16 "" 0
caml_string_get16(str, idx) will access indices (idx) and (idx+1). The
bound-checking code is currently implemented as:
if (idx < 0 || idx >= caml_string_length(str) - 1) caml_array_bound_error();
This is wrong as caml_string_length returns an mlsize_t which is
unsigned, so substracting 1 gets buggy when the size is 0. The test
should be written as follow:
if (idx < 0 || idx + 1 >= caml_string_length(str)) caml_array_bound_error();
Note 1: we can exploit this bug to make out-of-bound access to
a string, but I think get16 examples will run into the padding
characters of OCaml strings and behave in a not-too-wrong way. It may
also be the case of get32, but get64 will access 7 bytes, so access
memory outside the string:
# external set64: string -> int -> int -> unit = "%caml_string_get64";;
external set64 : string -> int -> int -> unit = "%caml_string_get64"
# set64 "" 0 0;;
Segmentation fault
Note 2: this first commit only fixes the C code in byterun/str.c. Only
ocamlc actually uses these functions when the compiler primitive is
used ("%caml_string_get16" instead of "caml_string_get16"). ocamlopt
generates ocaml code directly, and this part has yet to be fixed in
a following commit.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14267 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
2013-11-05 03:09:29 -08:00
|
|
|
if (idx < 0 || idx + 7 >= caml_string_length(str)) caml_array_bound_error();
|
2012-12-19 08:22:30 -08:00
|
|
|
val = Int64_val(newval);
|
2012-11-09 08:15:29 -08:00
|
|
|
#ifdef ARCH_BIG_ENDIAN
|
2014-04-15 10:09:13 -07:00
|
|
|
b1 = 0xFF & val >> 56;
|
|
|
|
b2 = 0xFF & val >> 48;
|
|
|
|
b3 = 0xFF & val >> 40;
|
|
|
|
b4 = 0xFF & val >> 32;
|
|
|
|
b5 = 0xFF & val >> 24;
|
|
|
|
b6 = 0xFF & val >> 16;
|
|
|
|
b7 = 0xFF & val >> 8;
|
|
|
|
b8 = 0xFF & val;
|
2012-11-09 08:15:29 -08:00
|
|
|
#else
|
2014-04-15 10:09:13 -07:00
|
|
|
b8 = 0xFF & val >> 56;
|
|
|
|
b7 = 0xFF & val >> 48;
|
|
|
|
b6 = 0xFF & val >> 40;
|
|
|
|
b5 = 0xFF & val >> 32;
|
|
|
|
b4 = 0xFF & val >> 24;
|
|
|
|
b3 = 0xFF & val >> 16;
|
|
|
|
b2 = 0xFF & val >> 8;
|
|
|
|
b1 = 0xFF & val;
|
2012-11-09 08:15:29 -08:00
|
|
|
#endif
|
|
|
|
Byte_u(str, idx) = b1;
|
|
|
|
Byte_u(str, idx + 1) = b2;
|
|
|
|
Byte_u(str, idx + 2) = b3;
|
|
|
|
Byte_u(str, idx + 3) = b4;
|
|
|
|
Byte_u(str, idx + 4) = b5;
|
|
|
|
Byte_u(str, idx + 5) = b6;
|
|
|
|
Byte_u(str, idx + 6) = b7;
|
|
|
|
Byte_u(str, idx + 7) = b8;
|
|
|
|
return Val_unit;
|
|
|
|
}
|
|
|
|
|
2003-12-16 10:09:44 -08:00
|
|
|
CAMLprim value caml_string_equal(value s1, value s2)
|
1995-07-10 02:48:27 -07:00
|
|
|
{
|
2007-01-30 01:52:08 -08:00
|
|
|
mlsize_t sz1, sz2;
|
1995-07-10 02:48:27 -07:00
|
|
|
value * p1, * p2;
|
2007-01-30 01:52:08 -08:00
|
|
|
|
|
|
|
if (s1 == s2) return Val_true;
|
|
|
|
sz1 = Wosize_val(s1);
|
|
|
|
sz2 = Wosize_val(s2);
|
1995-07-10 02:48:27 -07:00
|
|
|
if (sz1 != sz2) return Val_false;
|
|
|
|
for(p1 = Op_val(s1), p2 = Op_val(s2); sz1 > 0; sz1--, p1++, p2++)
|
|
|
|
if (*p1 != *p2) return Val_false;
|
|
|
|
return Val_true;
|
|
|
|
}
|
|
|
|
|
2016-08-07 07:51:35 -07:00
|
|
|
CAMLprim value caml_bytes_equal(value s1, value s2)
|
|
|
|
{
|
|
|
|
return caml_string_equal(s1,s2);
|
|
|
|
}
|
|
|
|
|
2003-12-16 10:09:44 -08:00
|
|
|
CAMLprim value caml_string_notequal(value s1, value s2)
|
1995-07-10 02:48:27 -07:00
|
|
|
{
|
2003-12-16 10:09:44 -08:00
|
|
|
return Val_not(caml_string_equal(s1, s2));
|
1995-07-10 02:48:27 -07:00
|
|
|
}
|
2003-04-01 00:46:39 -08:00
|
|
|
|
2016-08-07 07:51:35 -07:00
|
|
|
CAMLprim value caml_bytes_notequal(value s1, value s2)
|
|
|
|
{
|
|
|
|
return caml_string_notequal(s1,s2);
|
|
|
|
}
|
|
|
|
|
2003-12-16 10:09:44 -08:00
|
|
|
CAMLprim value caml_string_compare(value s1, value s2)
|
2003-04-01 00:46:39 -08:00
|
|
|
{
|
2004-05-17 10:10:00 -07:00
|
|
|
mlsize_t len1, len2;
|
2003-04-01 00:46:39 -08:00
|
|
|
int res;
|
|
|
|
|
2007-01-30 01:52:08 -08:00
|
|
|
if (s1 == s2) return Val_int(0);
|
2003-12-16 10:09:44 -08:00
|
|
|
len1 = caml_string_length(s1);
|
2010-01-22 04:48:24 -08:00
|
|
|
len2 = caml_string_length(s2);
|
2003-04-01 00:46:39 -08:00
|
|
|
res = memcmp(String_val(s1), String_val(s2), len1 <= len2 ? len1 : len2);
|
|
|
|
if (res < 0) return Val_int(-1);
|
|
|
|
if (res > 0) return Val_int(1);
|
|
|
|
if (len1 < len2) return Val_int(-1);
|
|
|
|
if (len1 > len2) return Val_int(1);
|
|
|
|
return Val_int(0);
|
|
|
|
}
|
|
|
|
|
2016-08-07 07:51:35 -07:00
|
|
|
CAMLprim value caml_bytes_compare(value s1, value s2)
|
|
|
|
{
|
|
|
|
return caml_string_compare(s1,s2);
|
|
|
|
}
|
|
|
|
|
2003-12-16 10:09:44 -08:00
|
|
|
CAMLprim value caml_string_lessthan(value s1, value s2)
|
2003-04-01 00:46:39 -08:00
|
|
|
{
|
2003-12-16 10:09:44 -08:00
|
|
|
return caml_string_compare(s1, s2) < Val_int(0) ? Val_true : Val_false;
|
2003-04-01 00:46:39 -08:00
|
|
|
}
|
2010-01-22 04:48:24 -08:00
|
|
|
|
2016-08-07 07:51:35 -07:00
|
|
|
CAMLprim value caml_bytes_lessthan(value s1, value s2)
|
|
|
|
{
|
|
|
|
return caml_string_lessthan(s1,s2);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2003-12-16 10:09:44 -08:00
|
|
|
CAMLprim value caml_string_lessequal(value s1, value s2)
|
2003-04-01 00:46:39 -08:00
|
|
|
{
|
2003-12-16 10:09:44 -08:00
|
|
|
return caml_string_compare(s1, s2) <= Val_int(0) ? Val_true : Val_false;
|
2003-04-01 00:46:39 -08:00
|
|
|
}
|
2010-01-22 04:48:24 -08:00
|
|
|
|
2016-08-07 07:51:35 -07:00
|
|
|
CAMLprim value caml_bytes_lessequal(value s1, value s2)
|
|
|
|
{
|
|
|
|
return caml_string_lessequal(s1,s2);
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2003-12-16 10:09:44 -08:00
|
|
|
CAMLprim value caml_string_greaterthan(value s1, value s2)
|
2003-04-01 00:46:39 -08:00
|
|
|
{
|
2003-12-16 10:09:44 -08:00
|
|
|
return caml_string_compare(s1, s2) > Val_int(0) ? Val_true : Val_false;
|
2003-04-01 00:46:39 -08:00
|
|
|
}
|
2010-01-22 04:48:24 -08:00
|
|
|
|
2016-08-07 07:51:35 -07:00
|
|
|
CAMLprim value caml_bytes_greaterthan(value s1, value s2)
|
|
|
|
{
|
|
|
|
return caml_string_greaterthan(s1,s2);
|
|
|
|
}
|
|
|
|
|
2003-12-16 10:09:44 -08:00
|
|
|
CAMLprim value caml_string_greaterequal(value s1, value s2)
|
2003-04-01 00:46:39 -08:00
|
|
|
{
|
2003-12-16 10:09:44 -08:00
|
|
|
return caml_string_compare(s1, s2) >= Val_int(0) ? Val_true : Val_false;
|
2003-04-01 00:46:39 -08:00
|
|
|
}
|
2010-01-22 04:48:24 -08:00
|
|
|
|
2016-08-07 07:51:35 -07:00
|
|
|
CAMLprim value caml_bytes_greaterequal(value s1, value s2)
|
|
|
|
{
|
|
|
|
return caml_string_greaterequal(s1,s2);
|
|
|
|
}
|
|
|
|
|
2016-08-08 08:02:19 -07:00
|
|
|
CAMLprim value caml_blit_bytes(value s1, value ofs1, value s2, value ofs2,
|
2003-12-16 10:09:44 -08:00
|
|
|
value n)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
2015-10-19 08:47:33 -07:00
|
|
|
memmove(&Byte(s2, Long_val(ofs2)), &Byte(s1, Long_val(ofs1)), Long_val(n));
|
1995-06-18 07:44:56 -07:00
|
|
|
return Val_unit;
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
|
2016-08-08 08:02:19 -07:00
|
|
|
CAMLprim value caml_blit_string(value s1, value ofs1, value s2, value ofs2,
|
2016-08-07 07:51:35 -07:00
|
|
|
value n)
|
|
|
|
{
|
2016-08-08 08:02:19 -07:00
|
|
|
return caml_blit_bytes (s1, ofs1, s2, ofs2, n);
|
2016-08-07 07:51:35 -07:00
|
|
|
}
|
2016-08-08 08:02:19 -07:00
|
|
|
|
|
|
|
CAMLprim value caml_fill_bytes(value s, value offset, value len, value init)
|
1995-05-04 03:15:53 -07:00
|
|
|
{
|
2003-04-01 00:46:39 -08:00
|
|
|
memset(&Byte(s, Long_val(offset)), Int_val(init), Long_val(len));
|
1995-06-18 07:44:56 -07:00
|
|
|
return Val_unit;
|
1995-05-04 03:15:53 -07:00
|
|
|
}
|
|
|
|
|
2016-08-08 08:02:19 -07:00
|
|
|
/**
|
|
|
|
* [caml_fill_string] is deprecated, use [caml_fill_bytes] instead
|
|
|
|
*/
|
|
|
|
CAMLprim value caml_fill_string(value s, value offset, value len, value init)
|
2016-08-07 07:51:35 -07:00
|
|
|
{
|
2016-08-08 08:02:19 -07:00
|
|
|
return caml_fill_bytes (s, offset, len, init);
|
2016-08-07 07:51:35 -07:00
|
|
|
}
|
|
|
|
|
2014-04-15 10:09:13 -07:00
|
|
|
CAMLexport value caml_alloc_sprintf(const char * format, ...)
|
|
|
|
{
|
|
|
|
va_list args;
|
2017-02-16 10:57:09 -08:00
|
|
|
char buf[128];
|
2014-04-15 10:09:13 -07:00
|
|
|
int n;
|
|
|
|
value res;
|
|
|
|
|
2016-01-16 01:24:01 -08:00
|
|
|
#if !defined(_WIN32) || defined(_UCRT)
|
2014-04-15 10:09:13 -07:00
|
|
|
/* C99-compliant implementation */
|
|
|
|
va_start(args, format);
|
|
|
|
/* "vsnprintf(dest, sz, format, args)" writes at most "sz" characters
|
2014-08-22 06:45:02 -07:00
|
|
|
into "dest", including the terminating '\0'.
|
2014-04-15 10:09:13 -07:00
|
|
|
It returns the number of characters of the formatted string,
|
|
|
|
excluding the terminating '\0'. */
|
|
|
|
n = vsnprintf(buf, sizeof(buf), format, args);
|
|
|
|
va_end(args);
|
|
|
|
if (n < sizeof(buf)) {
|
2014-08-22 06:45:02 -07:00
|
|
|
/* All output characters were written to buf, including the
|
2017-02-16 10:57:09 -08:00
|
|
|
terminating '\0'. Allocate a Caml string with length "n"
|
|
|
|
as computed by vsnprintf, and copy the output of vsnprintf into it. */
|
2017-08-03 06:19:13 -07:00
|
|
|
res = caml_alloc_initialized_string(n, buf);
|
2014-04-15 10:09:13 -07:00
|
|
|
} else {
|
2014-05-28 16:11:47 -07:00
|
|
|
/* PR#7568: if the format is in the Caml heap, the following
|
2017-02-16 10:57:09 -08:00
|
|
|
caml_alloc_string could move or free the format. To prevent
|
|
|
|
this, take a copy of the format outside the Caml heap. */
|
2014-05-28 16:11:47 -07:00
|
|
|
char * saved_format = caml_stat_strdup(format);
|
2017-02-16 10:57:09 -08:00
|
|
|
/* Allocate a Caml string with length "n" as computed by vsnprintf. */
|
|
|
|
res = caml_alloc_string(n);
|
2014-04-15 10:09:13 -07:00
|
|
|
/* Re-do the formatting, outputting directly in the Caml string.
|
|
|
|
Note that caml_alloc_string left room for a '\0' at position n,
|
|
|
|
so the size passed to vsnprintf is n+1. */
|
|
|
|
va_start(args, format);
|
2017-08-03 06:19:13 -07:00
|
|
|
vsnprintf((char *)String_val(res), n + 1, saved_format, args);
|
2014-04-15 10:09:13 -07:00
|
|
|
va_end(args);
|
2017-02-16 10:57:09 -08:00
|
|
|
caml_stat_free(saved_format);
|
2014-04-15 10:09:13 -07:00
|
|
|
}
|
|
|
|
return res;
|
|
|
|
#else
|
|
|
|
/* Implementation specific to the Microsoft CRT library */
|
|
|
|
va_start(args, format);
|
|
|
|
/* "_vsnprintf(dest, sz, format, args)" writes at most "sz" characters
|
|
|
|
into "dest". Let "len" be the number of characters of the formatted
|
|
|
|
string.
|
|
|
|
If "len" < "sz", a null terminator was appended, and "len" is returned.
|
|
|
|
If "len" == "sz", no null termination, and "len" is returned.
|
|
|
|
If "len" > "sz", a negative value is returned. */
|
|
|
|
n = _vsnprintf(buf, sizeof(buf), format, args);
|
|
|
|
va_end(args);
|
|
|
|
if (n >= 0 && n <= sizeof(buf)) {
|
|
|
|
/* All output characters were written to buf.
|
|
|
|
"n" is the actual length of the output.
|
2017-02-16 10:57:09 -08:00
|
|
|
Allocate a Caml string of length "n" and copy the characters into it. */
|
2014-04-15 10:09:13 -07:00
|
|
|
res = caml_alloc_string(n);
|
2019-11-13 12:59:18 -08:00
|
|
|
memcpy((char *)String_val(res), buf, n);
|
2014-04-15 10:09:13 -07:00
|
|
|
} else {
|
2014-05-28 16:11:47 -07:00
|
|
|
/* PR#7568: if the format is in the Caml heap, the following
|
2017-02-16 10:57:09 -08:00
|
|
|
caml_alloc_string could move or free the format. To prevent
|
|
|
|
this, take a copy of the format outside the Caml heap. */
|
2014-05-28 16:11:47 -07:00
|
|
|
char * saved_format = caml_stat_strdup(format);
|
2014-04-15 10:09:13 -07:00
|
|
|
/* Determine actual length of output, excluding final '\0' */
|
|
|
|
va_start(args, format);
|
|
|
|
n = _vscprintf(format, args);
|
|
|
|
va_end(args);
|
|
|
|
res = caml_alloc_string(n);
|
|
|
|
/* Re-do the formatting, outputting directly in the Caml string.
|
|
|
|
Note that caml_alloc_string left room for a '\0' at position n,
|
|
|
|
so the size passed to _vsnprintf is n+1. */
|
|
|
|
va_start(args, format);
|
2019-11-13 12:59:18 -08:00
|
|
|
_vsnprintf((char *)String_val(res), n + 1, saved_format, args);
|
2014-04-15 10:09:13 -07:00
|
|
|
va_end(args);
|
2017-02-16 10:57:09 -08:00
|
|
|
caml_stat_free(saved_format);
|
2014-04-15 10:09:13 -07:00
|
|
|
}
|
|
|
|
return res;
|
|
|
|
#endif
|
|
|
|
}
|
2018-02-17 00:15:53 -08:00
|
|
|
|
|
|
|
CAMLprim value caml_string_of_bytes(value bv)
|
|
|
|
{
|
|
|
|
return bv;
|
|
|
|
}
|
|
|
|
|
|
|
|
CAMLprim value caml_bytes_of_string(value bv)
|
|
|
|
{
|
|
|
|
return bv;
|
|
|
|
}
|