diff options
51 files changed, 516 insertions, 606 deletions
@@ -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 diff --git a/byterun/alloc.h b/byterun/alloc.h index a0cd41b65..f00a7ef0e 100644 --- a/byterun/alloc.h +++ b/byterun/alloc.h @@ -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*/ diff --git a/byterun/callback.c b/byterun/callback.c index 3bd7ea45c..5da37ec9a 100644 --- a/byterun/callback.c +++ b/byterun/callback.c @@ -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; diff --git a/byterun/config.h b/byterun/config.h index 8cf851613..02bdd53be 100644 --- a/byterun/config.h +++ b/byterun/config.h @@ -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 */ diff --git a/byterun/dynlink.c b/byterun/dynlink.c index f07cf91e3..8b4498b9d 100644 --- a/byterun/dynlink.c +++ b/byterun/dynlink.c @@ -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; diff --git a/byterun/floats.c b/byterun/floats.c index 9071106f2..7ff6d89dd 100644 --- a/byterun/floats.c +++ b/byterun/floats.c @@ -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) { diff --git a/byterun/hash.c b/byterun/hash.c index 61bee20cf..3beb0e016 100644 --- a/byterun/hash.c +++ b/byterun/hash.c @@ -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; diff --git a/byterun/instrtrace.c b/byterun/instrtrace.c index 2934984d2..0a19fd2f1 100644 --- a/byterun/instrtrace.c +++ b/byterun/instrtrace.c @@ -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; diff --git a/byterun/intern.c b/byterun/intern.c index f03704c32..e353e6b7b 100644 --- a/byterun/intern.c +++ b/byterun/intern.c @@ -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], diff --git a/byterun/interp.c b/byterun/interp.c index 591b51778..a0e54d166 100644 --- a/byterun/interp.c +++ b/byterun/interp.c @@ -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): diff --git a/byterun/ints.c b/byterun/ints.c index 4bf1d332c..a5e6e2e6d 100644 --- a/byterun/ints.c +++ b/byterun/ints.c @@ -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, - char * suffix, - char format_string[], - char default_format_buffer[], - char *conv) +static char parse_format(value fmt, + char * suffix, + 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))); } +{ + 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(I64_of_intnat(Long_val(v))); } +{ return caml_copy_int64((int64) (Long_val(v))); } CAMLprim value caml_int64_to_int(value v) -{ return Val_long(I64_to_intnat(Int64_val(v))); } +{ return Val_long((intnat) (Int64_val(v))); } CAMLprim value caml_int64_of_float(value v) -{ return caml_copy_int64(I64_of_double(Double_val(v))); } +{ return caml_copy_int64((int64) (Double_val(v))); } CAMLprim value caml_int64_to_float(value v) -{ - int64 i = Int64_val(v); - return caml_copy_double(I64_to_double(i)); -} +{ 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) diff --git a/byterun/io.c b/byterun/io.c index c1566b72c..5f04a966e 100644 --- a/byterun/io.c +++ b/byterun/io.c @@ -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 diff --git a/byterun/io.h b/byterun/io.h index 1d0917e6c..64a8bf50a 100644 --- a/byterun/io.h +++ b/byterun/io.h @@ -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 */ diff --git a/byterun/lexing.c b/byterun/lexing.c index 8242cc7a8..22ef6acde 100644 --- a/byterun/lexing.c +++ b/byterun/lexing.c @@ -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 diff --git a/byterun/memory.c b/byterun/memory.c index 529e5b248..54d91c96d 100644 --- a/byterun/memory.c +++ b/byterun/memory.c @@ -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); diff --git a/byterun/memory.h b/byterun/memory.h index d1c8f9917..076107017 100644 --- a/byterun/memory.h +++ b/byterun/memory.h @@ -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. */ diff --git a/byterun/misc.c b/byterun/misc.c index 6eeae0f1b..6dc27d5cc 100644 --- a/byterun/misc.c +++ b/byterun/misc.c @@ -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; +} diff --git a/byterun/misc.h b/byterun/misc.h index 4fd82af2d..5640980a6 100644 --- a/byterun/misc.h +++ b/byterun/misc.h @@ -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 */ diff --git a/byterun/parsing.c b/byterun/parsing.c index 3c1ced7d1..a857e3922 100644 --- a/byterun/parsing.c +++ b/byterun/parsing.c @@ -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 diff --git a/byterun/printexc.c b/byterun/printexc.c index 6e70d524c..8f6badd92 100644 --- a/byterun/printexc.c +++ b/byterun/printexc.c @@ -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, '"'); diff --git a/byterun/startup.c b/byterun/startup.c index 4bff11a0d..89e296a72 100644 --- a/byterun/startup.c +++ b/byterun/startup.c @@ -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]; diff --git a/byterun/str.c b/byterun/str.c index 9e157a816..e2e0f4d26 100644 --- a/byterun/str.c +++ b/byterun/str.c @@ -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 +} diff --git a/byterun/sys.c b/byterun/sys.c index 8b2551a00..ee2a77024 100644 --- a/byterun/sys.c +++ b/byterun/sys.c @@ -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(); diff --git a/byterun/unix.c b/byterun/unix.c index 491b1e78f..be2c39b15 100644 --- a/byterun/unix.c +++ b/byterun/unix.c @@ -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(fullname)) return fullname; - strcat(fullname, ".exe"); + if (cygwin_file_exists(name)) return caml_strdup(name); + fullname = caml_strconcat(2, name, ".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; diff --git a/byterun/win32.c b/byterun/win32.c index b2fd4b7e9..8647437f0 100644 --- a/byterun/win32.c +++ b/byterun/win32.c @@ -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; + caml_stat_free(fullname); + return caml_strdup(name); } - if (retcode < pathlen) break; + if (retcode < fullnamelen) + return fullname; caml_stat_free(fullname); - pathlen = retcode + 1; + fullnamelen = retcode + 1; } - return fullname; } 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; +} diff --git a/config/auto-aux/int64align.c b/config/auto-aux/int64align.c index 9ae8a5bc7..5795e4844 100644 --- a/config/auto-aux/int64align.c +++ b/config/auto-aux/int64align.c @@ -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 + +int64 foo; -void access_int64(ARCH_INT64_TYPE *p) +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; diff --git a/config/auto-aux/sizes.c b/config/auto-aux/sizes.c index 2700729d4..daa9615d1 100644 --- a/config/auto-aux/sizes.c +++ b/config/auto-aux/sizes.c @@ -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; } @@ -470,38 +470,39 @@ 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." - echo "#undef ARCH_SIXTYFOUR" >> m.h - arch64=false;; - *,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" \ - "OCaml won't run on this 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!" + echo "#define ARCH_SIXTYFOUR" >> m.h + arch64=true;; + *) err "This architecture seems to be neither 32 bits nor 64 bits.\n" \ + "OCaml won't run on this architecture.";; esac else # For cross-compilation, runtest always fails: add special handling. 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,36 +585,32 @@ case "$target" in esac;; esac -if $int64_native; then - case "$target" in - # PR#5088: autodetection is unreliable on ARM. PR#5280: also on MIPS. - sparc*-*-*|hppa*-*-*|arm*-*-*|mips*-*-*) - if test $2 = 8; then - inf "64-bit integers can be word-aligned." - echo "#undef ARCH_ALIGN_INT64" >> m.h - else - inf "64-bit integers must be doubleword-aligned." - echo "#define ARCH_ALIGN_INT64" >> m.h - fi;; - *-*-mingw*) true;; # Nothing is in config/m-nt.h so don't add anything. - *) - sh ./runtest int64align.c - case $? in - 0) inf "64-bit integers can be word-aligned." - echo "#undef ARCH_ALIGN_INT64" >> m.h;; - 1) inf "64-bit integers must be doubleword-aligned." - echo "#define ARCH_ALIGN_INT64" >> m.h;; - *) wrn "Something went wrong during alignment determination for\n" \ - "64-bit integers. I'm going to assume this architecture has\n" \ - "alignment constraints. That's a safe bet: OCaml will work\n" \ - "even if this architecture has actually no alignment\n" \ - "constraints." \ - echo "#define ARCH_ALIGN_INT64" >> m.h;; - esac - esac -else - echo "#undef ARCH_ALIGN_INT64" >> m.h -fi +case "$target" in + # PR#5088: autodetection is unreliable on ARM. PR#5280: also on MIPS. + sparc*-*-*|hppa*-*-*|arm*-*-*|mips*-*-*) + if test $2 = 8; then + inf "64-bit integers can be word-aligned." + echo "#undef ARCH_ALIGN_INT64" >> m.h + else + inf "64-bit integers must be doubleword-aligned." + echo "#define ARCH_ALIGN_INT64" >> m.h + fi;; + *-*-mingw*) true;; # Nothing is in config/m-nt.h so don't add anything. + *) + sh ./runtest int64align.c + case $? in + 0) inf "64-bit integers can be word-aligned." + echo "#undef ARCH_ALIGN_INT64" >> m.h;; + 1) inf "64-bit integers must be doubleword-aligned." + echo "#define ARCH_ALIGN_INT64" >> m.h;; + *) wrn "Something went wrong during alignment determination for\n" \ + "64-bit integers. I'm going to assume this architecture has\n" \ + "alignment constraints. That's a safe bet: OCaml will work\n" \ + "even if this architecture has actually no alignment\n" \ + "constraints." \ + echo "#define ARCH_ALIGN_INT64" >> m.h;; + esac +esac # Check semantics of division and modulus diff --git a/otherlibs/bigarray/bigarray_stubs.c b/otherlibs/bigarray/bigarray_stubs.c index b8c768afa..586357ad5 100644 --- a/otherlibs/bigarray/bigarray_stubs.c +++ b/otherlibs/bigarray/bigarray_stubs.c @@ -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); diff --git a/otherlibs/graph/open.c b/otherlibs/graph/open.c index e3529d42d..14a00eafd 100644 --- a/otherlibs/graph/open.c +++ b/otherlibs/graph/open.c @@ -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); diff --git a/otherlibs/unix/access.c b/otherlibs/unix/access.c index 9af8a6f95..7df4f9c5f 100644 --- a/otherlibs/unix/access.c +++ b/otherlibs/unix/access.c @@ -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(); diff --git a/otherlibs/unix/chdir.c b/otherlibs/unix/chdir.c index 4b93b5fc8..0d5326a0d 100644 --- a/otherlibs/unix/chdir.c +++ b/otherlibs/unix/chdir.c @@ -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(); diff --git a/otherlibs/unix/chmod.c b/otherlibs/unix/chmod.c index a04215521..90dd6024f 100644 --- a/otherlibs/unix/chmod.c +++ b/otherlibs/unix/chmod.c @@ -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(); diff --git a/otherlibs/unix/chown.c b/otherlibs/unix/chown.c index 0b118fb40..697f44771 100644 --- a/otherlibs/unix/chown.c +++ b/otherlibs/unix/chown.c @@ -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(); diff --git a/otherlibs/unix/chroot.c b/otherlibs/unix/chroot.c index 7c9517c11..b41c09ff0 100644 --- a/otherlibs/unix/chroot.c +++ b/otherlibs/unix/chroot.c @@ -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(); diff --git a/otherlibs/unix/getaddrinfo.c b/otherlibs/unix/getaddrinfo.c index cf3bb4a52..28d8903a3 100644 --- a/otherlibs/unix/getaddrinfo.c +++ b/otherlibs/unix/getaddrinfo.c @@ -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)); diff --git a/otherlibs/unix/gethost.c b/otherlibs/unix/gethost.c index 607b6c35f..8d5bb03f5 100644 --- a/otherlibs/unix/gethost.c +++ b/otherlibs/unix/gethost.c @@ -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 diff --git a/otherlibs/unix/link.c b/otherlibs/unix/link.c index 8110bf583..c71118a59 100644 --- a/otherlibs/unix/link.c +++ b/otherlibs/unix/link.c @@ -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(); diff --git a/otherlibs/unix/mkdir.c b/otherlibs/unix/mkdir.c index 6a7bb18c2..d72a066c5 100644 --- a/otherlibs/unix/mkdir.c +++ b/otherlibs/unix/mkdir.c @@ -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(); diff --git a/otherlibs/unix/mkfifo.c b/otherlibs/unix/mkfifo.c index ef440a25b..a00bcf2d0 100644 --- a/otherlibs/unix/mkfifo.c +++ b/otherlibs/unix/mkfifo.c @@ -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(); diff --git a/otherlibs/unix/open.c b/otherlibs/unix/open.c index c98819aab..32c332f23 100644 --- a/otherlibs/unix/open.c +++ b/otherlibs/unix/open.c @@ -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)); diff --git a/otherlibs/unix/opendir.c b/otherlibs/unix/opendir.c index 57a331888..9cb6829cd 100644 --- a/otherlibs/unix/opendir.c +++ b/otherlibs/unix/opendir.c @@ -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(); diff --git a/otherlibs/unix/readlink.c b/otherlibs/unix/readlink.c index d129aebfe..5706ba035 100644 --- a/otherlibs/unix/readlink.c +++ b/otherlibs/unix/readlink.c @@ -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(); diff --git a/otherlibs/unix/rename.c b/otherlibs/unix/rename.c index e63a06e36..78da70948 100644 --- a/otherlibs/unix/rename.c +++ b/otherlibs/unix/rename.c @@ -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(); diff --git a/otherlibs/unix/rmdir.c b/otherlibs/unix/rmdir.c index 28cef33d8..12d521a72 100644 --- a/otherlibs/unix/rmdir.c +++ b/otherlibs/unix/rmdir.c @@ -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(); diff --git a/otherlibs/unix/stat.c b/otherlibs/unix/stat.c index 9825802a0..f6d8c06d3 100644 --- a/otherlibs/unix/stat.c +++ b/otherlibs/unix/stat.c @@ -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); diff --git a/otherlibs/unix/symlink.c b/otherlibs/unix/symlink.c index 41ba02019..d1dbf37c5 100644 --- a/otherlibs/unix/symlink.c +++ b/otherlibs/unix/symlink.c @@ -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(); diff --git a/otherlibs/unix/truncate.c b/otherlibs/unix/truncate.c index c5b3a1159..520320ebb 100644 --- a/otherlibs/unix/truncate.c +++ b/otherlibs/unix/truncate.c @@ -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(); diff --git a/otherlibs/unix/unlink.c b/otherlibs/unix/unlink.c index 4a4a513e3..ae63f69a1 100644 --- a/otherlibs/unix/unlink.c +++ b/otherlibs/unix/unlink.c @@ -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(); diff --git a/otherlibs/unix/utimes.c b/otherlibs/unix/utimes.c index bb84c43e5..0c3b77d1b 100644 --- a/otherlibs/unix/utimes.c +++ b/otherlibs/unix/utimes.c @@ -38,7 +38,7 @@ CAMLprim value unix_utimes(value path, value atime, value mtime) t = × 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(); diff --git a/otherlibs/win32graph/open.c b/otherlibs/win32graph/open.c index 4bdae36a1..4138fccde 100644 --- a/otherlibs/win32graph/open.c +++ b/otherlibs/win32graph/open.c @@ -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)); } |