Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

PR#6075: avoid using unsafe C library functions (strcpy, strcat, sprintf). 

An ISO C99-compliant C compiler and standard library is now assumed.
(Plus special exceptions for MSVC.)  In particular, emulation code for
64-bit integer arithmetic was removed, the C compiler must support a
64-bit integer type.


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14607 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Xavier Leroy 2014-04-15 17:09:13 +00:00
parent 2fc7ac7e8b
commit 774e30e138
51 changed files with 522 additions and 612 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Changes
View File

@ -55,6 +55,11 @@ Runtime system:
increments proportional to heap size
- PR#4765: Structural equality should treat exception specifically
- PR#5009: Extending exception tag blocks
- PR#6075: avoid using unsafe C library functions (strcpy, strcat, sprintf)
- An ISO C99-compliant C compiler and standard library is now assumed.
(Plus special exceptions for MSVC.) In particular, emulation code for
64-bit integer arithmetic was removed, the C compiler must support a
64-bit integer type.
Standard library:
- PR#4986: add List.sort_uniq and Set.of_list

1
byterun/alloc.h
View File

@ -37,6 +37,7 @@ CAMLextern value caml_copy_int64 (int64); /* defined in [ints.c] */
CAMLextern value caml_copy_nativeint (intnat); /* defined in [ints.c] */
CAMLextern value caml_alloc_array (value (*funct) (char const *),
char const ** array);
CAMLextern value caml_alloc_sprintf(const char * format, ...);
typedef void (*final_fun)(value);
CAMLextern value caml_alloc_final (mlsize_t, /*size in words*/

5
byterun/callback.c
View File

@ -216,6 +216,7 @@ CAMLprim value caml_register_named_value(value vname, value val)
{
struct named_value * nv;
char * name = String_val(vname);
size_t namelen = strlen(name);
unsigned int h = hash_value_name(name);
for (nv = named_value_table[h]; nv != NULL; nv = nv->next) {
@ -225,8 +226,8 @@ CAMLprim value caml_register_named_value(value vname, value val)
}
}
nv = (struct named_value *)
caml_stat_alloc(sizeof(struct named_value) + strlen(name));
strcpy(nv->name, name);
caml_stat_alloc(sizeof(struct named_value) + namelen);
memcpy(nv->name, name, namelen + 1);
nv->val = val;
nv->next = named_value_table[h];
named_value_table[h] = nv;

56
byterun/config.h
View File

@ -25,30 +25,9 @@
#include "compatibility.h"
#endif
/* Types for signed chars, 32-bit integers, 64-bit integers,
/* Types for 32-bit integers, 64-bit integers,
native integers (as wide as a pointer type) */
typedef signed char schar;
#if SIZEOF_PTR == SIZEOF_LONG
/* Standard models: ILP32 or I32LP64 */
typedef long intnat;
typedef unsigned long uintnat;
#define ARCH_INTNAT_PRINTF_FORMAT "l"
#elif SIZEOF_PTR == SIZEOF_INT
/* Hypothetical IP32L64 model */
typedef int intnat;
typedef unsigned int uintnat;
#define ARCH_INTNAT_PRINTF_FORMAT ""
#elif SIZEOF_PTR == 8 && defined(ARCH_INT64_TYPE)
/* Win64 model: IL32LLP64 */
typedef ARCH_INT64_TYPE intnat;
typedef ARCH_UINT64_TYPE uintnat;
#define ARCH_INTNAT_PRINTF_FORMAT ARCH_INT64_PRINTF_FORMAT
#else
#error "No integer type available to represent pointers"
#endif
#if SIZEOF_INT == 4
typedef int int32;
typedef unsigned int uint32;
@ -68,12 +47,35 @@ typedef unsigned short uint32;
#if defined(ARCH_INT64_TYPE)
typedef ARCH_INT64_TYPE int64;
typedef ARCH_UINT64_TYPE uint64;
#elif SIZEOF_LONG == 8
typedef long int64;
typedef unsigned long uint64;
#define ARCH_INT64_PRINTF_FORMAT "l"
#elif SIZEOF_LONGLONG == 8
typedef long long int64;
typedef unsigned long long uint64;
#define ARCH_INT64_PRINTF_FORMAT "ll"
#else
# ifdef ARCH_BIG_ENDIAN
typedef struct { uint32 h, l; } uint64, int64;
# else
typedef struct { uint32 l, h; } uint64, int64;
# endif
#error "No 64-bit integer type available"
#endif
#if SIZEOF_PTR == SIZEOF_LONG
/* Standard models: ILP32 or I32LP64 */
typedef long intnat;
typedef unsigned long uintnat;
#define ARCH_INTNAT_PRINTF_FORMAT "l"
#elif SIZEOF_PTR == SIZEOF_INT
/* Hypothetical IP32L64 model */
typedef int intnat;
typedef unsigned int uintnat;
#define ARCH_INTNAT_PRINTF_FORMAT ""
#elif SIZEOF_PTR == 8
/* Win64 model: IL32LLP64 */
typedef int64 intnat;
typedef uint64 uintnat;
#define ARCH_INTNAT_PRINTF_FORMAT ARCH_INT64_PRINTF_FORMAT
#else
#error "No integer type available to represent pointers"
#endif
/* Endianness of floats */

4
byterun/dynlink.c
View File

@ -79,9 +79,7 @@ static char * parse_ld_conf(void)
stdlib = getenv("OCAMLLIB");
if (stdlib == NULL) stdlib = getenv("CAMLLIB");
if (stdlib == NULL) stdlib = OCAML_STDLIB_DIR;
ldconfname = caml_stat_alloc(strlen(stdlib) + 2 + sizeof(LD_CONF_NAME));
strcpy(ldconfname, stdlib);
strcat(ldconfname, "/" LD_CONF_NAME);
ldconfname = caml_strconcat(3, stdlib, "/", LD_CONF_NAME);
if (stat(ldconfname, &st) == -1) {
caml_stat_free(ldconfname);
return NULL;

48
byterun/floats.c
View File

@ -71,68 +71,29 @@ CAMLexport value caml_copy_double(double d)
CAMLprim value caml_format_float(value fmt, value arg)
{
#define MAX_DIGITS 350
/* Max number of decimal digits in a "natural" (not artificially padded)
representation of a float. Can be quite big for %f format.
Max exponent for IEEE format is 308 decimal digits.
Rounded up for good measure. */
char format_buffer[MAX_DIGITS + 20];
int prec, i;
char * p;
char * dest;
value res;
double d = Double_val(arg);
#ifdef HAS_BROKEN_PRINTF
if (isfinite(d)) {
#endif
prec = MAX_DIGITS;
for (p = String_val(fmt); *p != 0; p++) {
if (*p >= '0' && *p <= '9') {
i = atoi(p) + MAX_DIGITS;
if (i > prec) prec = i;
break;
}
}
for( ; *p != 0; p++) {
if (*p == '.') {
i = atoi(p+1) + MAX_DIGITS;
if (i > prec) prec = i;
break;
}
}
if (prec < sizeof(format_buffer)) {
dest = format_buffer;
} else {
dest = caml_stat_alloc(prec);
}
sprintf(dest, String_val(fmt), d);
res = caml_copy_string(dest);
if (dest != format_buffer) {
caml_stat_free(dest);
}
res = caml_alloc_sprintf(String_val(fmt), d);
#ifdef HAS_BROKEN_PRINTF
} else {
if (isnan(d))
{
if (isnan(d)) {
res = caml_copy_string("nan");
}
else
{
} else {
if (d > 0)
{
res = caml_copy_string("inf");
}
else
{
res = caml_copy_string("-inf");
}
}
}
#endif
return res;
}
#if 0
/*CAMLprim*/ value caml_float_of_substring(value vs, value idx, value l)
{
char parse_buffer[64];
@ -163,6 +124,7 @@ CAMLprim value caml_format_float(value fmt, value arg)
if (buf != parse_buffer) caml_stat_free(buf);
caml_failwith("float_of_string");
}
#endif
CAMLprim value caml_float_of_string(value vs)
{

10
byterun/hash.c
View File

@ -21,12 +21,6 @@
#include "memory.h"
#include "hash.h"
#ifdef ARCH_INT64_TYPE
#include "int64_native.h"
#else
#include "int64_emul.h"
#endif
/* The new implementation, based on MurmurHash 3,
http://code.google.com/p/smhasher/ */
@ -77,9 +71,7 @@ CAMLexport uint32 caml_hash_mix_intnat(uint32 h, intnat d)
CAMLexport uint32 caml_hash_mix_int64(uint32 h, int64 d)
{
uint32 hi, lo;
I64_split(d, hi, lo);
uint32 hi = (uint32) (d >> 32), lo = (uint32) d;
MIX(h, lo);
MIX(h, hi);
return h;

17
byterun/instrtrace.c
View File

@ -84,7 +84,7 @@ char * caml_instr_string (code_t pc)
char *nam;
nam = (instr < 0 || instr > STOP)
? (sprintf (nambuf, "???%d", instr), nambuf)
? (snprintf (nambuf, sizeof(nambuf), "???%d", instr), nambuf)
: names_of_instructions[instr];
pc++;
switch (instr) {
@ -125,7 +125,7 @@ char * caml_instr_string (code_t pc)
case OFFSETREF:
case OFFSETCLOSURE:
case PUSHOFFSETCLOSURE:
sprintf(buf, "%s %d", nam, pc[0]);
snprintf(buf, sizeof(buf), "%s %d", nam, pc[0]);
break;
/* Instructions with two operands */
case APPTERM:
@ -142,16 +142,16 @@ char * caml_instr_string (code_t pc)
case BGEINT:
case BULTINT:
case BUGEINT:
sprintf(buf, "%s %d, %d", nam, pc[0], pc[1]);
snprintf(buf, sizeof(buf), "%s %d, %d", nam, pc[0], pc[1]);
break;
case SWITCH:
sprintf(buf, "SWITCH sz%#lx=%ld::ntag%ld nint%ld",
snprintf(buf, sizeof(buf), "SWITCH sz%#lx=%ld::ntag%ld nint%ld",
(long) pc[0], (long) pc[0], (unsigned long) pc[0] >> 16,
(unsigned long) pc[0] & 0xffff);
break;
/* Instructions with a C primitive as operand */
case C_CALLN:
sprintf(buf, "%s %d,", nam, pc[0]);
snprintf(buf, sizeof(buf), "%s %d,", nam, pc[0]);
pc++;
/* fallthrough */
case C_CALL1:
@ -160,12 +160,13 @@ char * caml_instr_string (code_t pc)
case C_CALL4:
case C_CALL5:
if (pc[0] < 0 || pc[0] >= caml_prim_name_table.size)
sprintf(buf, "%s unknown primitive %d", nam, pc[0]);
snprintf(buf, sizeof(buf), "%s unknown primitive %d", nam, pc[0]);
else
sprintf(buf, "%s %s", nam, (char *) caml_prim_name_table.contents[pc[0]]);
snprintf(buf, sizeof(buf), "%s %s",
nam, (char *) caml_prim_name_table.contents[pc[0]]);
break;
default:
sprintf(buf, "%s", nam);
snprintf(buf, sizeof(buf), "%s", nam);
break;
};
return buf;

3
byterun/intern.c
View File

@ -738,7 +738,8 @@ static char * intern_resolve_code_pointer(unsigned char digest[16],
static void intern_bad_code_pointer(unsigned char digest[16])
{
char msg[256];
sprintf(msg, "input_value: unknown code module "
snprintf(msg, sizeof(msg),
"input_value: unknown code module "
"%02X%02X%02X%02X%02X%02X%02X%02X"
"%02X%02X%02X%02X%02X%02X%02X%02X",
digest[0], digest[1], digest[2], digest[3],

16
byterun/interp.c
View File

@ -181,14 +181,6 @@ sp is a local copy of the global variable caml_extern_sp. */
#endif
#endif
/* Division and modulus madness */
#ifdef NONSTANDARD_DIV_MOD
extern intnat caml_safe_div(intnat p, intnat q);
extern intnat caml_safe_mod(intnat p, intnat q);
#endif
#ifdef DEBUG
static intnat caml_bcodcount;
#endif
@ -962,21 +954,13 @@ value caml_interprete(code_t prog, asize_t prog_size)
Instruct(DIVINT): {
intnat divisor = Long_val(*sp++);
if (divisor == 0) { Setup_for_c_call; caml_raise_zero_divide(); }
#ifdef NONSTANDARD_DIV_MOD
accu = Val_long(caml_safe_div(Long_val(accu), divisor));
#else
accu = Val_long(Long_val(accu) / divisor);
#endif
Next;
}
Instruct(MODINT): {
intnat divisor = Long_val(*sp++);
if (divisor == 0) { Setup_for_c_call; caml_raise_zero_divide(); }
#ifdef NONSTANDARD_DIV_MOD
accu = Val_long(caml_safe_mod(Long_val(accu), divisor));
#else
accu = Val_long(Long_val(accu) % divisor);
#endif
Next;
}
Instruct(ANDINT):

228
byterun/ints.c
View File

@ -96,24 +96,6 @@ static intnat parse_intnat(value s, int nbits)
return sign < 0 ? -((intnat) res) : (intnat) res;
}
#ifdef NONSTANDARD_DIV_MOD
intnat caml_safe_div(intnat p, intnat q)
{
uintnat ap = p >= 0 ? p : -p;
uintnat aq = q >= 0 ? q : -q;
uintnat ar = ap / aq;
return (p ^ q) >= 0 ? ar : -ar;
}
intnat caml_safe_mod(intnat p, intnat q)
{
uintnat ap = p >= 0 ? p : -p;
uintnat aq = q >= 0 ? q : -q;
uintnat ar = ap % aq;
return p >= 0 ? ar : -ar;
}
#endif
value caml_bswap16_direct(value x)
{
return ((((x & 0x00FF) << 8) |
@ -142,13 +124,10 @@ CAMLprim value caml_int_of_string(value s)
#define FORMAT_BUFFER_SIZE 32
static char * parse_format(value fmt,
static char parse_format(value fmt,
char * suffix,
char format_string[],
char default_format_buffer[],
char *conv)
char format_string[FORMAT_BUFFER_SIZE])
{
int prec;
char * p;
char lastletter;
mlsize_t len, len_suffix;
@ -167,41 +146,25 @@ static char * parse_format(value fmt,
memmove(p, suffix, len_suffix); p += len_suffix;
*p++ = lastletter;
*p = 0;
/* Determine space needed for result and allocate it dynamically if needed */
prec = 22 + 5; /* 22 digits for 64-bit number in octal + 5 extra */
for (p = String_val(fmt); *p != 0; p++) {
if (*p >= '0' && *p <= '9') {
prec = atoi(p) + 5;
break;
}
}
*conv = lastletter;
if (prec < FORMAT_BUFFER_SIZE)
return default_format_buffer;
else
return caml_stat_alloc(prec + 1);
/* Return the conversion type (last letter) */
return lastletter;
}
CAMLprim value caml_format_int(value fmt, value arg)
{
char format_string[FORMAT_BUFFER_SIZE];
char default_format_buffer[FORMAT_BUFFER_SIZE];
char * buffer;
char conv;
value res;
buffer = parse_format(fmt, ARCH_INTNAT_PRINTF_FORMAT,
format_string, default_format_buffer, &conv);
conv = parse_format(fmt, ARCH_INTNAT_PRINTF_FORMAT, format_string);
switch (conv) {
case 'u': case 'x': case 'X': case 'o':
sprintf(buffer, format_string, Unsigned_long_val(arg));
res = caml_alloc_sprintf(format_string, Unsigned_long_val(arg));
break;
default:
sprintf(buffer, format_string, Long_val(arg));
res = caml_alloc_sprintf(format_string, Long_val(arg));
break;
}
res = caml_copy_string(buffer);
if (buffer != default_format_buffer) caml_stat_free(buffer);
return res;
}
@ -269,11 +232,7 @@ CAMLprim value caml_int32_div(value v1, value v2)
/* PR#4740: on some processors, division crashes on overflow.
Implement the same behavior as for type "int". */
if (dividend == (1<<31) && divisor == -1) return v1;
#ifdef NONSTANDARD_DIV_MOD
return caml_copy_int32(caml_safe_div(dividend, divisor));
#else
return caml_copy_int32(dividend / divisor);
#endif
}
CAMLprim value caml_int32_mod(value v1, value v2)
@ -284,11 +243,7 @@ CAMLprim value caml_int32_mod(value v1, value v2)
/* PR#4740: on some processors, modulus crashes if division overflows.
Implement the same behavior as for type "int". */
if (dividend == (1<<31) && divisor == -1) return caml_copy_int32(0);
#ifdef NONSTANDARD_DIV_MOD
return caml_copy_int32(caml_safe_mod(dividend, divisor));
#else
return caml_copy_int32(dividend % divisor);
#endif
}
CAMLprim value caml_int32_and(value v1, value v2)
@ -346,17 +301,9 @@ CAMLprim value caml_int32_compare(value v1, value v2)
CAMLprim value caml_int32_format(value fmt, value arg)
{
char format_string[FORMAT_BUFFER_SIZE];
char default_format_buffer[FORMAT_BUFFER_SIZE];
char * buffer;
char conv;
value res;
buffer = parse_format(fmt, ARCH_INT32_PRINTF_FORMAT,
format_string, default_format_buffer, &conv);
sprintf(buffer, format_string, Int32_val(arg));
res = caml_copy_string(buffer);
if (buffer != default_format_buffer) caml_stat_free(buffer);
return res;
parse_format(fmt, ARCH_INT32_PRINTF_FORMAT, format_string);
return caml_alloc_sprintf(format_string, Int32_val(arg));
}
CAMLprim value caml_int32_of_string(value s)
@ -380,12 +327,6 @@ CAMLprim value caml_int32_float_of_bits(value vi)
/* 64-bit integers */
#ifdef ARCH_INT64_TYPE
#include "int64_native.h"
#else
#include "int64_emul.h"
#endif
#ifdef ARCH_ALIGN_INT64
CAMLexport int64 caml_Int64_val(value v)
@ -402,15 +343,13 @@ static int int64_cmp(value v1, value v2)
{
int64 i1 = Int64_val(v1);
int64 i2 = Int64_val(v2);
return I64_compare(i1, i2);
return (i1 > i2) - (i1 < i2);
}
static intnat int64_hash(value v)
{
int64 x = Int64_val(v);
uint32 lo, hi;
I64_split(x, hi, lo);
uint32 lo = (uint32) x, hi = (uint32) (x >> 32);
return hi ^ lo;
}
@ -459,59 +398,58 @@ CAMLexport value caml_copy_int64(int64 i)
}
CAMLprim value caml_int64_neg(value v)
{ return caml_copy_int64(I64_neg(Int64_val(v))); }
{ return caml_copy_int64(- Int64_val(v)); }
CAMLprim value caml_int64_add(value v1, value v2)
{ return caml_copy_int64(I64_add(Int64_val(v1), Int64_val(v2))); }
{ return caml_copy_int64(Int64_val(v1) + Int64_val(v2)); }
CAMLprim value caml_int64_sub(value v1, value v2)
{ return caml_copy_int64(I64_sub(Int64_val(v1), Int64_val(v2))); }
{ return caml_copy_int64(Int64_val(v1) - Int64_val(v2)); }
CAMLprim value caml_int64_mul(value v1, value v2)
{ return caml_copy_int64(I64_mul(Int64_val(v1), Int64_val(v2))); }
{ return caml_copy_int64(Int64_val(v1) * Int64_val(v2)); }
#define Int64_min_int ((intnat) 1 << (sizeof(intnat) * 8 - 1))
CAMLprim value caml_int64_div(value v1, value v2)
{
int64 dividend = Int64_val(v1);
int64 divisor = Int64_val(v2);
if (I64_is_zero(divisor)) caml_raise_zero_divide();
if (divisor == 0) caml_raise_zero_divide();
/* PR#4740: on some processors, division crashes on overflow.
Implement the same behavior as for type "int". */
if (I64_is_min_int(dividend) && I64_is_minus_one(divisor)) return v1;
return caml_copy_int64(I64_div(Int64_val(v1), divisor));
if (dividend == ((int64)1 << 63) && divisor == -1) return v1;
return caml_copy_int64(Int64_val(v1) / divisor);
}
CAMLprim value caml_int64_mod(value v1, value v2)
{
int64 dividend = Int64_val(v1);
int64 divisor = Int64_val(v2);
if (I64_is_zero(divisor)) caml_raise_zero_divide();
if (divisor == 0) caml_raise_zero_divide();
/* PR#4740: on some processors, division crashes on overflow.
Implement the same behavior as for type "int". */
if (I64_is_min_int(dividend) && I64_is_minus_one(divisor)) {
int64 zero = I64_literal(0,0);
return caml_copy_int64(zero);
}
return caml_copy_int64(I64_mod(Int64_val(v1), divisor));
if (dividend == ((int64)1 << 63) && divisor == -1) return caml_copy_int64(0);
return caml_copy_int64(Int64_val(v1) % divisor);
}
CAMLprim value caml_int64_and(value v1, value v2)
{ return caml_copy_int64(I64_and(Int64_val(v1), Int64_val(v2))); }
{ return caml_copy_int64(Int64_val(v1) & Int64_val(v2)); }
CAMLprim value caml_int64_or(value v1, value v2)
{ return caml_copy_int64(I64_or(Int64_val(v1), Int64_val(v2))); }
{ return caml_copy_int64(Int64_val(v1) | Int64_val(v2)); }
CAMLprim value caml_int64_xor(value v1, value v2)
{ return caml_copy_int64(I64_xor(Int64_val(v1), Int64_val(v2))); }
{ return caml_copy_int64(Int64_val(v1) ^ Int64_val(v2)); }
CAMLprim value caml_int64_shift_left(value v1, value v2)
{ return caml_copy_int64(I64_lsl(Int64_val(v1), Int_val(v2))); }
{ return caml_copy_int64(Int64_val(v1) << Int_val(v2)); }
CAMLprim value caml_int64_shift_right(value v1, value v2)
{ return caml_copy_int64(I64_asr(Int64_val(v1), Int_val(v2))); }
{ return caml_copy_int64(Int64_val(v1) >> Int_val(v2)); }
CAMLprim value caml_int64_shift_right_unsigned(value v1, value v2)
{ return caml_copy_int64(I64_lsr(Int64_val(v1), Int_val(v2))); }
{ return caml_copy_int64((uint64) (Int64_val(v1)) >> Int_val(v2)); }
#ifdef ARCH_SIXTYFOUR
static value caml_swap64(value x)
@ -531,98 +469,92 @@ value caml_int64_direct_bswap(value v)
#endif
CAMLprim value caml_int64_bswap(value v)
{ return caml_copy_int64(I64_bswap(Int64_val(v))); }
CAMLprim value caml_int64_of_int(value v)
{ return caml_copy_int64(I64_of_intnat(Long_val(v))); }
CAMLprim value caml_int64_to_int(value v)
{ return Val_long(I64_to_intnat(Int64_val(v))); }
CAMLprim value caml_int64_of_float(value v)
{ return caml_copy_int64(I64_of_double(Double_val(v))); }
CAMLprim value caml_int64_to_float(value v)
{
int64 i = Int64_val(v);
return caml_copy_double(I64_to_double(i));
int64 x = Int64_val(v);
return caml_copy_int64
(((x & 0x00000000000000FFULL) << 56) |
((x & 0x000000000000FF00ULL) << 40) |
((x & 0x0000000000FF0000ULL) << 24) |
((x & 0x00000000FF000000ULL) << 8) |
((x & 0x000000FF00000000ULL) >> 8) |
((x & 0x0000FF0000000000ULL) >> 24) |
((x & 0x00FF000000000000ULL) >> 40) |
((x & 0xFF00000000000000ULL) >> 56));
}
CAMLprim value caml_int64_of_int(value v)
{ return caml_copy_int64((int64) (Long_val(v))); }
CAMLprim value caml_int64_to_int(value v)
{ return Val_long((intnat) (Int64_val(v))); }
CAMLprim value caml_int64_of_float(value v)
{ return caml_copy_int64((int64) (Double_val(v))); }
CAMLprim value caml_int64_to_float(value v)
{ return caml_copy_double((double) (Int64_val(v))); }
CAMLprim value caml_int64_of_int32(value v)
{ return caml_copy_int64(I64_of_int32(Int32_val(v))); }
{ return caml_copy_int64((int64) (Int32_val(v))); }
CAMLprim value caml_int64_to_int32(value v)
{ return caml_copy_int32(I64_to_int32(Int64_val(v))); }
{ return caml_copy_int32((int32) (Int64_val(v))); }
CAMLprim value caml_int64_of_nativeint(value v)
{ return caml_copy_int64(I64_of_intnat(Nativeint_val(v))); }
{ return caml_copy_int64((int64) (Nativeint_val(v))); }
CAMLprim value caml_int64_to_nativeint(value v)
{ return caml_copy_nativeint(I64_to_intnat(Int64_val(v))); }
{ return caml_copy_nativeint((intnat) (Int64_val(v))); }
CAMLprim value caml_int64_compare(value v1, value v2)
{
int64 i1 = Int64_val(v1);
int64 i2 = Int64_val(v2);
return Val_int(I64_compare(i1, i2));
return Val_int((i1 > i2) - (i1 < i2));
}
#ifdef ARCH_INT64_PRINTF_FORMAT
#define I64_format(buf,fmt,x) sprintf(buf,fmt,x)
#else
#include "int64_format.h"
#define ARCH_INT64_PRINTF_FORMAT ""
#endif
CAMLprim value caml_int64_format(value fmt, value arg)
{
char format_string[FORMAT_BUFFER_SIZE];
char default_format_buffer[FORMAT_BUFFER_SIZE];
char * buffer;
char conv;
value res;
buffer = parse_format(fmt, ARCH_INT64_PRINTF_FORMAT,
format_string, default_format_buffer, &conv);
I64_format(buffer, format_string, Int64_val(arg));
res = caml_copy_string(buffer);
if (buffer != default_format_buffer) caml_stat_free(buffer);
return res;
parse_format(fmt, ARCH_INT64_PRINTF_FORMAT, format_string);
return caml_alloc_sprintf(format_string, Int64_val(arg));
}
CAMLprim value caml_int64_of_string(value s)
{
char * p;
uint64 max_uint64 = I64_literal(0xFFFFFFFF, 0xFFFFFFFF);
uint64 max_int64_pos = I64_literal(0x7FFFFFFF, 0xFFFFFFFF);
uint64 max_int64_neg = I64_literal(0x80000000, 0x00000000);
uint64 res, threshold;
int sign, base, d;
p = parse_sign_and_base(String_val(s), &base, &sign);
I64_udivmod(max_uint64, I64_of_int32(base), &threshold, &res);
threshold = ((uint64) -1) / base;
d = parse_digit(*p);
if (d < 0 || d >= base) caml_failwith("int_of_string");
res = I64_of_int32(d);
res = d;
for (p++; /*nothing*/; p++) {
char c = *p;
if (c == '_') continue;
d = parse_digit(c);
if (d < 0 || d >= base) break;
/* Detect overflow in multiplication base * res */
if (I64_ult(threshold, res)) caml_failwith("int_of_string");
res = I64_add(I64_mul(I64_of_int32(base), res), I64_of_int32(d));
if (res > threshold) caml_failwith("int_of_string");
res = base * res + d;
/* Detect overflow in addition (base * res) + d */
if (I64_ult(res, I64_of_int32(d))) caml_failwith("int_of_string");
if (res < (uint64) d) caml_failwith("int_of_string");
}
if (p != String_val(s) + caml_string_length(s)){
caml_failwith("int_of_string");
}
if (base == 10) {
if (I64_ult((sign >= 0 ? max_int64_pos : max_int64_neg), res))
caml_failwith("int_of_string");
/* Signed representation expected, allow -2^63 to 2^63 - 1 only */
if (sign >= 0) {
if (res >= (uint64)1 << 63) caml_failwith("int_of_string");
} else {
if (res > (uint64)1 << 63) caml_failwith("int_of_string");
}
if (sign < 0) res = I64_neg(res);
}
if (sign < 0) res = - res;
return caml_copy_int64(res);
}
@ -745,11 +677,7 @@ CAMLprim value caml_nativeint_div(value v1, value v2)
/* PR#4740: on some processors, modulus crashes if division overflows.
Implement the same behavior as for type "int". */
if (dividend == Nativeint_min_int && divisor == -1) return v1;
#ifdef NONSTANDARD_DIV_MOD
return caml_copy_nativeint(caml_safe_div(dividend, divisor));
#else
return caml_copy_nativeint(dividend / divisor);
#endif
}
CAMLprim value caml_nativeint_mod(value v1, value v2)
@ -762,11 +690,7 @@ CAMLprim value caml_nativeint_mod(value v1, value v2)
if (dividend == Nativeint_min_int && divisor == -1){
return caml_copy_nativeint(0);
}
#ifdef NONSTANDARD_DIV_MOD
return caml_copy_nativeint(caml_safe_mod(dividend, divisor));
#else
return caml_copy_nativeint(dividend % divisor);
#endif
}
CAMLprim value caml_nativeint_and(value v1, value v2)
@ -834,17 +758,9 @@ CAMLprim value caml_nativeint_compare(value v1, value v2)
CAMLprim value caml_nativeint_format(value fmt, value arg)
{
char format_string[FORMAT_BUFFER_SIZE];
char default_format_buffer[FORMAT_BUFFER_SIZE];
char * buffer;
char conv;
value res;
buffer = parse_format(fmt, ARCH_INTNAT_PRINTF_FORMAT,
format_string, default_format_buffer, &conv);
sprintf(buffer, format_string, Nativeint_val(arg));
res = caml_copy_string(buffer);
if (buffer != default_format_buffer) caml_stat_free(buffer);
return res;
parse_format(fmt, ARCH_INTNAT_PRINTF_FORMAT, format_string);
return caml_alloc_sprintf(format_string, Nativeint_val(arg));
}
CAMLprim value caml_nativeint_of_string(value s)

18
byterun/io.c
View File

@ -791,21 +791,3 @@ CAMLprim value caml_ml_input_scan_line(value vchannel)
Unlock(channel);
CAMLreturn (Val_long(res));
}
/* Conversion between file_offset and int64 */
#ifndef ARCH_INT64_TYPE
CAMLexport value caml_Val_file_offset(file_offset fofs)
{
int64 ofs;
ofs.l = fofs;
ofs.h = 0;
return caml_copy_int64(ofs);
}
CAMLexport file_offset caml_File_offset_val(value v)
{
int64 ofs = Int64_val(v);
return (file_offset) ofs.l;
}
#endif

7
byterun/io.h
View File

@ -109,14 +109,7 @@ CAMLextern struct channel * caml_all_opened_channels;
/* Conversion between file_offset and int64 */
#ifdef ARCH_INT64_TYPE
#define Val_file_offset(fofs) caml_copy_int64(fofs)
#define File_offset_val(v) ((file_offset) Int64_val(v))
#else
CAMLextern value caml_Val_file_offset(file_offset fofs);
CAMLextern file_offset caml_File_offset_val(value v);
#define Val_file_offset caml_Val_file_offset
#define File_offset_val caml_File_offset_val
#endif
#endif /* CAML_IO_H */

2
byterun/lexing.c
View File

@ -49,7 +49,7 @@ struct lexing_table {
#if defined(ARCH_BIG_ENDIAN) || SIZEOF_SHORT != 2
#define Short(tbl,n) \
(*((unsigned char *)((tbl) + (n) * 2)) + \
(*((schar *)((tbl) + (n) * 2 + 1)) << 8))
(*((signed char *)((tbl) + (n) * 2 + 1)) << 8))
#else
#define Short(tbl,n) (((short *)(tbl))[(n)])
#endif

8
byterun/memory.c
View File

@ -581,14 +581,6 @@ CAMLexport void * caml_stat_alloc (asize_t sz)
return result;
}
CAMLexport char * caml_stat_alloc_string(value str)
{
mlsize_t sz = caml_string_length(str) + 1;
char * p = caml_stat_alloc(sz);
memcpy(p, String_val(str), sz);
return p;
}
CAMLexport void caml_stat_free (void * blk)
{
free (blk);

1
byterun/memory.h
View File

@ -41,7 +41,6 @@ CAMLextern void caml_modify (value *, value);
CAMLextern void caml_initialize (value *, value);
CAMLextern value caml_check_urgent_gc (value);
CAMLextern void * caml_stat_alloc (asize_t); /* Size in bytes. */
CAMLextern char * caml_stat_alloc_string (value);
CAMLextern void caml_stat_free (void *);
CAMLextern void * caml_stat_resize (void *, asize_t); /* Size in bytes. */
char *caml_alloc_for_heap (asize_t request); /* Size in bytes. */

38
byterun/misc.c
View File

@ -12,6 +12,8 @@
/***********************************************************************/
#include <stdio.h>
#include <string.h>
#include <stdarg.h>
#include "config.h"
#include "misc.h"
#include "memory.h"
@ -121,3 +123,39 @@ void caml_ext_table_free(struct ext_table * tbl, int free_entries)
for (i = 0; i < tbl->size; i++) caml_stat_free(tbl->contents[i]);
caml_stat_free(tbl->contents);
}
CAMLexport char * caml_strdup(const char * s)
{
size_t slen = strlen(s);
char * res = caml_stat_alloc(slen + 1);
memcpy(res, s, slen + 1);
return res;
}
CAMLexport char * caml_strconcat(int n, ...)
{
va_list args;
char * res, * p;
size_t len;
int i;
len = 0;
va_start(args, n);
for (i = 0; i < n; i++) {
const char * s = va_arg(args, const char *);
len += strlen(s);
}
va_end(args);
res = caml_stat_alloc(len + 1);
va_start(args, n);
p = res;
for (i = 0; i < n; i++) {
const char * s = va_arg(args, const char *);
size_t l = strlen(s);
memcpy(p, s, l);
p += l;
}
va_end(args);
*p = 0;
return res;
}

16
byterun/misc.h
View File

@ -61,8 +61,6 @@ typedef char * addr;
/* Assertions */
/* <private> */
#ifdef DEBUG
#define CAMLassert(x) \
((x) ? (void) 0 : caml_failed_assert ( #x , __FILE__, __LINE__))
@ -76,6 +74,13 @@ CAMLextern void caml_fatal_error_arg (char *fmt, char *arg) Noreturn;
CAMLextern void caml_fatal_error_arg2 (char *fmt1, char *arg1,
char *fmt2, char *arg2) Noreturn;
/* Safe string operations */
CAMLextern char * caml_strdup(const char * s);
CAMLextern char * caml_strconcat(int n, ...); /* n args of const char * type */
/* <private> */
/* Data structures */
struct ext_table {
@ -138,6 +143,13 @@ extern void caml_set_fields (char *, unsigned long, unsigned long);
#define Assert CAMLassert
#endif
/* snprintf emulation for Win32 */
#ifdef _WIN32
extern int caml_snprintf(char * buf, size_t size, const char * format, ...);
#define snprintf caml_snprintf
#endif
/* </private> */
#endif /* CAML_MISC_H */

2
byterun/parsing.c
View File

@ -63,7 +63,7 @@ struct parser_env { /* Mirrors parser_env in ../stdlib/parsing.ml */
#if defined(ARCH_BIG_ENDIAN) || SIZEOF_SHORT != 2
#define Short(tbl,n) \
(*((unsigned char *)((tbl) + (n) * 2)) + \
(*((schar *)((tbl) + (n) * 2 + 1)) << 8))
(*((signed char *)((tbl) + (n) * 2 + 1)) << 8))
#else
#define Short(tbl,n) (((short *)(tbl))[n])
#endif

3
byterun/printexc.c
View File

@ -71,7 +71,8 @@ CAMLexport char * caml_format_exception(value exn)
if (i > start) add_string(&buf, ", ");
v = Field(bucket, i);
if (Is_long(v)) {
sprintf(intbuf, "%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val(v));
snprintf(intbuf, sizeof(intbuf),
"%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val(v));
add_string(&buf, intbuf);
} else if (Tag_val(v) == String_tag) {
add_char(&buf, '"');

5
byterun/startup.c
View File

@ -459,7 +459,7 @@ CAMLexport void caml_startup_code(
char **argv)
{
value res;
char* cds_file;
char * cds_file;
char * exe_name;
static char proc_self_exe[256];
@ -473,8 +473,7 @@ CAMLexport void caml_startup_code(
#endif
cds_file = getenv("CAML_DEBUG_FILE");
if (cds_file != NULL) {
caml_cds_file = caml_stat_alloc(strlen(cds_file) + 1);
strcpy(caml_cds_file, cds_file);
caml_cds_file = caml_strdup(cds_file);
}
parse_camlrunparam();
exe_name = argv[0];

124
byterun/str.c
View File

@ -15,6 +15,8 @@
#include <string.h>
#include <ctype.h>
#include <stdio.h>
#include <stdarg.h>
#include "alloc.h"
#include "fail.h"
#include "mlvalues.h"
@ -97,16 +99,9 @@ CAMLprim value caml_string_get32(value str, value index)
return caml_copy_int32(res);
}
#ifdef ARCH_INT64_TYPE
#include "int64_native.h"
#else
#include "int64_emul.h"
#endif
CAMLprim value caml_string_get64(value str, value index)
{
uint32 reshi;
uint32 reslo;
uint64 res;
unsigned char b1, b2, b3, b4, b5, b6, b7, b8;
intnat idx = Long_val(index);
if (idx < 0 || idx + 7 >= caml_string_length(str)) caml_array_bound_error();
@ -119,13 +114,17 @@ CAMLprim value caml_string_get64(value str, value index)
b7 = Byte_u(str, idx + 6);
b8 = Byte_u(str, idx + 7);
#ifdef ARCH_BIG_ENDIAN
reshi = b1 << 24 | b2 << 16 | b3 << 8 | b4;
reslo = b5 << 24 | b6 << 16 | b7 << 8 | b8;
res = (uint64) b1 << 56 | (uint64) b2 << 48
| (uint64) b3 << 40 | (uint64) b4 << 32
| (uint64) b5 << 24 | (uint64) b6 << 16
| (uint64) b7 << 8 | (uint64) b8;
#else
reshi = b8 << 24 | b7 << 16 | b6 << 8 | b5;
reslo = b4 << 24 | b3 << 16 | b2 << 8 | b1;
res = (uint64) b8 << 56 | (uint64) b7 << 48
| (uint64) b6 << 40 | (uint64) b5 << 32
| (uint64) b4 << 24 | (uint64) b3 << 16
| (uint64) b2 << 8 | (uint64) b1;
#endif
return caml_copy_int64(I64_literal(reshi,reslo));
return caml_copy_int64(res);
}
CAMLprim value caml_string_set16(value str, value index, value newval)
@ -175,30 +174,28 @@ CAMLprim value caml_string_set32(value str, value index, value newval)
CAMLprim value caml_string_set64(value str, value index, value newval)
{
unsigned char b1, b2, b3, b4, b5, b6, b7, b8;
uint32 lo,hi;
int64 val;
intnat idx = Long_val(index);
if (idx < 0 || idx + 7 >= caml_string_length(str)) caml_array_bound_error();
val = Int64_val(newval);
I64_split(val,hi,lo);
#ifdef ARCH_BIG_ENDIAN
b1 = 0xFF & hi >> 24;
b2 = 0xFF & hi >> 16;
b3 = 0xFF & hi >> 8;
b4 = 0xFF & hi;
b5 = 0xFF & lo >> 24;
b6 = 0xFF & lo >> 16;
b7 = 0xFF & lo >> 8;
b8 = 0xFF & lo;
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;
#else
b8 = 0xFF & hi >> 24;
b7 = 0xFF & hi >> 16;
b6 = 0xFF & hi >> 8;
b5 = 0xFF & hi;
b4 = 0xFF & lo >> 24;
b3 = 0xFF & lo >> 16;
b2 = 0xFF & lo >> 8;
b1 = 0xFF & lo;
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;
#endif
Byte_u(str, idx) = b1;
Byte_u(str, idx + 1) = b2;
@ -299,3 +296,68 @@ CAMLprim value caml_bitvect_test(value bv, value n)
int pos = Int_val(n);
return Val_int(Byte_u(bv, pos >> 3) & (1 << (pos & 7)));
}
CAMLexport value caml_alloc_sprintf(const char * format, ...)
{
va_list args;
char buf[64];
int n;
value res;
#ifndef _WIN32
/* C99-compliant implementation */
va_start(args, format);
/* "vsnprintf(dest, sz, format, args)" writes at most "sz" characters
into "dest", including the terminating '\0'.
It returns the number of characters of the formatted string,
excluding the terminating '\0'. */
n = vsnprintf(buf, sizeof(buf), format, args);
va_end(args);
/* Allocate a Caml string with length "n" as computed by vsnprintf. */
res = caml_alloc_string(n);
if (n < sizeof(buf)) {
/* All output characters were written to buf, including the
terminating '\0'. Just copy them to the result. */
memcpy(String_val(res), buf, n);
} else {
/* 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);
vsnprintf(String_val(res), n + 1, format, args);
va_end(args);
}
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.
Copy the characters to a Caml string of length n. */
res = caml_alloc_string(n);
memcpy(String_val(res), buf, n);
} else {
/* 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);
_vsnprintf(String_val(res), n + 1, format, args);
va_end(args);
}
return res;
#endif
}

18
byterun/sys.c
View File

@ -125,7 +125,7 @@ CAMLprim value caml_sys_open(value path, value vflags, value vperm)
int fd, flags, perm;
char * p;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
flags = caml_convert_flag_list(vflags, sys_open_flags);
perm = Int_val(vperm);
/* open on a named FIFO can block (PR#1533) */
@ -156,7 +156,7 @@ CAMLprim value caml_sys_file_exists(value name)
char * p;
int ret;
p = caml_stat_alloc_string(name);
p = caml_strdup(String_val(name));
caml_enter_blocking_section();
ret = stat(p, &st);
caml_leave_blocking_section();
@ -172,7 +172,7 @@ CAMLprim value caml_sys_is_directory(value name)
char * p;
int ret;
p = caml_stat_alloc_string(name);
p = caml_strdup(String_val(name));
caml_enter_blocking_section();
ret = stat(p, &st);
caml_leave_blocking_section();
@ -191,7 +191,7 @@ CAMLprim value caml_sys_remove(value name)
CAMLparam1(name);
char * p;
int ret;
p = caml_stat_alloc_string(name);
p = caml_strdup(String_val(name));
caml_enter_blocking_section();
ret = unlink(p);
caml_leave_blocking_section();
@ -205,8 +205,8 @@ CAMLprim value caml_sys_rename(value oldname, value newname)
char * p_old;
char * p_new;
int ret;
p_old = caml_stat_alloc_string(oldname);
p_new = caml_stat_alloc_string(newname);
p_old = caml_strdup(String_val(oldname));
p_new = caml_strdup(String_val(newname));
caml_enter_blocking_section();
ret = rename(p_old, p_new);
caml_leave_blocking_section();
@ -222,7 +222,7 @@ CAMLprim value caml_sys_chdir(value dirname)
CAMLparam1(dirname);
char * p;
int ret;
p = caml_stat_alloc_string(dirname);
p = caml_strdup(String_val(dirname));
caml_enter_blocking_section();
ret = chdir(p);
caml_leave_blocking_section();
@ -289,7 +289,7 @@ CAMLprim value caml_sys_system_command(value command)
int status, retcode;
char *buf;
buf = caml_stat_alloc_string(command);
buf = caml_strdup(String_val(command));
caml_enter_blocking_section ();
status = system(buf);
caml_leave_blocking_section ();
@ -430,7 +430,7 @@ CAMLprim value caml_sys_read_directory(value path)
int ret;
caml_ext_table_init(&tbl, 50);
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = caml_read_directory(p, &tbl);
caml_leave_blocking_section();

56
byterun/unix.c
View File

@ -49,11 +49,10 @@
char * caml_decompose_path(struct ext_table * tbl, char * path)
{
char * p, * q;
int n;
size_t n;
if (path == NULL) return NULL;
p = caml_stat_alloc(strlen(path) + 1);
strcpy(p, path);
p = caml_strdup(path);
q = p;
while (1) {
for (n = 0; q[n] != 0 && q[n] != ':'; n++) /*nothing*/;
@ -68,7 +67,7 @@ char * caml_decompose_path(struct ext_table * tbl, char * path)
char * caml_search_in_path(struct ext_table * path, char * name)
{
char * p, * fullname;
char * p, * dir, * fullname;
int i;
struct stat st;
@ -76,18 +75,15 @@ char * caml_search_in_path(struct ext_table * path, char * name)
if (*p == '/') goto not_found;
}
for (i = 0; i < path->size; i++) {
fullname = caml_stat_alloc(strlen((char *)(path->contents[i])) +
strlen(name) + 2);
strcpy(fullname, (char *)(path->contents[i]));
if (fullname[0] != 0) strcat(fullname, "/");
strcat(fullname, name);
if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode)) return fullname;
dir = path->contents[i];
if (dir[0] == 0) dir = "."; /* empty path component = current dir */
fullname = caml_strconcat(3, dir, "/", name);
if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode))
return fullname;
caml_stat_free(fullname);
}
not_found:
fullname = caml_stat_alloc(strlen(name) + 1);
strcpy(fullname, name);
return fullname;
return caml_strdup(name);
}
#ifdef __CYGWIN32__
@ -107,31 +103,28 @@ static int cygwin_file_exists(char * name)
static char * cygwin_search_exe_in_path(struct ext_table * path, char * name)
{
char * p, * fullname;
char * p, * dir, * fullname;
int i;
for (p = name; *p != 0; p++) {
if (*p == '/' || *p == '\\') goto not_found;
}
for (i = 0; i < path->size; i++) {
fullname = caml_stat_alloc(strlen((char *)(path->contents[i])) +
strlen(name) + 6);
strcpy(fullname, (char *)(path->contents[i]));
strcat(fullname, "/");
strcat(fullname, name);
dir = path->contents[i];
if (dir[0] == 0) dir = "."; /* empty path component = current dir */
fullname = caml_strconcat(3, dir, "/", name);
if (cygwin_file_exists(fullname)) return fullname;
strcat(fullname, ".exe");
caml_stat_free(fullname);
fullname = caml_strconcat(4, dir, "/", name, ".exe");
if (cygwin_file_exists(fullname)) return fullname;
caml_stat_free(fullname);
}
not_found:
fullname = caml_stat_alloc(strlen(name) + 5);
strcpy(fullname, name);
if (cygwin_file_exists(name)) return caml_strdup(name);
fullname = caml_strconcat(2, name, ".exe");
if (cygwin_file_exists(fullname)) return fullname;
strcat(fullname, ".exe");
if (cygwin_file_exists(fullname)) return fullname;
strcpy(fullname, name);
return fullname;
caml_stat_free(fullname);
return caml_strdup(name);
}
#endif
@ -156,10 +149,10 @@ char * caml_search_exe_in_path(char * name)
char * caml_search_dll_in_path(struct ext_table * path, char * name)
{
char * dllname = caml_stat_alloc(strlen(name) + 4);
char * dllname;
char * res;
strcpy(dllname, name);
strcat(dllname, ".so");
dllname = caml_strconcat(2, name, ".so");
res = caml_search_in_path(path, dllname);
caml_stat_free(dllname);
return res;
@ -286,7 +279,6 @@ int caml_read_directory(char * dirname, struct ext_table * contents)
#else
struct direct * e;
#endif
char * p;
d = opendir(dirname);
if (d == NULL) return -1;
@ -294,9 +286,7 @@ int caml_read_directory(char * dirname, struct ext_table * contents)
e = readdir(d);
if (e == NULL) break;
if (strcmp(e->d_name, ".") == 0 || strcmp(e->d_name, "..") == 0) continue;
p = caml_stat_alloc(strlen(e->d_name) + 1);
strcpy(p, e->d_name);
caml_ext_table_add(contents, p);
caml_ext_table_add(contents, caml_strdup(e->d_name));
}
closedir(d);
return 0;

121
byterun/win32.c
View File

@ -16,6 +16,7 @@
#include <windows.h>
#include <stdlib.h>
#include <stdio.h>
#include <stdarg.h>
#include <io.h>
#include <fcntl.h>
#include <sys/types.h>
@ -43,8 +44,7 @@ char * caml_decompose_path(struct ext_table * tbl, char * path)
int n;
if (path == NULL) return NULL;
p = caml_stat_alloc(strlen(path) + 1);
strcpy(p, path);
p = caml_strdup(path);
q = p;
while (1) {
for (n = 0; q[n] != 0 && q[n] != ';'; n++) /*nothing*/;
@ -59,7 +59,7 @@ char * caml_decompose_path(struct ext_table * tbl, char * path)
char * caml_search_in_path(struct ext_table * path, char * name)
{
char * p, * fullname;
char * p, * dir, * fullname;
int i;
struct stat st;
@ -67,56 +67,55 @@ char * caml_search_in_path(struct ext_table * path, char * name)
if (*p == '/' || *p == '\\') goto not_found;
}
for (i = 0; i < path->size; i++) {
fullname = caml_stat_alloc(strlen((char *)(path->contents[i])) +
strlen(name) + 2);
strcpy(fullname, (char *)(path->contents[i]));
strcat(fullname, "\\");
strcat(fullname, name);
dir = path->contents[i];
if (dir[0] == 0) continue;
/* not sure what empty path components mean under Windows */
fullname = caml_strconcat(3, dir, "\\", name);
caml_gc_message(0x100, "Searching %s\n", (uintnat) fullname);
if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode)) return fullname;
if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode))
return fullname;
caml_stat_free(fullname);
}
not_found:
caml_gc_message(0x100, "%s not found in search path\n", (uintnat) name);
fullname = caml_stat_alloc(strlen(name) + 1);
strcpy(fullname, name);
return fullname;
return caml_strdup(name);
}
CAMLexport char * caml_search_exe_in_path(char * name)
{
char * fullname, * filepart;
DWORD pathlen, retcode;
size_t fullnamelen;
DWORD retcode;
pathlen = strlen(name) + 1;
if (pathlen < 256) pathlen = 256;
fullnamelen = strlen(name) + 1;
if (fullnamelen < 256) fullnamelen = 256;
while (1) {
fullname = caml_stat_alloc(pathlen);
fullname = caml_stat_alloc(fullnamelen);
retcode = SearchPath(NULL, /* use system search path */
name,
".exe", /* add .exe extension if needed */
pathlen,
fullnamelen,
fullname,
&filepart);
if (retcode == 0) {
caml_gc_message(0x100, "%s not found in search path\n",
(uintnat) name);
strcpy(fullname, name);
break;
}
if (retcode < pathlen) break;
caml_stat_free(fullname);
pathlen = retcode + 1;
return caml_strdup(name);
}
if (retcode < fullnamelen)
return fullname;
caml_stat_free(fullname);
fullnamelen = retcode + 1;
}
}
char * caml_search_dll_in_path(struct ext_table * path, char * name)
{
char * dllname = caml_stat_alloc(strlen(name) + 5);
char * dllname;
char * res;
strcpy(dllname, name);
strcat(dllname, ".dll");
dllname = caml_strconcat(2, name, ".dll");
res = caml_search_in_path(path, dllname);
caml_stat_free(dllname);
return res;
@ -235,27 +234,27 @@ static void expand_argument(char * arg)
static void expand_pattern(char * pat)
{
char * prefix, * p, * name;
int handle;
struct _finddata_t ffblk;
int preflen;
size_t i;
handle = _findfirst(pat, &ffblk);
if (handle == -1) {
store_argument(pat); /* a la Bourne shell */
return;
}
for (preflen = strlen(pat); preflen > 0; preflen--) {
char c = pat[preflen - 1];
if (c == '\\' || c == '/' || c == ':') break;
prefix = caml_strdup(pat);
for (i = strlen(prefix); i > 0; i--) {
char c = prefix[i - 1];
if (c == '\\' || c == '/' || c == ':') { prefix[i] = 0; break; }
}
do {
char * name = malloc(preflen + strlen(ffblk.name) + 1);
if (name == NULL) out_of_memory();
memcpy(name, pat, preflen);
strcpy(name + preflen, ffblk.name);
name = caml_strconcat(2, prefix, ffblk.name);
store_argument(name);
} while (_findnext(handle, &ffblk) != -1);
_findclose(handle);
caml_stat_free(prefix);
}
@ -278,7 +277,7 @@ CAMLexport void caml_expand_command_line(int * argcp, char *** argvp)
int caml_read_directory(char * dirname, struct ext_table * contents)
{
int dirnamelen;
size_t dirnamelen;
char * template;
#if _MSC_VER <= 1200
int h;
@ -286,28 +285,27 @@ int caml_read_directory(char * dirname, struct ext_table * contents)
intptr_t h;
#endif
struct _finddata_t fileinfo;
char * p;
dirnamelen = strlen(dirname);
template = caml_stat_alloc(dirnamelen + 5);
strcpy(template, dirname);
switch (dirname[dirnamelen - 1]) {
case '/': case '\\': case ':':
strcat(template, "*.*"); break;
default:
strcat(template, "\\*.*");
}
if (dirnamelen > 0 &&
(dirname[dirnamelen - 1] == '/'
|| dirname[dirnamelen - 1] == '\\'
|| dirname[dirnamelen - 1] == ':'))
template = caml_strconcat(2, dirname, "*.*");
else
template = caml_strconcat(2, dirname, "\\*.*");
h = _findfirst(template, &fileinfo);
caml_stat_free(template);
if (h == -1) return errno == ENOENT ? 0 : -1;
if (h == -1) {
caml_strbuf_free(&template);
return errno == ENOENT ? 0 : -1;
}
do {
if (strcmp(fileinfo.name, ".") != 0 && strcmp(fileinfo.name, "..") != 0) {
p = caml_stat_alloc(strlen(fileinfo.name) + 1);
strcpy(p, fileinfo.name);
caml_ext_table_add(contents, p);
caml_ext_table_add(contents, caml_strdup(fileinfo.name));
}
} while (_findnext(h, &fileinfo) == 0);
_findclose(h);
caml_stat_free(template);
return 0;
}
@ -514,3 +512,30 @@ int caml_executable_name(char * name, int name_len)
if (0 == ret || ret >= name_len) return -1;
return 0;
}
/* snprintf emulation */
int caml_snprintf(char * buf, size_t size, const char * format, ...)
{
int len;
va_list args;
if (size > 0) {
va_start(args, format);
len = _vsnprintf(buf, size, format, args);
va_end(args);
if (len >= 0 && len < size) {
/* [len] characters were stored in [buf],
a null-terminator was appended. */
return len;
}
/* [size] characters were stored in [buf], without null termination.
Put a null terminator, truncating the output. */
buf[size - 1] = 0;
}
/* Compute the actual length of output, excluding null terminator */
va_start(args, format);
len = _vscprintf(format, args);
va_end(args);
return len;
}

18
config/auto-aux/int64align.c
View File

@ -16,9 +16,19 @@
#include <setjmp.h>
#include "m.h"
ARCH_INT64_TYPE foo;
#if defined(ARCH_INT64_TYPE)
typedef ARCH_INT64_TYPE int64;
#elif SIZEOF_LONG == 8
typedef long int64;
#elif SIZEOF_LONGLONG == 8
typedef long long int64;
#else
#error "No 64-bit integer type available"
#endif
void access_int64(ARCH_INT64_TYPE *p)
int64 foo;
void access_int64(int64 *p)
{
foo = *p;
}
@ -39,8 +49,8 @@ int main(void)
signal(SIGBUS, sig_handler);
#endif
if(setjmp(failure) == 0) {
access_int64((ARCH_INT64_TYPE *) n);
access_int64((ARCH_INT64_TYPE *) (n+1));
access_int64((int64 *) n);
access_int64((int64 *) (n+1));
res = 0;
} else {
res = 1;

5
config/auto-aux/sizes.c
View File

@ -15,7 +15,8 @@
int main(int argc, char **argv)
{
printf("%d %d %d %d\n",
sizeof(int), sizeof(long), sizeof(long *), sizeof(short));
printf("%d %d %d %d %d\n",
sizeof(int), sizeof(long), sizeof(long *), sizeof(short),
sizeof(long long));
return 0;
}

94
configure vendored
View File

@ -470,26 +470,27 @@ fi
echo "CAMLRUN=$CAMLRUN" >> Makefile
# Check the sizes of data types
# OCaml needs a 32 or 64bit architectue and a 32-bit integer type.
# OCaml needs a 32 or 64 bit architecture, a 32-bit integer type and
# a 64-bit integer type
inf "Checking the sizes of integers and pointers..."
ret=`sh ./runtest sizes.c`
# $1 = sizeof(int)
# $2 = sizeof(long)
# $3 = sizeof(pointers)
# $4 = sizeof(short)
# $5 = sizeof(long long)
if test "$?" -eq 0; then
set $ret
case "$2,$3" in
4,4) inf "OK, this is a regular 32 bit architecture."
case "$3" in
4) inf "OK, this is a regular 32 bit architecture."
echo "#undef ARCH_SIXTYFOUR" >> m.h
arch64=false;;
*,8) inf "Wow! A 64 bit architecture!"
8) inf "Wow! A 64 bit architecture!"
echo "#define ARCH_SIXTYFOUR" >> m.h
arch64=true
if test $1 != 4 && test $2 != 4 && test $4 != 4; then
err "Sorry, we can't find a 32-bit integer type\n" \
"(sizeof(short) = $4, sizeof(int) = $1, sizeof(long) = $2)\n" \
"OCaml won't run on this architecture."
fi;;
*,*) err "This architecture seems to be neither 32 bits nor 64 bits.\n" \
arch64=true;;
*) err "This architecture seems to be neither 32 bits nor 64 bits.\n" \
"OCaml won't run on this architecture.";;
esac
else
@ -497,11 +498,11 @@ else
case "$target" in
i686-*-mingw*) inf "OK, this is a regular 32 bit architecture."
echo "#undef ARCH_SIXTYFOUR" >> m.h
set 4 4 4 2
set 4 4 4 2 8
arch64=false;;
x86_64-*-mingw*) inf "Wow! A 64 bit architecture!"
echo "#define ARCH_SIXTYFOUR" >> m.h
set 4 4 8 2
set 4 4 8 2 8
arch64=true;;
*) err "Since datatype sizes cannot be guessed when cross-compiling,\n" \
"a hardcoded list is used but your architecture isn't known yet.\n" \
@ -510,56 +511,23 @@ else
esac
fi
if test $1 != 4 && test $2 != 4 && test $4 != 4; then
err "Sorry, we can't find a 32-bit integer type\n" \
"(sizeof(short) = $4, sizeof(int) = $1, sizeof(long) = $2)\n" \
"OCaml won't run on this architecture."
fi
if test $2 != 8 && test $5 != 8; then
err "Sorry, we can't find a 64-bit integer type\n" \
"(sizeof(long) = $2, sizeof(long long) = $5)\n" \
"OCaml won't run on this architecture."
fi
echo "#define SIZEOF_INT $1" >> m.h
echo "#define SIZEOF_LONG $2" >> m.h
echo "#define SIZEOF_PTR $3" >> m.h
echo "#define SIZEOF_SHORT $4" >> m.h
if test $2 = 8; then
echo "#define ARCH_INT64_TYPE long" >> m.h
echo "#define ARCH_UINT64_TYPE unsigned long" >> m.h
echo '#define ARCH_INT64_PRINTF_FORMAT "l"' >> m.h
int64_native=true
else
sh ./runtest longlong.c
case $? in
0) inf "64-bit \"long long\" integer type found (printf with \"%ll\")."
echo "#define ARCH_INT64_TYPE long long" >> m.h
echo "#define ARCH_UINT64_TYPE unsigned long long" >> m.h
echo '#define ARCH_INT64_PRINTF_FORMAT "ll"' >> m.h
int64_native=true;;
1) inf "64-bit \"long long\" integer type found (printf with \"%q\")."
echo "#define ARCH_INT64_TYPE long long" >> m.h
echo "#define ARCH_UINT64_TYPE unsigned long long" >> m.h
echo '#define ARCH_INT64_PRINTF_FORMAT "q"' >> m.h
int64_native=true;;
2) inf "64-bit \"long long\" integer type found (but no printf)."
echo "#define ARCH_INT64_TYPE long long" >> m.h
echo "#define ARCH_UINT64_TYPE unsigned long long" >> m.h
echo '#undef ARCH_INT64_PRINTF_FORMAT' >> m.h
int64_native=true;;
*)
case "$target" in
*-*-mingw*)
inf "No suitable 64-bit integer type found, will use software emulation."
echo "#define ARCH_INT64_TYPE long long" >> m.h
echo "#define ARCH_UINT64_TYPE unsigned long long" >> m.h
echo '#define ARCH_INT64_PRINTF_FORMAT "I64"' >> m.h
int64_native=true;;
*)
wrn "No suitable 64-bit integer type found, will use software emulation."
echo "#undef ARCH_INT64_TYPE" >> m.h
echo "#undef ARCH_UINT64_TYPE" >> m.h
echo '#undef ARCH_INT64_PRINTF_FORMAT' >> m.h
int64_native=false;;
esac;;
esac
fi
if test $3 = 8 && test $int64_native = false; then
err "This architecture has 64-bit pointers but no 64-bit integer type.\n" \
"OCaml won't run on this architecture."
fi
echo "#define SIZEOF_LONGLONG $5" >> m.h
# Determine endianness
@ -617,8 +585,7 @@ case "$target" in
esac;;
esac
if $int64_native; then
case "$target" in
case "$target" in
# PR#5088: autodetection is unreliable on ARM. PR#5280: also on MIPS.
sparc*-*-*|hppa*-*-*|arm*-*-*|mips*-*-*)
if test $2 = 8; then
@ -643,10 +610,7 @@ if $int64_native; then
"constraints." \
echo "#define ARCH_ALIGN_INT64" >> m.h;;
esac
esac
else
echo "#undef ARCH_ALIGN_INT64" >> m.h
fi
esac
# Check semantics of division and modulus

70
otherlibs/bigarray/bigarray_stubs.c
View File

@ -386,16 +386,9 @@ CAMLprim value caml_ba_uint8_get32(value vb, value vind)
return caml_copy_int32(res);
}
#ifdef ARCH_INT64_TYPE
#include "int64_native.h"
#else
#include "int64_emul.h"
#endif
CAMLprim value caml_ba_uint8_get64(value vb, value vind)
{
uint32 reshi;
uint32 reslo;
uint64 res;
unsigned char b1, b2, b3, b4, b5, b6, b7, b8;
intnat idx = Long_val(vind);
struct caml_ba_array * b = Caml_ba_array_val(vb);
@ -409,13 +402,17 @@ CAMLprim value caml_ba_uint8_get64(value vb, value vind)
b7 = ((unsigned char*) b->data)[idx+6];
b8 = ((unsigned char*) b->data)[idx+7];
#ifdef ARCH_BIG_ENDIAN
reshi = b1 << 24 | b2 << 16 | b3 << 8 | b4;
reslo = b5 << 24 | b6 << 16 | b7 << 8 | b8;
res = (uint64) b1 << 56 | (uint64) b2 << 48
| (uint64) b3 << 40 | (uint64) b4 << 32
| (uint64) b5 << 24 | (uint64) b6 << 16
| (uint64) b7 << 8 | (uint64) b8;
#else
reshi = b8 << 24 | b7 << 16 | b6 << 8 | b5;
reslo = b4 << 24 | b3 << 16 | b2 << 8 | b1;
res = (uint64) b8 << 56 | (uint64) b7 << 48
| (uint64) b6 << 40 | (uint64) b5 << 32
| (uint64) b4 << 24 | (uint64) b3 << 16
| (uint64) b2 << 8 | (uint64) b1;
#endif
return caml_copy_int64(I64_literal(reshi,reslo));
return caml_copy_int64(res);
}
/* Generic write to a big array */
@ -579,31 +576,29 @@ CAMLprim value caml_ba_uint8_set32(value vb, value vind, value newval)
CAMLprim value caml_ba_uint8_set64(value vb, value vind, value newval)
{
unsigned char b1, b2, b3, b4, b5, b6, b7, b8;
uint32 lo,hi;
intnat idx = Long_val(vind);
int64 val;
struct caml_ba_array * b = Caml_ba_array_val(vb);
if (idx < 0 || idx >= b->dim[0] - 7) caml_array_bound_error();
val = Int64_val(newval);
I64_split(val,hi,lo);
#ifdef ARCH_BIG_ENDIAN
b1 = 0xFF & hi >> 24;
b2 = 0xFF & hi >> 16;
b3 = 0xFF & hi >> 8;
b4 = 0xFF & hi;
b5 = 0xFF & lo >> 24;
b6 = 0xFF & lo >> 16;
b7 = 0xFF & lo >> 8;
b8 = 0xFF & lo;
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;
#else
b8 = 0xFF & hi >> 24;
b7 = 0xFF & hi >> 16;
b6 = 0xFF & hi >> 8;
b5 = 0xFF & hi;
b4 = 0xFF & lo >> 24;
b3 = 0xFF & lo >> 16;
b2 = 0xFF & lo >> 8;
b1 = 0xFF & lo;
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;
#endif
((unsigned char*) b->data)[idx] = b1;
((unsigned char*) b->data)[idx+1] = b2;
@ -767,20 +762,7 @@ static int caml_ba_compare(value v1, value v2)
case CAML_BA_INT32:
DO_INTEGER_COMPARISON(int32);
case CAML_BA_INT64:
#ifdef ARCH_INT64_TYPE
DO_INTEGER_COMPARISON(int64);
#else
{ int64 * p1 = b1->data; int64 * p2 = b2->data;
for (n = 0; n < num_elts; n++) {
int64 e1 = *p1++; int64 e2 = *p2++;
if ((int32)e1.h > (int32)e2.h) return 1;
if ((int32)e1.h < (int32)e2.h) return -1;
if (e1.l > e2.l) return 1;
if (e1.l < e2.l) return -1;
}
return 0;
}
#endif
case CAML_BA_CAML_INT:
case CAML_BA_NATIVE_INT:
DO_INTEGER_COMPARISON(intnat);

3
otherlibs/graph/open.c
View File

@ -244,8 +244,7 @@ value caml_gr_window_id(void)
value caml_gr_set_window_title(value n)
{
if (window_name != NULL) stat_free(window_name);
window_name = caml_stat_alloc(strlen(String_val(n))+1);
strcpy(window_name, String_val(n));
window_name = caml_strdup(String_val(n));
if (caml_gr_initialized) {
XStoreName(caml_gr_display, caml_gr_window.win, window_name);
XSetIconName(caml_gr_display, caml_gr_window.win, window_name);

2
otherlibs/unix/access.c
View File

@ -47,7 +47,7 @@ CAMLprim value unix_access(value path, value perms)
int ret, cv_flags;
cv_flags = convert_flag_list(perms, access_permission_table);
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = access(p, cv_flags);
caml_leave_blocking_section();

2
otherlibs/unix/chdir.c
View File

@ -21,7 +21,7 @@ CAMLprim value unix_chdir(value path)
CAMLparam1(path);
char * p;
int ret;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = chdir(p);
caml_leave_blocking_section();

2
otherlibs/unix/chmod.c
View File

@ -23,7 +23,7 @@ CAMLprim value unix_chmod(value path, value perm)
CAMLparam2(path, perm);
char * p;
int ret;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = chmod(p, Int_val(perm));
caml_leave_blocking_section();

2
otherlibs/unix/chown.c
View File

@ -21,7 +21,7 @@ CAMLprim value unix_chown(value path, value uid, value gid)
CAMLparam1(path);
char * p;
int ret;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = chown(p, Int_val(uid), Int_val(gid));
caml_leave_blocking_section();

2
otherlibs/unix/chroot.c
View File

@ -21,7 +21,7 @@ CAMLprim value unix_chroot(value path)
CAMLparam1(path);
char * p;
int ret;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = chroot(p);
caml_leave_blocking_section();

14
otherlibs/unix/getaddrinfo.c
View File

@ -16,6 +16,7 @@
#include <alloc.h>
#include <fail.h>
#include <memory.h>
#include <misc.h>
#include <signals.h>
#include "unixsupport.h"
#include "cst2constr.h"
@ -56,27 +57,22 @@ CAMLprim value unix_getaddrinfo(value vnode, value vserv, value vopts)
{
CAMLparam3(vnode, vserv, vopts);
CAMLlocal3(vres, v, e);
mlsize_t len;
char * node, * serv;
struct addrinfo hints;
struct addrinfo * res, * r;
int retcode;
/* Extract "node" parameter */
len = string_length(vnode);
if (len == 0) {
if (caml_string_length(vnode) == 0) {
node = NULL;
} else {
node = caml_stat_alloc(len + 1);
strcpy(node, String_val(vnode));
node = caml_strdup(String_val(vnode));
}
/* Extract "service" parameter */
len = string_length(vserv);
if (len == 0) {
if (caml_string_length(vserv) == 0) {
serv = NULL;
} else {
serv = caml_stat_alloc(len + 1);
strcpy(serv, String_val(vserv));
serv = caml_strdup(String_val(vserv));
}
/* Parse options, set hints */
memset(&hints, 0, sizeof(hints));

2
otherlibs/unix/gethost.c
View File

@ -127,7 +127,7 @@ CAMLprim value unix_gethostbyname(value name)
char * hostname;
#if HAS_GETHOSTBYNAME_R || GETHOSTBYNAME_IS_REENTRANT
hostname = caml_stat_alloc_string(name);
hostname = caml_strdup(String_val(name));
#else
hostname = String_val(name);
#endif

4
otherlibs/unix/link.c
View File

@ -22,8 +22,8 @@ CAMLprim value unix_link(value path1, value path2)
char * p1;
char * p2;
int ret;
p1 = caml_stat_alloc_string(path1);
p2 = caml_stat_alloc_string(path2);
p1 = caml_strdup(String_val(path1));
p2 = caml_strdup(String_val(path2));
caml_enter_blocking_section();
ret = link(p1, p2);
caml_leave_blocking_section();

2
otherlibs/unix/mkdir.c
View File

@ -23,7 +23,7 @@ CAMLprim value unix_mkdir(value path, value perm)
CAMLparam2(path, perm);
char * p;
int ret;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = mkdir(p, Int_val(perm));
caml_leave_blocking_section();

4
otherlibs/unix/mkfifo.c
View File

@ -26,7 +26,7 @@ CAMLprim value unix_mkfifo(value path, value mode)
CAMLparam2(path, mode);
char * p;
int ret;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = mkfifo(p, Int_val(mode));
caml_leave_blocking_section();
@ -48,7 +48,7 @@ CAMLprim value unix_mkfifo(value path, value mode)
CAMLparam2(path, mode);
char * p;
int ret;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = mknod(p, (Int_val(mode) & 07777) | S_IFIFO, 0);
caml_leave_blocking_section();

3
otherlibs/unix/open.c
View File

@ -14,6 +14,7 @@
#include <mlvalues.h>
#include <alloc.h>
#include <memory.h>
#include <misc.h>
#include <signals.h>
#include "unixsupport.h"
#include <string.h>
@ -62,7 +63,7 @@ CAMLprim value unix_open(value path, value flags, value perm)
char * p;
cv_flags = convert_flag_list(flags, open_flag_table);
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
/* open on a named FIFO can block (PR#1533) */
enter_blocking_section();
fd = open(p, cv_flags, Int_val(perm));

2
otherlibs/unix/opendir.c
View File

@ -30,7 +30,7 @@ CAMLprim value unix_opendir(value path)
value res;
char * p;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
d = opendir(p);
caml_leave_blocking_section();

2
otherlibs/unix/readlink.c
View File

@ -36,7 +36,7 @@ CAMLprim value unix_readlink(value path)
char buffer[PATH_MAX];
int len;
char * p;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
len = readlink(p, buffer, sizeof(buffer) - 1);
caml_leave_blocking_section();

4
otherlibs/unix/rename.c
View File

@ -23,8 +23,8 @@ CAMLprim value unix_rename(value path1, value path2)
char * p1;
char * p2;
int ret;
p1 = caml_stat_alloc_string(path1);
p2 = caml_stat_alloc_string(path2);
p1 = caml_strdup(String_val(path1));
p2 = caml_strdup(String_val(path2));
caml_enter_blocking_section();
ret = rename(p1, p2);
caml_leave_blocking_section();

2
otherlibs/unix/rmdir.c
View File

@ -21,7 +21,7 @@ CAMLprim value unix_rmdir(value path)
CAMLparam1(path);
char * p;
int ret;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = rmdir(p);
caml_leave_blocking_section();

8
otherlibs/unix/stat.c
View File

@ -75,7 +75,7 @@ CAMLprim value unix_stat(value path)
int ret;
struct stat buf;
char * p;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = stat(p, &buf);
caml_leave_blocking_section();
@ -92,7 +92,7 @@ CAMLprim value unix_lstat(value path)
int ret;
struct stat buf;
char * p;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
#ifdef HAS_SYMLINK
ret = lstat(p, &buf);
@ -126,7 +126,7 @@ CAMLprim value unix_stat_64(value path)
int ret;
struct stat buf;
char * p;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = stat(p, &buf);
caml_leave_blocking_section();
@ -141,7 +141,7 @@ CAMLprim value unix_lstat_64(value path)
int ret;
struct stat buf;
char * p;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
#ifdef HAS_SYMLINK
ret = lstat(p, &buf);

4
otherlibs/unix/symlink.c
View File

@ -25,8 +25,8 @@ CAMLprim value unix_symlink(value path1, value path2)
char * p1;
char * p2;
int ret;
p1 = caml_stat_alloc_string(path1);
p2 = caml_stat_alloc_string(path2);
p1 = caml_strdup(String_val(path1));
p2 = caml_strdup(String_val(path2));
caml_enter_blocking_section();
ret = symlink(p1, p2);
caml_leave_blocking_section();

4
otherlibs/unix/truncate.c
View File

@ -29,7 +29,7 @@ CAMLprim value unix_truncate(value path, value len)
CAMLparam2(path, len);
char * p;
int ret;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = truncate(p, Long_val(len));
caml_leave_blocking_section();
@ -45,7 +45,7 @@ CAMLprim value unix_truncate_64(value path, value vlen)
char * p;
int ret;
file_offset len = File_offset_val(vlen);
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = truncate(p, len);
caml_leave_blocking_section();

2
otherlibs/unix/unlink.c
View File

@ -21,7 +21,7 @@ CAMLprim value unix_unlink(value path)
CAMLparam1(path);
char * p;
int ret;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = unlink(p);
caml_leave_blocking_section();

4
otherlibs/unix/utimes.c
View File

@ -38,7 +38,7 @@ CAMLprim value unix_utimes(value path, value atime, value mtime)
t = &times;
else
t = (struct utimbuf *) NULL;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = utime(p, t);
caml_leave_blocking_section();
@ -70,7 +70,7 @@ CAMLprim value unix_utimes(value path, value atime, value mtime)
t = tv;
else
t = (struct timeval *) NULL;
p = caml_stat_alloc_string(path);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = utimes(p, t);
caml_leave_blocking_section();

3
otherlibs/win32graph/open.c
View File

@ -48,7 +48,8 @@ HFONT CreationFont(char *name)
CurrentFont.lfWeight = FW_NORMAL;
CurrentFont.lfHeight = grwindow.CurrentFontSize;
CurrentFont.lfPitchAndFamily = (BYTE) (FIXED_PITCH | FF_MODERN);
strcpy(CurrentFont.lfFaceName, name); /* Courier */
strncpy(CurrentFont.lfFaceName, name, sizeof(CurrentFont.lfFaceName));
CurrentFont.lfFaceName[sizeof(CurrentFont.lfFaceName) - 1] = 0;
return (CreateFontIndirect(&CurrentFont));
}