diff options
77 files changed, 634 insertions, 572 deletions
diff --git a/asmrun/roots.c b/asmrun/roots.c index 76d85a0ad..5a143d2dd 100644 --- a/asmrun/roots.c +++ b/asmrun/roots.c @@ -34,7 +34,7 @@ void (*caml_scan_roots_hook) (scanning_action) = NULL; /* The hashtable of frame descriptors */ typedef struct { - unsigned long retaddr; + uintnat retaddr; short frame_size; short num_live; short live_ofs[1]; @@ -44,14 +44,14 @@ static frame_descr ** frame_descriptors = NULL; static int frame_descriptors_mask; #define Hash_retaddr(addr) \ - (((unsigned long)(addr) >> 3) & frame_descriptors_mask) + (((uintnat)(addr) >> 3) & frame_descriptors_mask) static void init_frame_descriptors(void) { - long num_descr, tblsize, i, j, len; - long * tbl; + intnat num_descr, tblsize, i, j, len; + intnat * tbl; frame_descr * d; - unsigned long h; + uintnat h; /* Count the frame descriptors */ num_descr = 0; @@ -81,7 +81,7 @@ static void init_frame_descriptors(void) } frame_descriptors[h] = d; d = (frame_descr *) - (((unsigned long)d + + (((uintnat)d + sizeof(char *) + sizeof(short) + sizeof(short) + sizeof(short) * d->num_live + sizeof(frame_descr *) - 1) & -sizeof(frame_descr *)); @@ -92,20 +92,20 @@ static void init_frame_descriptors(void) /* Communication with [caml_start_program] and [caml_call_gc]. */ char * caml_bottom_of_stack = NULL; /* no stack initially */ -unsigned long caml_last_return_address = 1; /* not in Caml code initially */ +uintnat caml_last_return_address = 1; /* not in Caml code initially */ value * caml_gc_regs; -long caml_globals_inited = 0; -static long caml_globals_scanned = 0; +intnat caml_globals_inited = 0; +static intnat caml_globals_scanned = 0; /* Call [caml_oldify_one] on (at least) all the roots that point to the minor heap. */ void caml_oldify_local_roots (void) { char * sp; - unsigned long retaddr; + uintnat retaddr; value * regs; frame_descr * d; - unsigned long h; + uintnat h; int i, j, n, ofs; short * p; value glob; @@ -227,14 +227,14 @@ void caml_do_roots (scanning_action f) } void caml_do_local_roots(scanning_action f, char * bottom_of_stack, - unsigned long last_retaddr, value * gc_regs, + uintnat last_retaddr, value * gc_regs, struct caml__roots_block * local_roots) { char * sp; - unsigned long retaddr; + uintnat retaddr; value * regs; frame_descr * d; - unsigned long h; + uintnat h; int i, j, n, ofs; short * p; value * root; diff --git a/asmrun/signals.c b/asmrun/signals.c index 83024a8e3..82c23e0cf 100644 --- a/asmrun/signals.c +++ b/asmrun/signals.c @@ -52,14 +52,14 @@ extern char * caml_code_area_start, * caml_code_area_end; ((char *)(pc) >= caml_code_area_start && \ (char *)(pc) <= caml_code_area_end) -volatile long caml_pending_signals[NSIG]; +volatile intnat caml_pending_signals[NSIG]; volatile int caml_force_major_slice = 0; value caml_signal_handlers = 0; static void caml_process_pending_signals(void) { int signal_num; - long signal_state; + intnat signal_state; for (signal_num = 0; signal_num < NSIG; signal_num++) { Read_and_clear(signal_state, caml_pending_signals[signal_num]); @@ -67,7 +67,7 @@ static void caml_process_pending_signals(void) } } -static long volatile caml_async_signal_mode = 0; +static intnat volatile caml_async_signal_mode = 0; static void caml_enter_blocking_section_default(void) { @@ -83,7 +83,7 @@ static void caml_leave_blocking_section_default(void) static int caml_try_leave_blocking_section_default(void) { - long res; + intnat res; Read_and_clear(res, caml_async_signal_mode); return res; } @@ -138,7 +138,7 @@ void caml_execute_signal(int signal_number, int in_signal_handler) void caml_garbage_collection(void) { int signal_number; - long signal_state; + intnat signal_state; caml_young_limit = caml_young_start; if (caml_young_ptr < caml_young_start || caml_force_major_slice) { @@ -165,7 +165,7 @@ void caml_urge_major_slice (void) void caml_enter_blocking_section(void) { int i; - long pending; + intnat pending; while (1){ /* Process all pending signals now */ @@ -415,7 +415,7 @@ DECLARE_SIGNAL_HANDLER(segv_handler) - faulting address is within the stack - we are in Caml code */ fault_addr = CONTEXT_FAULTING_ADDRESS; - if (((long) fault_addr & (sizeof(long) - 1)) == 0 + if (((uintnat) fault_addr & (sizeof(intnat) - 1)) == 0 && getrlimit(RLIMIT_STACK, &limit) == 0 && fault_addr < system_stack_top && fault_addr >= system_stack_top - limit.rlim_cur - 0x2000 diff --git a/asmrun/stack.h b/asmrun/stack.h index dd7069099..a28711983 100644 --- a/asmrun/stack.h +++ b/asmrun/stack.h @@ -20,38 +20,38 @@ /* Macros to access the stack frame */ #ifdef TARGET_alpha -#define Saved_return_address(sp) *((long *)((sp) - 8)) +#define Saved_return_address(sp) *((intnat *)((sp) - 8)) #define Already_scanned(sp, retaddr) ((retaddr) & 1L) -#define Mark_scanned(sp, retaddr) (*((long *)((sp) - 8)) = (retaddr) | 1L) +#define Mark_scanned(sp, retaddr) (*((intnat *)((sp) - 8)) = (retaddr) | 1L) #define Mask_already_scanned(retaddr) ((retaddr) & ~1L) #define Callback_link(sp) ((struct caml_context *)((sp) + 16)) #endif #ifdef TARGET_sparc -#define Saved_return_address(sp) *((long *)((sp) + 92)) +#define Saved_return_address(sp) *((intnat *)((sp) + 92)) #define Callback_link(sp) ((struct caml_context *)((sp) + 104)) #endif #ifdef TARGET_i386 -#define Saved_return_address(sp) *((long *)((sp) - 4)) +#define Saved_return_address(sp) *((intnat *)((sp) - 4)) #define Callback_link(sp) ((struct caml_context *)((sp) + 8)) #endif #ifdef TARGET_mips -#define Saved_return_address(sp) *((long *)((sp) - 4)) +#define Saved_return_address(sp) *((intnat *)((sp) - 4)) #define Callback_link(sp) ((struct caml_context *)((sp) + 16)) #endif #ifdef TARGET_hppa #define Stack_grows_upwards -#define Saved_return_address(sp) *((long *)(sp)) +#define Saved_return_address(sp) *((intnat *)(sp)) #define Callback_link(sp) ((struct caml_context *)((sp) - 24)) #endif #ifdef TARGET_power -#define Saved_return_address(sp) *((long *)((sp) - 4)) +#define Saved_return_address(sp) *((intnat *)((sp) - 4)) #define Already_scanned(sp, retaddr) ((retaddr) & 1) -#define Mark_scanned(sp, retaddr) (*((long *)((sp) - 4)) = (retaddr) | 1) +#define Mark_scanned(sp, retaddr) (*((intnat *)((sp) - 4)) = (retaddr) | 1) #define Mask_already_scanned(retaddr) ((retaddr) & ~1) #ifdef SYS_aix #define Trap_frame_size 32 @@ -62,25 +62,25 @@ #endif #ifdef TARGET_m68k -#define Saved_return_address(sp) *((long *)((sp) - 4)) +#define Saved_return_address(sp) *((intnat *)((sp) - 4)) #define Callback_link(sp) ((struct caml_context *)((sp) + 8)) #endif #ifdef TARGET_arm -#define Saved_return_address(sp) *((long *)((sp) - 4)) +#define Saved_return_address(sp) *((intnat *)((sp) - 4)) #define Callback_link(sp) ((struct caml_context *)((sp) + 8)) #endif #ifdef TARGET_ia64 -#define Saved_return_address(sp) *((long *)((sp) + 8)) +#define Saved_return_address(sp) *((intnat *)((sp) + 8)) #define Already_scanned(sp, retaddr) ((retaddr) & 1L) -#define Mark_scanned(sp, retaddr) (*((long *)((sp) + 8)) = (retaddr) | 1L) +#define Mark_scanned(sp, retaddr) (*((intnat *)((sp) + 8)) = (retaddr) | 1L) #define Mask_already_scanned(retaddr) ((retaddr) & ~1L) #define Callback_link(sp) ((struct caml_context *)((sp) + 32)) #endif #ifdef TARGET_amd64 -#define Saved_return_address(sp) *((long *)((sp) - 8)) +#define Saved_return_address(sp) *((intnat *)((sp) - 8)) #define Callback_link(sp) ((struct caml_context *)((sp) + 16)) #endif @@ -88,18 +88,18 @@ struct caml_context { char * bottom_of_stack; /* beginning of Caml stack chunk */ - unsigned long last_retaddr; /* last return address in Caml code */ + uintnat last_retaddr; /* last return address in Caml code */ value * gc_regs; /* pointer to register block */ }; /* Declaration of variables used in the asm code */ extern char * caml_bottom_of_stack; -extern unsigned long caml_last_return_address; +extern uintnat caml_last_return_address; extern value * caml_gc_regs; extern char * caml_exception_pointer; extern value caml_globals[]; -extern long caml_globals_inited; -extern long * caml_frametable[]; +extern intnat caml_globals_inited; +extern intnat * caml_frametable[]; #endif /* CAML_STACK_H */ diff --git a/asmrun/startup.c b/asmrun/startup.c index 576c2c56c..44aab0ccf 100644 --- a/asmrun/startup.c +++ b/asmrun/startup.c @@ -64,12 +64,12 @@ static void init_atoms(void) /* Configuration parameters and flags */ -static unsigned long percent_free_init = Percent_free_def; -static unsigned long max_percent_free_init = Max_percent_free_def; -static unsigned long minor_heap_init = Minor_heap_def; -static unsigned long heap_chunk_init = Heap_chunk_def; -static unsigned long heap_size_init = Init_heap_def; -static unsigned long max_stack_init = Max_stack_def; +static uintnat percent_free_init = Percent_free_def; +static uintnat max_percent_free_init = Max_percent_free_def; +static uintnat minor_heap_init = Minor_heap_def; +static uintnat heap_chunk_init = Heap_chunk_def; +static uintnat heap_size_init = Init_heap_def; +static uintnat max_stack_init = Max_stack_def; /* Parse the CAMLRUNPARAM variable */ /* The option letter for each runtime option is the first letter of the @@ -80,14 +80,18 @@ static unsigned long max_stack_init = Max_stack_def; /* If you change these functions, see also their copy in byterun/startup.c */ -static void scanmult (char *opt, long unsigned int *var) +static void scanmult (char *opt, uintnat *var) { char mult = ' '; - sscanf (opt, "=%lu%c", var, &mult); - sscanf (opt, "=0x%lx%c", var, &mult); - if (mult == 'k') *var = *var * 1024; - if (mult == 'M') *var = *var * (1024 * 1024); - if (mult == 'G') *var = *var * (1024 * 1024 * 1024); + int val; + sscanf (opt, "=%u%c", &val, &mult); + sscanf (opt, "=0x%x%c", &val, &mult); + switch (mult) { + case 'k': *var = (uintnat) val * 1024; break; + case 'M': *var = (uintnat) val * 1024 * 1024; break; + case 'G': *var = (uintnat) val * 1024 * 1024 * 1024; break; + default: *var = (uintnat) val; break; + } } static void parse_camlrunparam(void) diff --git a/boot/ocamlc b/boot/ocamlc Binary files differindex 777037b88..3d0c1b409 100755 --- a/boot/ocamlc +++ b/boot/ocamlc diff --git a/boot/ocamllex b/boot/ocamllex Binary files differindex e770406c5..277c0dfa7 100755 --- a/boot/ocamllex +++ b/boot/ocamllex diff --git a/byterun/alloc.h b/byterun/alloc.h index 1cf70c224..66cab7024 100644 --- a/byterun/alloc.h +++ b/byterun/alloc.h @@ -32,7 +32,7 @@ CAMLextern value caml_copy_string_array (char const **); CAMLextern value caml_copy_double (double); CAMLextern value caml_copy_int32 (int32); /* defined in [ints.c] */ CAMLextern value caml_copy_int64 (int64); /* defined in [ints.c] */ -CAMLextern value caml_copy_nativeint (long); /* 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); diff --git a/byterun/array.c b/byterun/array.c index c13c0fed7..468fe444a 100644 --- a/byterun/array.c +++ b/byterun/array.c @@ -25,14 +25,14 @@ CAMLprim value caml_array_get_addr(value array, value index) { - long idx = Long_val(index); + intnat idx = Long_val(index); if (idx < 0 || idx >= Wosize_val(array)) caml_array_bound_error(); return Field(array, idx); } CAMLprim value caml_array_get_float(value array, value index) { - long idx = Long_val(index); + intnat idx = Long_val(index); double d; value res; @@ -58,7 +58,7 @@ CAMLprim value caml_array_get(value array, value index) CAMLprim value caml_array_set_addr(value array, value index, value newval) { - long idx = Long_val(index); + intnat idx = Long_val(index); if (idx < 0 || idx >= Wosize_val(array)) caml_array_bound_error(); Modify(&Field(array, idx), newval); return Val_unit; @@ -66,7 +66,7 @@ CAMLprim value caml_array_set_addr(value array, value index, value newval) CAMLprim value caml_array_set_float(value array, value index, value newval) { - long idx = Long_val(index); + intnat idx = Long_val(index); if (idx < 0 || idx >= Wosize_val(array) / Double_wosize) caml_array_bound_error(); Store_double_field(array, idx, Double_val(newval)); @@ -106,7 +106,7 @@ CAMLprim value caml_array_unsafe_get(value array, value index) CAMLprim value caml_array_unsafe_set_addr(value array, value index,value newval) { - long idx = Long_val(index); + intnat idx = Long_val(index); Modify(&Field(array, idx), newval); return Val_unit; } diff --git a/byterun/compact.c b/byterun/compact.c index 567530846..a6860d529 100644 --- a/byterun/compact.c +++ b/byterun/compact.c @@ -26,7 +26,7 @@ #include "roots.h" #include "weak.h" -extern unsigned long caml_percent_free; /* major_gc.c */ +extern uintnat caml_percent_free; /* major_gc.c */ extern void caml_shrink_heap (char *); /* memory.c */ /* Encoded headers: the color is stored in the 2 least significant bits. @@ -51,12 +51,12 @@ extern void caml_shrink_heap (char *); /* memory.c */ #define Tag_ehd(h) (((h) >> 2) & 0xFF) #define Ecolor(w) ((w) & 3) -typedef unsigned long word; +typedef uintnat word; static void invert_pointer_at (word *p) { word q = *p; - Assert (Ecolor ((long) p) == 0); + Assert (Ecolor ((intnat) p) == 0); /* Use Ecolor (q) == 0 instead of Is_block (q) because q could be an inverted pointer for an infix header (with Ecolor == 2). */ @@ -208,7 +208,7 @@ void caml_compact_heap (void) /* Get the original header of this block. */ infixes = p + sz; q = *infixes; - while (Ecolor (q) != 3) q = * (word *) (q & ~(unsigned long)3); + while (Ecolor (q) != 3) q = * (word *) (q & ~(uintnat)3); sz = Whsize_ehd (q); t = Tag_ehd (q); } @@ -272,7 +272,7 @@ void caml_compact_heap (void) /* Get the original header of this block. */ infixes = p + sz; q = *infixes; Assert (Ecolor (q) == 2); - while (Ecolor (q) != 3) q = * (word *) (q & ~(unsigned long)3); + while (Ecolor (q) != 3) q = * (word *) (q & ~(uintnat)3); sz = Whsize_ehd (q); t = Tag_ehd (q); } @@ -289,11 +289,11 @@ void caml_compact_heap (void) if (infixes != NULL){ /* Rebuild the infix headers and revert the infix pointers. */ while (Ecolor ((word) infixes) != 3){ - infixes = (word *) ((word) infixes & ~(unsigned long) 3); + infixes = (word *) ((word) infixes & ~(uintnat) 3); q = *infixes; while (Ecolor (q) == 2){ word next; - q = (word) q & ~(unsigned long) 3; + q = (word) q & ~(uintnat) 3; next = * (word *) q; * (word *) q = (word) Val_hp ((word *) newadr + (infixes - p)); q = next; @@ -393,7 +393,7 @@ void caml_compact_heap (void) caml_gc_message (0x10, "done.\n", 0); } -unsigned long caml_percent_max; /* used in gc_ctrl.c */ +uintnat caml_percent_max; /* used in gc_ctrl.c */ void caml_compact_heap_maybe (void) { @@ -419,9 +419,12 @@ void caml_compact_heap_maybe (void) fp = 100.0 * fw / (Wsize_bsize (caml_stat_heap_size) - fw); if (fp > 1000000.0) fp = 1000000.0; } - caml_gc_message (0x200, "FL size at phase change = %lu\n", - (unsigned long) caml_fl_size_at_phase_change); - caml_gc_message (0x200, "Estimated overhead = %lu%%\n", (unsigned long) fp); + caml_gc_message (0x200, "FL size at phase change = %" + ARCH_INTNAT_PRINTF_FORMAT "u\n", + (uintnat) caml_fl_size_at_phase_change); + caml_gc_message (0x200, "Estimated overhead = %" + ARCH_INTNAT_PRINTF_FORMAT "u%%\n", + (uintnat) fp); if (fp >= caml_percent_max){ caml_gc_message (0x200, "Automatic compaction triggered.\n", 0); caml_finish_major_cycle (); @@ -429,7 +432,9 @@ void caml_compact_heap_maybe (void) /* We just did a complete GC, so we can measure the overhead exactly. */ fw = caml_fl_cur_size; fp = 100.0 * fw / (Wsize_bsize (caml_stat_heap_size) - fw); - caml_gc_message (0x200, "Measured overhead: %lu%%\n", (unsigned long) fp); + caml_gc_message (0x200, "Measured overhead: %" + ARCH_INTNAT_PRINTF_FORMAT "u%%\n", + (uintnat) fp); caml_compact_heap (); } diff --git a/byterun/compare.c b/byterun/compare.c index c16067b23..a709b2e47 100644 --- a/byterun/compare.c +++ b/byterun/compare.c @@ -91,7 +91,7 @@ static struct compare_item * compare_resize_stack(struct compare_item * sp) < 0 and > UNORDERED v1 is less than v2 UNORDERED v1 and v2 cannot be compared */ -static long compare_val(value v1, value v2, int total) +static intnat compare_val(value v1, value v2, int total) { struct compare_item * sp; tag_t t1, t2; @@ -132,7 +132,7 @@ static long compare_val(value v1, value v2, int total) t2 = Tag_val(v2); if (t1 == Forward_tag) { v1 = Forward_val (v1); continue; } if (t2 == Forward_tag) { v2 = Forward_val (v2); continue; } - if (t1 != t2) return (long)t1 - (long)t2; + if (t1 != t2) return (intnat)t1 - (intnat)t2; switch(t1) { case String_tag: { mlsize_t len1, len2, len; @@ -145,7 +145,7 @@ static long compare_val(value v1, value v2, int total) p2 = (unsigned char *) String_val(v2); len > 0; len--, p1++, p2++) - if (*p1 != *p2) return (long)*p1 - (long)*p2; + if (*p1 != *p2) return (intnat)*p1 - (intnat)*p2; if (len1 != len2) return len1 - len2; break; } @@ -191,8 +191,8 @@ static long compare_val(value v1, value v2, int total) compare_free_stack(); caml_invalid_argument("equal: functional value"); case Object_tag: { - long oid1 = Oid_val(v1); - long oid2 = Oid_val(v2); + intnat oid1 = Oid_val(v1); + intnat oid2 = Oid_val(v2); if (oid1 != oid2) return oid1 - oid2; break; } @@ -237,7 +237,7 @@ static long compare_val(value v1, value v2, int total) CAMLprim value caml_compare(value v1, value v2) { - long res = compare_val(v1, v2, 1); + intnat res = compare_val(v1, v2, 1); /* Free stack if needed */ if (compare_stack != compare_stack_init) compare_free_stack(); if (res < 0) @@ -250,42 +250,42 @@ CAMLprim value caml_compare(value v1, value v2) CAMLprim value caml_equal(value v1, value v2) { - long res = compare_val(v1, v2, 0); + intnat res = compare_val(v1, v2, 0); if (compare_stack != compare_stack_init) compare_free_stack(); return Val_int(res == 0); } CAMLprim value caml_notequal(value v1, value v2) { - long res = compare_val(v1, v2, 0); + intnat res = compare_val(v1, v2, 0); if (compare_stack != compare_stack_init) compare_free_stack(); return Val_int(res != 0); } CAMLprim value caml_lessthan(value v1, value v2) { - long res = compare_val(v1, v2, 0); + intnat res = compare_val(v1, v2, 0); if (compare_stack != compare_stack_init) compare_free_stack(); return Val_int(res - 1 < -1); } CAMLprim value caml_lessequal(value v1, value v2) { - long res = compare_val(v1, v2, 0); + intnat res = compare_val(v1, v2, 0); if (compare_stack != compare_stack_init) compare_free_stack(); return Val_int(res - 1 <= -1); } CAMLprim value caml_greaterthan(value v1, value v2) { - long res = compare_val(v1, v2, 0); + intnat res = compare_val(v1, v2, 0); if (compare_stack != compare_stack_init) compare_free_stack(); return Val_int(res > 0); } CAMLprim value caml_greaterequal(value v1, value v2) { - long res = compare_val(v1, v2, 0); + intnat res = compare_val(v1, v2, 0); if (compare_stack != compare_stack_init) compare_free_stack(); return Val_int(res >= 0); } diff --git a/byterun/config.h b/byterun/config.h index ae80a96d5..b2b765c18 100644 --- a/byterun/config.h +++ b/byterun/config.h @@ -27,22 +27,41 @@ #include "compatibility.h" #endif -/* Types for signed chars, 16-bit integers, 32-bit integers, 64-bit integers */ +/* Types for signed chars, 32-bit integers, 64-bit integers, + native integers (as wide as a pointer type) */ typedef signed char schar; -typedef short int16; /* FIXME -- not true on the Cray T3E */ -typedef unsigned short uint16; /* FIXME -- not true on the Cray T3E */ +#if SIZEOF_PTR == SIZEOF_LONG +typedef long intnat; +typedef unsigned long uintnat; +#define ARCH_INTNAT_PRINTF_FORMAT "l" +#elif SIZEOF_PTR == SIZEOF_INT +typedef int intnat; +typedef unsigned int uintnat; +#define ARCH_INTNAT_PRINTF_FORMAT "" +#elif SIZEOF_PTR == 8 && defined(ARCH_INT64_TYPE) +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; +#define ARCH_INT32_PRINTF_FORMAT "" #elif SIZEOF_LONG == 4 typedef long int32; typedef unsigned long uint32; +#define ARCH_INT32_PRINTF_FORMAT "l" #elif SIZEOF_SHORT == 4 typedef short int32; typedef unsigned short uint32; +#define ARCH_INT32_PRINTF_FORMAT "" +#else +#error "No 32-bit integer type available" #endif #if defined(ARCH_INT64_TYPE) @@ -85,7 +104,7 @@ typedef struct { uint32 l, h; } uint64, int64; /* Memory model parameters */ /* The size of a page for memory management (in bytes) is [1 << Page_log]. - It must be a multiple of [sizeof (long)]. */ + It must be a multiple of [sizeof (value)]. */ #define Page_log 12 /* A page is 4 kilobytes. */ /* Initial size of stack (bytes). */ diff --git a/byterun/custom.c b/byterun/custom.c index 8e3f4a50f..24281db84 100644 --- a/byterun/custom.c +++ b/byterun/custom.c @@ -22,7 +22,7 @@ #include "mlvalues.h" CAMLexport value caml_alloc_custom(struct custom_operations * ops, - unsigned long size, + uintnat size, mlsize_t mem, mlsize_t max) { diff --git a/byterun/custom.h b/byterun/custom.h index 7caa75191..3855742f4 100644 --- a/byterun/custom.h +++ b/byterun/custom.h @@ -26,11 +26,11 @@ struct custom_operations { char *identifier; void (*finalize)(value v); int (*compare)(value v1, value v2); - long (*hash)(value v); + intnat (*hash)(value v); void (*serialize)(value v, - /*out*/ unsigned long * wsize_32 /*size in bytes*/, - /*out*/ unsigned long * wsize_64 /*size in bytes*/); - unsigned long (*deserialize)(void * dst); + /*out*/ uintnat * wsize_32 /*size in bytes*/, + /*out*/ uintnat * wsize_64 /*size in bytes*/); + uintnat (*deserialize)(void * dst); }; #define custom_finalize_default NULL @@ -42,7 +42,7 @@ struct custom_operations { #define Custom_ops_val(v) (*((struct custom_operations **) (v))) CAMLextern value caml_alloc_custom(struct custom_operations * ops, - unsigned long size, /*size in bytes*/ + uintnat size, /*size in bytes*/ mlsize_t mem, /*resources consumed*/ mlsize_t max /*max resources*/); diff --git a/byterun/debugger.c b/byterun/debugger.c index 41ab84544..df399fc89 100644 --- a/byterun/debugger.c +++ b/byterun/debugger.c @@ -30,7 +30,7 @@ #include "sys.h" int caml_debugger_in_use = 0; -unsigned long caml_event_count; +uintnat caml_event_count; #if !defined(HAS_SOCKETS) || defined(_WIN32) @@ -170,7 +170,7 @@ void caml_debugger(enum event_kind event) { int frame_number; value * frame; - long i, pos; + intnat i, pos; value val; if (dbg_socket == -1) return; /* Not connected to a debugger. */ diff --git a/byterun/debugger.h b/byterun/debugger.h index c8cbcd20e..59e23ec0e 100644 --- a/byterun/debugger.h +++ b/byterun/debugger.h @@ -23,7 +23,7 @@ extern int caml_debugger_in_use; extern int running; -extern unsigned long caml_event_count; +extern uintnat caml_event_count; enum event_kind { EVENT_COUNT, BREAKPOINT, PROGRAM_START, PROGRAM_EXIT, diff --git a/byterun/dynlink.c b/byterun/dynlink.c index cbbf5ea37..251206cc6 100644 --- a/byterun/dynlink.c +++ b/byterun/dynlink.c @@ -122,7 +122,7 @@ static void open_shared_lib(char * name) realname = caml_search_dll_in_path(&caml_shared_libs_path, name); caml_gc_message(0x100, "Loading shared library %s\n", - (unsigned long) realname); + (uintnat) realname); handle = caml_dlopen(realname); if (handle == NULL) caml_fatal_error_arg2("Fatal error: cannot load shared library %s\n", name, diff --git a/byterun/extern.c b/byterun/extern.c index d12d9b7cd..a8e367f18 100644 --- a/byterun/extern.c +++ b/byterun/extern.c @@ -29,9 +29,9 @@ #include "mlvalues.h" #include "reverse.h" -static unsigned long obj_counter; /* Number of objects emitted so far */ -static unsigned long size_32; /* Size in words of 32-bit block for struct. */ -static unsigned long size_64; /* Size in words of 64-bit block for struct. */ +static uintnat obj_counter; /* Number of objects emitted so far */ +static uintnat size_32; /* Size in words of 32-bit block for struct. */ +static uintnat size_64; /* Size in words of 64-bit block for struct. */ static int extern_ignore_sharing; /* Flag to ignore sharing */ static int extern_closures; /* Flag to allow externing code pointers */ @@ -156,10 +156,10 @@ static void free_extern_output(void) extern_output_first = NULL; } -static void grow_extern_output(long required) +static void grow_extern_output(intnat required) { struct output_block * blk; - long extra; + intnat extra; if (extern_userprovided_output != NULL) { extern_replay_trail(); @@ -179,10 +179,10 @@ static void grow_extern_output(long required) extern_limit = extern_output_block->data + SIZE_EXTERN_OUTPUT_BLOCK + extra; } -static long extern_output_length(void) +static intnat extern_output_length(void) { struct output_block * blk; - long len; + intnat len; if (extern_userprovided_output != NULL) { return extern_ptr - extern_userprovided_output; @@ -215,7 +215,7 @@ static void extern_invalid_argument(char *msg) if (extern_ptr >= extern_limit) grow_extern_output(1); \ *extern_ptr++ = (c) -static void writeblock(char *data, long len) +static void writeblock(char *data, intnat len) { if (extern_ptr + len > extern_limit) grow_extern_output(len); memmove(extern_ptr, data, len); @@ -230,7 +230,7 @@ static void writeblock(char *data, long len) caml_serialize_block_float_8((data), (ndoubles)) #endif -static void writecode8(int code, long int val) +static void writecode8(int code, intnat val) { if (extern_ptr + 2 > extern_limit) grow_extern_output(2); extern_ptr[0] = code; @@ -238,7 +238,7 @@ static void writecode8(int code, long int val) extern_ptr += 2; } -static void writecode16(int code, long int val) +static void writecode16(int code, intnat val) { if (extern_ptr + 3 > extern_limit) grow_extern_output(3); extern_ptr[0] = code; @@ -247,7 +247,7 @@ static void writecode16(int code, long int val) extern_ptr += 3; } -static void write32(long int val) +static void write32(intnat val) { if (extern_ptr + 4 > extern_limit) grow_extern_output(4); extern_ptr[0] = val >> 24; @@ -257,7 +257,7 @@ static void write32(long int val) extern_ptr += 4; } -static void writecode32(int code, long int val) +static void writecode32(int code, intnat val) { if (extern_ptr + 5 > extern_limit) grow_extern_output(5); extern_ptr[0] = code; @@ -269,7 +269,7 @@ static void writecode32(int code, long int val) } #ifdef ARCH_SIXTYFOUR -static void writecode64(int code, long val) +static void writecode64(int code, intnat val) { int i; if (extern_ptr + 9 > extern_limit) grow_extern_output(9); @@ -284,7 +284,7 @@ static void extern_rec(value v) { tailcall: if (Is_long(v)) { - long n = Long_val(v); + intnat n = Long_val(v); if (n >= 0 && n < 0x40) { Write(PREFIX_SMALL_INT + n); } else if (n >= -(1 << 7) && n < (1 << 7)) { @@ -327,7 +327,7 @@ static void extern_rec(value v) } /* Check if already seen */ if (Color_hd(hd) == Caml_blue) { - unsigned long d = obj_counter - (unsigned long) Field(v, 0); + uintnat d = obj_counter - (uintnat) Field(v, 0); if (d < 0x100) { writecode8(CODE_SHARED8, d); } else if (d < 0x10000) { @@ -389,10 +389,10 @@ static void extern_rec(value v) extern_rec(v - Infix_offset_hd(hd)); break; case Custom_tag: { - unsigned long sz_32, sz_64; + uintnat sz_32, sz_64; char * ident = Custom_ops_val(v)->identifier; - void (*serialize)(value v, unsigned long * wsize_32, - unsigned long * wsize_64) + void (*serialize)(value v, uintnat * wsize_32, + uintnat * wsize_64) = Custom_ops_val(v)->serialize; if (serialize == NULL) extern_invalid_argument("output_value: abstract value (Custom)"); @@ -445,9 +445,9 @@ static void extern_rec(value v) enum { NO_SHARING = 1, CLOSURES = 2 }; static int extern_flags[] = { NO_SHARING, CLOSURES }; -static long extern_value(value v, value flags) +static intnat extern_value(value v, value flags) { - long res_len; + intnat res_len; int fl; /* Parse flag list */ fl = caml_convert_flag_list(flags, extern_flags); @@ -495,7 +495,7 @@ static long extern_value(value v, value flags) void caml_output_val(struct channel *chan, value v, value flags) { - long len; + intnat len; struct output_block * blk, * nextblk; if (! caml_channel_binary_mode(chan)) @@ -527,7 +527,7 @@ CAMLprim value caml_output_value(value vchan, value v, value flags) CAMLprim value caml_output_value_to_string(value v, value flags) { - long len, ofs; + intnat len, ofs; value res; struct output_block * blk; @@ -546,7 +546,7 @@ CAMLprim value caml_output_value_to_string(value v, value flags) CAMLprim value caml_output_value_to_buffer(value buf, value ofs, value len, value v, value flags) { - long len_res; + intnat len_res; extern_userprovided_output = &Byte(buf, Long_val(ofs)); extern_ptr = extern_userprovided_output; extern_limit = extern_userprovided_output + Long_val(len); @@ -556,9 +556,9 @@ CAMLprim value caml_output_value_to_buffer(value buf, value ofs, value len, CAMLexport void caml_output_value_to_malloc(value v, value flags, /*out*/ char ** buf, - /*out*/ long * len) + /*out*/ intnat * len) { - long len_res; + intnat len_res; char * res; struct output_block * blk; @@ -576,10 +576,10 @@ CAMLexport void caml_output_value_to_malloc(value v, value flags, free_extern_output(); } -CAMLexport long caml_output_value_to_block(value v, value flags, - char * buf, long len) +CAMLexport intnat caml_output_value_to_block(value v, value flags, + char * buf, intnat len) { - long len_res; + intnat len_res; extern_userprovided_output = buf; extern_ptr = extern_userprovided_output; extern_limit = extern_userprovided_output + len; @@ -629,14 +629,14 @@ CAMLexport void caml_serialize_float_8(double f) caml_serialize_block_8(&f, 1); } -CAMLexport void caml_serialize_block_1(void * data, long len) +CAMLexport void caml_serialize_block_1(void * data, intnat len) { if (extern_ptr + len > extern_limit) grow_extern_output(len); memmove(extern_ptr, data, len); extern_ptr += len; } -CAMLexport void caml_serialize_block_2(void * data, long len) +CAMLexport void caml_serialize_block_2(void * data, intnat len) { if (extern_ptr + 2 * len > extern_limit) grow_extern_output(2 * len); #ifndef ARCH_BIG_ENDIAN @@ -653,7 +653,7 @@ CAMLexport void caml_serialize_block_2(void * data, long len) #endif } -CAMLexport void caml_serialize_block_4(void * data, long len) +CAMLexport void caml_serialize_block_4(void * data, intnat len) { if (extern_ptr + 4 * len > extern_limit) grow_extern_output(4 * len); #ifndef ARCH_BIG_ENDIAN @@ -670,7 +670,7 @@ CAMLexport void caml_serialize_block_4(void * data, long len) #endif } -CAMLexport void caml_serialize_block_8(void * data, long len) +CAMLexport void caml_serialize_block_8(void * data, intnat len) { if (extern_ptr + 8 * len > extern_limit) grow_extern_output(8 * len); #ifndef ARCH_BIG_ENDIAN @@ -687,7 +687,7 @@ CAMLexport void caml_serialize_block_8(void * data, long len) #endif } -CAMLexport void caml_serialize_block_float_8(void * data, long len) +CAMLexport void caml_serialize_block_float_8(void * data, intnat len) { if (extern_ptr + 8 * len > extern_limit) grow_extern_output(8 * len); #if ARCH_FLOAT_ENDIANNESS == 0x01234567 diff --git a/byterun/finalise.c b/byterun/finalise.c index 20b039489..e41131148 100644 --- a/byterun/finalise.c +++ b/byterun/finalise.c @@ -27,7 +27,7 @@ struct final { }; static struct final *final_table = NULL; -static unsigned long old = 0, young = 0, size = 0; +static uintnat old = 0, young = 0, size = 0; /* [0..old) : finalisable set [old..young) : recent set [young..size) : free space @@ -65,8 +65,8 @@ static void alloc_to_do (int size) */ void caml_final_update (void) { - unsigned long i, j, k; - unsigned long todo_count = 0; + uintnat i, j, k; + uintnat todo_count = 0; Assert (young == old); for (i = 0; i < old; i++){ @@ -154,7 +154,7 @@ void caml_final_do_calls (void) */ void caml_final_do_strong_roots (scanning_action f) { - unsigned long i; + uintnat i; struct to_do *todo; Assert (old == young); @@ -174,7 +174,7 @@ void caml_final_do_strong_roots (scanning_action f) */ void caml_final_do_weak_roots (scanning_action f) { - unsigned long i; + uintnat i; Assert (old == young); for (i = 0; i < old; i++) Call_action (f, final_table[i].val); @@ -185,7 +185,7 @@ void caml_final_do_weak_roots (scanning_action f) */ void caml_final_do_young_roots (scanning_action f) { - unsigned long i; + uintnat i; Assert (old <= young); for (i = old; i < young; i++){ @@ -213,13 +213,13 @@ CAMLprim value caml_final_register (value f, value v) if (young >= size){ if (final_table == NULL){ - unsigned long new_size = 30; + uintnat new_size = 30; final_table = caml_stat_alloc (new_size * sizeof (struct final)); Assert (old == 0); Assert (young == 0); size = new_size; }else{ - unsigned long new_size = size * 2; + uintnat new_size = size * 2; final_table = caml_stat_resize (final_table, new_size * sizeof (struct final)); size = new_size; diff --git a/byterun/floats.c b/byterun/floats.c index 6ef592026..2db4a7bb7 100644 --- a/byterun/floats.c +++ b/byterun/floats.c @@ -112,8 +112,8 @@ CAMLprim value caml_format_float(value fmt, value arg) char * buf, * src, * dst, * end; mlsize_t len, lenvs; double d; - long flen = Int_val(l); - long fidx = Int_val(idx); + intnat flen = Long_val(l); + intnat fidx = Long_val(idx); lenvs = caml_string_length(vs); len = @@ -159,7 +159,7 @@ CAMLprim value caml_float_of_string(value vs) CAMLprim value caml_int_of_float(value f) { - return Val_long((long) Double_val(f)); + return Val_long((intnat) Double_val(f)); } CAMLprim value caml_float_of_int(value n) diff --git a/byterun/freelist.c b/byterun/freelist.c index 00b095e96..c463d91f7 100644 --- a/byterun/freelist.c +++ b/byterun/freelist.c @@ -55,7 +55,7 @@ static void fl_check (void) { char *cur, *prev; int prev_found = 0, merge_found = 0; - unsigned long size_found = 0; + uintnat size_found = 0; prev = Fl_head; cur = Next (prev); diff --git a/byterun/gc_ctrl.c b/byterun/gc_ctrl.c index ed4bc3de3..12bfc9b0a 100644 --- a/byterun/gc_ctrl.c +++ b/byterun/gc_ctrl.c @@ -26,23 +26,23 @@ #include "stacks.h" #ifndef NATIVE_CODE -extern unsigned long caml_max_stack_size; /* defined in stacks.c */ +extern uintnat caml_max_stack_size; /* defined in stacks.c */ #endif double caml_stat_minor_words = 0.0, caml_stat_promoted_words = 0.0, caml_stat_major_words = 0.0; -long caml_stat_minor_collections = 0, - caml_stat_major_collections = 0, - caml_stat_heap_size = 0, /* bytes */ - caml_stat_top_heap_size = 0, /* bytes */ - caml_stat_compactions = 0, - caml_stat_heap_chunks = 0; +intnat caml_stat_minor_collections = 0, + caml_stat_major_collections = 0, + caml_stat_heap_size = 0, /* bytes */ + caml_stat_top_heap_size = 0, /* bytes */ + caml_stat_compactions = 0, + caml_stat_heap_chunks = 0; extern asize_t caml_major_heap_increment; /* bytes; see major_gc.c */ -extern unsigned long caml_percent_free; /* see major_gc.c */ -extern unsigned long caml_percent_max; /* see compact.c */ +extern uintnat caml_percent_free; /* see major_gc.c */ +extern uintnat caml_percent_max; /* see compact.c */ #define Next(hp) ((hp) + Bhsize_hp (hp)) @@ -116,9 +116,9 @@ static void check_block (char *hp) static value heap_stats (int returnstats) { CAMLparam0 (); - long live_words = 0, live_blocks = 0, - free_words = 0, free_blocks = 0, largest_free = 0, - fragments = 0, heap_chunks = 0; + intnat live_words = 0, live_blocks = 0, + free_words = 0, free_blocks = 0, largest_free = 0, + fragments = 0, heap_chunks = 0; char *chunk = caml_heap_start, *chunk_end; char *cur_hp, *prev_hp; header_t cur_hd; @@ -203,11 +203,11 @@ static value heap_stats (int returnstats) + (double) Wsize_bsize (caml_young_end - caml_young_ptr); double prowords = caml_stat_promoted_words; double majwords = caml_stat_major_words + (double) caml_allocated_words; - long mincoll = caml_stat_minor_collections; - long majcoll = caml_stat_major_collections; - long heap_words = Wsize_bsize (caml_stat_heap_size); - long cpct = caml_stat_compactions; - long top_heap_words = Wsize_bsize (caml_stat_top_heap_size); + intnat mincoll = caml_stat_minor_collections; + intnat majcoll = caml_stat_major_collections; + intnat heap_words = Wsize_bsize (caml_stat_heap_size); + intnat cpct = caml_stat_compactions; + intnat top_heap_words = Wsize_bsize (caml_stat_top_heap_size); res = caml_alloc_tuple (15); Store_field (res, 0, caml_copy_double (minwords)); @@ -254,12 +254,12 @@ CAMLprim value caml_gc_quick_stat(value v) + (double) Wsize_bsize (caml_young_end - caml_young_ptr); double prowords = caml_stat_promoted_words; double majwords = caml_stat_major_words + (double) caml_allocated_words; - long mincoll = caml_stat_minor_collections; - long majcoll = caml_stat_major_collections; - long heap_words = caml_stat_heap_size / sizeof (value); - long top_heap_words = caml_stat_top_heap_size / sizeof (value); - long cpct = caml_stat_compactions; - long heap_chunks = caml_stat_heap_chunks; + intnat mincoll = caml_stat_minor_collections; + intnat majcoll = caml_stat_major_collections; + intnat heap_words = caml_stat_heap_size / sizeof (value); + intnat top_heap_words = caml_stat_top_heap_size / sizeof (value); + intnat cpct = caml_stat_compactions; + intnat heap_chunks = caml_stat_heap_chunks; res = caml_alloc_tuple (15); Store_field (res, 0, caml_copy_double (minwords)); @@ -319,17 +319,17 @@ CAMLprim value caml_gc_get(value v) #define Max(x,y) ((x) < (y) ? (y) : (x)) -static unsigned long norm_pfree (long unsigned int p) +static uintnat norm_pfree (uintnat p) { return Max (p, 1); } -static unsigned long norm_pmax (long unsigned int p) +static uintnat norm_pmax (uintnat p) { return p; } -static long norm_heapincr (long unsigned int i) +static intnat norm_heapincr (uintnat i) { #define Psv (Wsize_bsize (Page_size)) i = ((i + Psv - 1) / Psv) * Psv; @@ -337,7 +337,7 @@ static long norm_heapincr (long unsigned int i) return i; } -static long norm_minsize (long int s) +static intnat norm_minsize (intnat s) { if (s < Minor_heap_min) s = Minor_heap_min; if (s > Minor_heap_max) s = Minor_heap_max; @@ -346,7 +346,7 @@ static long norm_minsize (long int s) CAMLprim value caml_gc_set(value v) { - unsigned long newpf, newpm; + uintnat newpf, newpm; asize_t newheapincr; asize_t newminsize; @@ -399,8 +399,9 @@ static void test_and_compact (void) fp = 100.0 * caml_fl_cur_size / (Wsize_bsize (caml_stat_heap_size) - caml_fl_cur_size); if (fp > 1000000.0) fp = 1000000.0; - caml_gc_message (0x200, "Estimated overhead (lower bound) = %lu%%\n", - (unsigned long) fp); + caml_gc_message (0x200, "Estimated overhead (lower bound) = %" + ARCH_INTNAT_PRINTF_FORMAT "u%%\n", + (uintnat) fp); if (fp >= caml_percent_max && caml_stat_heap_chunks > 1){ caml_gc_message (0x200, "Automatic compaction triggered.\n", 0); caml_compact_heap (); @@ -447,11 +448,11 @@ CAMLprim value caml_gc_compaction(value v) return Val_unit; } -void caml_init_gc (unsigned long minor_size, unsigned long major_size, - unsigned long major_incr, unsigned long percent_fr, - unsigned long percent_m) +void caml_init_gc (uintnat minor_size, uintnat major_size, + uintnat major_incr, uintnat percent_fr, + uintnat percent_m) { - unsigned long major_heap_size = Bsize_wsize (norm_heapincr (major_size)); + uintnat major_heap_size = Bsize_wsize (norm_heapincr (major_size)); #ifdef DEBUG caml_gc_message (-1, "### O'Caml runtime: debug mode ###\n", 0); diff --git a/byterun/gc_ctrl.h b/byterun/gc_ctrl.h index b5a2e87f7..205636d59 100644 --- a/byterun/gc_ctrl.h +++ b/byterun/gc_ctrl.h @@ -23,7 +23,7 @@ extern double caml_stat_promoted_words, caml_stat_major_words; -extern long +extern intnat caml_stat_minor_collections, caml_stat_major_collections, caml_stat_heap_size, @@ -31,8 +31,8 @@ extern long caml_stat_compactions, caml_stat_heap_chunks; -void caml_init_gc (unsigned long, unsigned long, unsigned long, - unsigned long, unsigned long); +void caml_init_gc (uintnat, uintnat, uintnat, + uintnat, uintnat); #ifdef DEBUG diff --git a/byterun/globroots.c b/byterun/globroots.c index e9d3d6c11..792da34d8 100644 --- a/byterun/globroots.c +++ b/byterun/globroots.c @@ -61,7 +61,7 @@ CAMLexport void caml_register_global_root(value *r) struct global_root * e, * f; int i, new_level; - Assert (((long) r & 3) == 0); /* compact.c demands this (for now) */ + Assert (((intnat) r & 3) == 0); /* compact.c demands this (for now) */ /* Init "cursor" to list head */ e = (struct global_root *) &caml_global_roots; diff --git a/byterun/hash.c b/byterun/hash.c index 17748e393..2b8a23575 100644 --- a/byterun/hash.c +++ b/byterun/hash.c @@ -21,8 +21,8 @@ #include "custom.h" #include "memory.h" -static unsigned long hash_accu; -static long hash_univ_limit, hash_univ_count; +static uintnat hash_accu; +static intnat hash_univ_limit, hash_univ_count; static void hash_aux(value obj); @@ -137,7 +137,7 @@ static void hash_aux(value obj) /* Otherwise, obj is a pointer outside the heap, to an object with a priori unknown structure. Use its physical address as hash key. */ - Combine((long) obj); + Combine((intnat) obj); } /* Hashing variant tags */ diff --git a/byterun/instrtrace.c b/byterun/instrtrace.c index 03260b41e..ef6bdcf91 100644 --- a/byterun/instrtrace.c +++ b/byterun/instrtrace.c @@ -30,7 +30,7 @@ extern code_t caml_start_code; -long caml_icount = 0; +intnat caml_icount = 0; void caml_stop_here () {} @@ -193,10 +193,10 @@ caml_trace_value_file (value v, code_t prog, int proglen, FILE * f) && (code_t) v < (code_t) ((char *) prog + proglen)) fprintf (f, "=code@%d", (code_t) v - prog); else if (Is_long (v)) - fprintf (f, "=long%ld", Long_val (v)); + fprintf (f, "=long%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val (v)); else if ((void*)v >= (void*)caml_stack_low && (void*)v < (void*)caml_stack_high) - fprintf (f, "=stack_%d", (long*)caml_stack_high - (long*)v); + fprintf (f, "=stack_%d", (intnat*)caml_stack_high - (intnat*)v); else if (Is_block (v)) { int s = Wosize_val (v); int tg = Tag_val (v); @@ -259,7 +259,8 @@ caml_trace_accu_sp_file (value accu, value * sp, code_t prog, int proglen, value *p; fprintf (f, "accu="); caml_trace_value_file (accu, prog, proglen, f); - fprintf (f, "\n sp=%#lx @%d:", (long) sp, caml_stack_high - sp); + fprintf (f, "\n sp=%#" ARCH_INTNAT_PRINTF_FORMAT "x @%d:", + (intnat) sp, caml_stack_high - sp); for (p = sp, i = 0; i < 12 + (1 << caml_trace_flag) && p < caml_stack_high; p++, i++) { fprintf (f, "\n[%d] ", caml_stack_high - p); diff --git a/byterun/instrtrace.h b/byterun/instrtrace.h index 9df4a6235..c1ca4a7ec 100644 --- a/byterun/instrtrace.h +++ b/byterun/instrtrace.h @@ -23,7 +23,7 @@ #include "misc.h" extern int caml_trace_flag; -extern long caml_icount; +extern intnat caml_icount; void caml_stop_here (void); void caml_disasm_instr (code_t pc); void caml_trace_value_file (value v, code_t prog, int proglen, FILE * f); diff --git a/byterun/int64_emul.h b/byterun/int64_emul.h index 407cd2bf9..04e38656f 100644 --- a/byterun/int64_emul.h +++ b/byterun/int64_emul.h @@ -239,10 +239,10 @@ static int64 I64_of_int32(int32 x) #define I64_to_int32(x) ((int32) (x).l) -/* Note: we assume sizeof(long) = 4 here, which is true otherwise +/* Note: we assume sizeof(intnat) = 4 here, which is true otherwise autoconfiguration would have selected native 64-bit integers */ -#define I64_of_long I64_of_int32 -#define I64_to_long I64_to_int32 +#define I64_of_intnat I64_of_int32 +#define I64_to_intnat I64_to_int32 static double I64_to_double(int64 x) { diff --git a/byterun/int64_native.h b/byterun/int64_native.h index fc0d0dcfe..f5bef4a6f 100644 --- a/byterun/int64_native.h +++ b/byterun/int64_native.h @@ -40,8 +40,8 @@ #define I64_lsl(x,y) ((x) << (y)) #define I64_asr(x,y) ((x) >> (y)) #define I64_lsr(x,y) ((uint64)(x) >> (y)) -#define I64_to_long(x) ((long) (x)) -#define I64_of_long(x) ((int64) (x)) +#define I64_to_intnat(x) ((intnat) (x)) +#define I64_of_intnat(x) ((intnat) (x)) #define I64_to_int32(x) ((int32) (x)) #define I64_of_int32(x) ((int64) (x)) #define I64_to_double(x) ((double)(x)) diff --git a/byterun/intern.c b/byterun/intern.c index b855404e1..5f99b5b06 100644 --- a/byterun/intern.c +++ b/byterun/intern.c @@ -63,8 +63,8 @@ static value intern_block; /* Point to the heap block allocated as destination block. Meaningful only if intern_extra_block is NULL. */ -#define Sign_extend_shift ((sizeof(long) - 1) * 8) -#define Sign_extend(x) (((long)(x) << Sign_extend_shift) >> Sign_extend_shift) +#define Sign_extend_shift ((sizeof(intnat) - 1) * 8) +#define Sign_extend(x) (((intnat)(x) << Sign_extend_shift) >> Sign_extend_shift) #define read8u() (*intern_src++) #define read8s() Sign_extend(*intern_src++) @@ -84,9 +84,9 @@ static value intern_block; (intern_src[-2] << 8) + intern_src[-1]) #ifdef ARCH_SIXTYFOUR -static long read64s(void) +static intnat read64s(void) { - long res; + intnat res; int i; res = 0; for (i = 0; i < 8; i++) res = (res << 8) + intern_src[i]; @@ -443,7 +443,7 @@ CAMLprim value caml_input_value(value vchan) CAMLreturn (res); } -CAMLexport value caml_input_val_from_string(value str, long int ofs) +CAMLexport value caml_input_val_from_string(value str, intnat ofs) { CAMLparam1 (str); mlsize_t num_objects, size_32, size_64, whsize; @@ -498,7 +498,7 @@ static value input_val_from_block(void) return obj; } -CAMLexport value caml_input_value_from_malloc(char * data, long ofs) +CAMLexport value caml_input_value_from_malloc(char * data, intnat ofs) { uint32 magic; mlsize_t block_len; @@ -517,7 +517,7 @@ CAMLexport value caml_input_value_from_malloc(char * data, long ofs) return obj; } -CAMLexport value caml_input_value_from_block(char * data, long len) +CAMLexport value caml_input_value_from_block(char * data, intnat len) { uint32 magic; mlsize_t block_len; @@ -645,13 +645,13 @@ CAMLexport double caml_deserialize_float_8(void) return f; } -CAMLexport void caml_deserialize_block_1(void * data, long len) +CAMLexport void caml_deserialize_block_1(void * data, intnat len) { memmove(data, intern_src, len); intern_src += len; } -CAMLexport void caml_deserialize_block_2(void * data, long len) +CAMLexport void caml_deserialize_block_2(void * data, intnat len) { #ifndef ARCH_BIG_ENDIAN unsigned char * p, * q; @@ -664,7 +664,7 @@ CAMLexport void caml_deserialize_block_2(void * data, long len) #endif } -CAMLexport void caml_deserialize_block_4(void * data, long len) +CAMLexport void caml_deserialize_block_4(void * data, intnat len) { #ifndef ARCH_BIG_ENDIAN unsigned char * p, * q; @@ -677,7 +677,7 @@ CAMLexport void caml_deserialize_block_4(void * data, long len) #endif } -CAMLexport void caml_deserialize_block_8(void * data, long len) +CAMLexport void caml_deserialize_block_8(void * data, intnat len) { #ifndef ARCH_BIG_ENDIAN unsigned char * p, * q; @@ -690,7 +690,7 @@ CAMLexport void caml_deserialize_block_8(void * data, long len) #endif } -CAMLexport void caml_deserialize_block_float_8(void * data, long len) +CAMLexport void caml_deserialize_block_float_8(void * data, intnat len) { #if ARCH_FLOAT_ENDIANNESS == 0x01234567 memmove(data, intern_src, len * 8); diff --git a/byterun/interp.c b/byterun/interp.c index ed6b154c1..e19d537ed 100644 --- a/byterun/interp.c +++ b/byterun/interp.c @@ -179,13 +179,13 @@ sp is a local copy of the global variable caml_extern_sp. */ /* Division and modulus madness */ #ifdef NONSTANDARD_DIV_MOD -extern long caml_safe_div(long p, long q); -extern long caml_safe_mod(long p, long q); +extern intnat caml_safe_div(intnat p, intnat q); +extern intnat caml_safe_mod(intnat p, intnat q); #endif #ifdef DEBUG -static long caml_bcodcount; +static intnat caml_bcodcount; #endif /* The interpreter itself */ @@ -209,7 +209,7 @@ value caml_interprete(code_t prog, asize_t prog_size) #endif #endif value env; - long extra_args; + intnat extra_args; struct longjmp_buffer * initial_external_raise; int initial_sp_offset; /* volatile ensures that initial_local_roots and saved_pc @@ -779,13 +779,12 @@ value caml_interprete(code_t prog, asize_t prog_size) Instruct(SWITCH): { uint32 sizes = *pc++; if (Is_block(accu)) { - long index = Tag_val(accu); - Assert (index >= 0); - Assert (index < (sizes >> 16)); + intnat index = Tag_val(accu); + Assert ((uintnat) index < (sizes >> 16)); pc += pc[(sizes & 0xFFFF) + index]; } else { - long index = Long_val(accu); - Assert ((unsigned long) index < (sizes & 0xFFFF)) ; + intnat index = Long_val(accu); + Assert ((uintnat) index < (sizes & 0xFFFF)) ; pc += pc[index]; } Next; @@ -939,16 +938,16 @@ value caml_interprete(code_t prog, asize_t prog_size) /* Integer arithmetic */ Instruct(NEGINT): - accu = (value)(2 - (long)accu); Next; + accu = (value)(2 - (intnat)accu); Next; Instruct(ADDINT): - accu = (value)((long) accu + (long) *sp++ - 1); Next; + accu = (value)((intnat) accu + (intnat) *sp++ - 1); Next; Instruct(SUBINT): - accu = (value)((long) accu - (long) *sp++ + 1); Next; + accu = (value)((intnat) accu - (intnat) *sp++ + 1); Next; Instruct(MULINT): accu = Val_long(Long_val(accu) * Long_val(*sp++)); Next; Instruct(DIVINT): { - long divisor = Long_val(*sp++); + 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)); @@ -958,7 +957,7 @@ value caml_interprete(code_t prog, asize_t prog_size) Next; } Instruct(MODINT): { - long divisor = Long_val(*sp++); + 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)); @@ -968,48 +967,48 @@ value caml_interprete(code_t prog, asize_t prog_size) Next; } Instruct(ANDINT): - accu = (value)((long) accu & (long) *sp++); Next; + accu = (value)((intnat) accu & (intnat) *sp++); Next; Instruct(ORINT): - accu = (value)((long) accu | (long) *sp++); Next; + accu = (value)((intnat) accu | (intnat) *sp++); Next; Instruct(XORINT): - accu = (value)(((long) accu ^ (long) *sp++) | 1); Next; + accu = (value)(((intnat) accu ^ (intnat) *sp++) | 1); Next; Instruct(LSLINT): - accu = (value)((((long) accu - 1) << Long_val(*sp++)) + 1); Next; + accu = (value)((((intnat) accu - 1) << Long_val(*sp++)) + 1); Next; Instruct(LSRINT): - accu = (value)((((unsigned long) accu - 1) >> Long_val(*sp++)) | 1); + accu = (value)((((uintnat) accu - 1) >> Long_val(*sp++)) | 1); Next; Instruct(ASRINT): - accu = (value)((((long) accu - 1) >> Long_val(*sp++)) | 1); Next; + accu = (value)((((intnat) accu - 1) >> Long_val(*sp++)) | 1); Next; -#define Integer_comparison(sign,opname,tst) \ +#define Integer_comparison(typ,opname,tst) \ Instruct(opname): \ - accu = Val_int((sign long) accu tst (sign long) *sp++); Next; - - Integer_comparison(signed,EQ, ==) - Integer_comparison(signed,NEQ, !=) - Integer_comparison(signed,LTINT, <) - Integer_comparison(signed,LEINT, <=) - Integer_comparison(signed,GTINT, >) - Integer_comparison(signed,GEINT, >=) - Integer_comparison(unsigned,ULTINT, <) - Integer_comparison(unsigned,UGEINT, >=) - -#define Integer_branch_comparison(sign,opname,tst,debug) \ + accu = Val_int((typ) accu tst (typ) *sp++); Next; + + Integer_comparison(intnat,EQ, ==) + Integer_comparison(intnat,NEQ, !=) + Integer_comparison(intnat,LTINT, <) + Integer_comparison(intnat,LEINT, <=) + Integer_comparison(intnat,GTINT, >) + Integer_comparison(intnat,GEINT, >=) + Integer_comparison(uintnat,ULTINT, <) + Integer_comparison(uintnat,UGEINT, >=) + +#define Integer_branch_comparison(typ,opname,tst,debug) \ Instruct(opname): \ - if ( *pc++ tst ((sign long)Long_val(accu))) { \ + if ( *pc++ tst (typ) Long_val(accu)) { \ pc += *pc ; \ } else { \ pc++ ; \ } ; Next; - Integer_branch_comparison(signed,BEQ, ==, "==") - Integer_branch_comparison(signed,BNEQ, !=, "!=") - Integer_branch_comparison(signed,BLTINT, <, "<") - Integer_branch_comparison(signed,BLEINT, <=, "<=") - Integer_branch_comparison(signed,BGTINT, >, ">") - Integer_branch_comparison(signed,BGEINT, >=, ">=") - Integer_branch_comparison(unsigned,BULTINT, <, "<") - Integer_branch_comparison(unsigned,BUGEINT, >=, ">=") + Integer_branch_comparison(intnat,BEQ, ==, "==") + Integer_branch_comparison(intnat,BNEQ, !=, "!=") + Integer_branch_comparison(intnat,BLTINT, <, "<") + Integer_branch_comparison(intnat,BLEINT, <=, "<=") + Integer_branch_comparison(intnat,BGTINT, >, ">") + Integer_branch_comparison(intnat,BGEINT, >=, ">=") + Integer_branch_comparison(uintnat,BULTINT, <, "<") + Integer_branch_comparison(uintnat,BUGEINT, >=, ">=") Instruct(OFFSETINT): accu += *pc << 1; @@ -1120,8 +1119,9 @@ value caml_interprete(code_t prog, asize_t prog_size) #if _MSC_VER >= 1200 __assume(0); #else - caml_fatal_error_arg("Fatal error: bad opcode (%lx)\n", - (char *)(long)(*(pc-1))); + caml_fatal_error_arg("Fatal error: bad opcode (%" + ARCH_INTNAT_PRINTF_FORMAT "x)\n", + (uintnat)(*(pc-1))); #endif } } diff --git a/byterun/intext.h b/byterun/intext.h index 6326b97f3..b757d1718 100644 --- a/byterun/intext.h +++ b/byterun/intext.h @@ -83,12 +83,12 @@ void caml_output_val (struct channel * chan, value v, value flags); CAMLextern void caml_output_value_to_malloc(value v, value flags, /*out*/ char ** buf, - /*out*/ long * len); + /*out*/ intnat * len); /* Output [v] with flags [flags] to a memory buffer allocated with malloc. On return, [*buf] points to the buffer and [*len] contains the number of bytes in buffer. */ -CAMLextern long caml_output_value_to_block(value v, value flags, - char * data, long len); +CAMLextern intnat caml_output_value_to_block(value v, value flags, + char * data, intnat len); /* Output [v] with flags [flags] to a user-provided memory buffer. [data] points to the start of this buffer, and [len] is its size in bytes. Return the number of bytes actually written in buffer. @@ -99,15 +99,15 @@ value caml_input_val (struct channel * chan); /* Read a structured value from the channel [chan]. */ /* </private> */ -CAMLextern value caml_input_val_from_string (value str, long ofs); +CAMLextern value caml_input_val_from_string (value str, intnat ofs); /* Read a structured value from the Caml string [str], starting at offset [ofs]. */ -CAMLextern value caml_input_value_from_malloc(char * data, long ofs); +CAMLextern value caml_input_value_from_malloc(char * data, intnat ofs); /* Read a structured value from a malloced buffer. [data] points to the beginning of the buffer, and [ofs] is the offset of the beginning of the externed data in this buffer. The buffer is deallocated with [free] on return, or if an exception is raised. */ -CAMLextern value caml_input_value_from_block(char * data, long len); +CAMLextern value caml_input_value_from_block(char * data, intnat len); /* Read a structured value from a user-provided buffer. [data] points to the beginning of the externed data in this buffer, and [len] is the length in bytes of valid data in this buffer. @@ -121,11 +121,11 @@ CAMLextern void caml_serialize_int_4(int32 i); CAMLextern void caml_serialize_int_8(int64 i); CAMLextern void caml_serialize_float_4(float f); CAMLextern void caml_serialize_float_8(double f); -CAMLextern void caml_serialize_block_1(void * data, long len); -CAMLextern void caml_serialize_block_2(void * data, long len); -CAMLextern void caml_serialize_block_4(void * data, long len); -CAMLextern void caml_serialize_block_8(void * data, long len); -CAMLextern void caml_serialize_block_float_8(void * data, long len); +CAMLextern void caml_serialize_block_1(void * data, intnat len); +CAMLextern void caml_serialize_block_2(void * data, intnat len); +CAMLextern void caml_serialize_block_4(void * data, intnat len); +CAMLextern void caml_serialize_block_8(void * data, intnat len); +CAMLextern void caml_serialize_block_float_8(void * data, intnat len); CAMLextern int caml_deserialize_uint_1(void); CAMLextern int caml_deserialize_sint_1(void); @@ -137,11 +137,11 @@ CAMLextern uint64 caml_deserialize_uint_8(void); CAMLextern int64 caml_deserialize_sint_8(void); CAMLextern float caml_deserialize_float_4(void); CAMLextern double caml_deserialize_float_8(void); -CAMLextern void caml_deserialize_block_1(void * data, long len); -CAMLextern void caml_deserialize_block_2(void * data, long len); -CAMLextern void caml_deserialize_block_4(void * data, long len); -CAMLextern void caml_deserialize_block_8(void * data, long len); -CAMLextern void caml_deserialize_block_float_8(void * data, long len); +CAMLextern void caml_deserialize_block_1(void * data, intnat len); +CAMLextern void caml_deserialize_block_2(void * data, intnat len); +CAMLextern void caml_deserialize_block_4(void * data, intnat len); +CAMLextern void caml_deserialize_block_8(void * data, intnat len); +CAMLextern void caml_deserialize_block_float_8(void * data, intnat len); CAMLextern void caml_deserialize_error(char * msg); /* <private> */ diff --git a/byterun/ints.c b/byterun/ints.c index 2106fbd66..9d18abd83 100644 --- a/byterun/ints.c +++ b/byterun/ints.c @@ -58,14 +58,14 @@ static int parse_digit(char c) return -1; } -static long parse_long(value s, int nbits) +static intnat parse_intnat(value s, int nbits) { char * p; - unsigned long res, threshold; + uintnat res, threshold; int sign, base, d; p = parse_sign_and_base(String_val(s), &base, &sign); - threshold = ((unsigned long) -1) / base; + threshold = ((uintnat) -1) / base; d = parse_digit(*p); if (d < 0 || d >= base) caml_failwith("int_of_string"); for (p++, res = d; /*nothing*/; p++) { @@ -77,7 +77,7 @@ static long parse_long(value s, int nbits) if (res > threshold) caml_failwith("int_of_string"); res = base * res + d; /* Detect overflow in addition (base * res) + d */ - if (res < (unsigned long) d) caml_failwith("int_of_string"); + if (res < (uintnat) d) caml_failwith("int_of_string"); } if (p != String_val(s) + caml_string_length(s)){ caml_failwith("int_of_string"); @@ -89,26 +89,26 @@ static long parse_long(value s, int nbits) } else { /* Unsigned representation expected, allow 0 to 2^nbits - 1 and tolerate -(2^nbits - 1) to 0 */ - if (nbits < sizeof(unsigned long) * 8 && res >= 1UL << nbits) + if (nbits < sizeof(uintnat) * 8 && res >= 1UL << nbits) caml_failwith("int_of_string"); } - return sign < 0 ? -((long) res) : (long) res; + return sign < 0 ? -((intnat) res) : (intnat) res; } #ifdef NONSTANDARD_DIV_MOD -long caml_safe_div(long p, long q) +intnat caml_safe_div(intnat p, intnat q) { - unsigned long ap = p >= 0 ? p : -p; - unsigned long aq = q >= 0 ? q : -q; - unsigned long ar = ap / aq; + uintnat ap = p >= 0 ? p : -p; + uintnat aq = q >= 0 ? q : -q; + uintnat ar = ap / aq; return (p ^ q) >= 0 ? ar : -ar; } -long caml_safe_mod(long p, long q) +intnat caml_safe_mod(intnat p, intnat q) { - unsigned long ap = p >= 0 ? p : -p; - unsigned long aq = q >= 0 ? q : -q; - unsigned long ar = ap % aq; + uintnat ap = p >= 0 ? p : -p; + uintnat aq = q >= 0 ? q : -q; + uintnat ar = ap % aq; return p >= 0 ? ar : -ar; } #endif @@ -123,7 +123,7 @@ CAMLprim value caml_int_compare(value v1, value v2) CAMLprim value caml_int_of_string(value s) { - return Val_long(parse_long(s, 8 * sizeof(value) - 1)); + return Val_long(parse_intnat(s, 8 * sizeof(value) - 1)); } #define FORMAT_BUFFER_SIZE 32 @@ -199,19 +199,19 @@ static int int32_cmp(value v1, value v2) return (i1 > i2) - (i1 < i2); } -static long int32_hash(value v) +static intnat int32_hash(value v) { return Int32_val(v); } -static void int32_serialize(value v, unsigned long * wsize_32, - unsigned long * wsize_64) +static void int32_serialize(value v, uintnat * wsize_32, + uintnat * wsize_64) { caml_serialize_int_4(Int32_val(v)); *wsize_32 = *wsize_64 = 4; } -static unsigned long int32_deserialize(void * dst) +static uintnat int32_deserialize(void * dst) { *((int32 *) dst) = caml_deserialize_sint_4(); return 4; @@ -313,8 +313,9 @@ CAMLprim value caml_int32_format(value fmt, value arg) char conv; value res; - buffer = parse_format(fmt, "", format_string, default_format_buffer, &conv); - sprintf(buffer, format_string, (long) Int32_val(arg)); + 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; @@ -322,7 +323,7 @@ CAMLprim value caml_int32_format(value fmt, value arg) CAMLprim value caml_int32_of_string(value s) { - return caml_copy_int32(parse_long(s, 32)); + return caml_copy_int32(parse_intnat(s, 32)); } CAMLprim value caml_int32_bits_of_float(value vd) @@ -366,19 +367,19 @@ static int int64_cmp(value v1, value v2) return I64_compare(i1, i2); } -static long int64_hash(value v) +static intnat int64_hash(value v) { - return I64_to_long(Int64_val(v)); + return I64_to_intnat(Int64_val(v)); } -static void int64_serialize(value v, unsigned long * wsize_32, - unsigned long * wsize_64) +static void int64_serialize(value v, uintnat * wsize_32, + uintnat * wsize_64) { caml_serialize_int_8(Int64_val(v)); *wsize_32 = *wsize_64 = 8; } -static unsigned long int64_deserialize(void * dst) +static uintnat int64_deserialize(void * dst) { #ifndef ARCH_ALIGN_INT64 *((int64 *) dst) = caml_deserialize_sint_8(); @@ -459,10 +460,10 @@ CAMLprim value caml_int64_shift_right_unsigned(value v1, value v2) { return caml_copy_int64(I64_lsr(Int64_val(v1), Int_val(v2))); } CAMLprim value caml_int64_of_int(value v) -{ return caml_copy_int64(I64_of_long(Long_val(v))); } +{ return caml_copy_int64(I64_of_intnat(Long_val(v))); } CAMLprim value caml_int64_to_int(value v) -{ return Val_long(I64_to_long(Int64_val(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))); } @@ -480,10 +481,10 @@ CAMLprim value caml_int64_to_int32(value v) { return caml_copy_int32(I64_to_int32(Int64_val(v))); } CAMLprim value caml_int64_of_nativeint(value v) -{ return caml_copy_int64(I64_of_long(Nativeint_val(v))); } +{ return caml_copy_int64(I64_of_intnat(Nativeint_val(v))); } CAMLprim value caml_int64_to_nativeint(value v) -{ return caml_copy_nativeint(I64_to_long(Int64_val(v))); } +{ return caml_copy_nativeint(I64_to_intnat(Int64_val(v))); } CAMLprim value caml_int64_compare(value v1, value v2) { @@ -565,20 +566,20 @@ CAMLprim value caml_int64_float_of_bits(value vi) static int nativeint_cmp(value v1, value v2) { - long i1 = Nativeint_val(v1); - long i2 = Nativeint_val(v2); + intnat i1 = Nativeint_val(v1); + intnat i2 = Nativeint_val(v2); return (i1 > i2) - (i1 < i2); } -static long nativeint_hash(value v) +static intnat nativeint_hash(value v) { return Nativeint_val(v); } -static void nativeint_serialize(value v, unsigned long * wsize_32, - unsigned long * wsize_64) +static void nativeint_serialize(value v, uintnat * wsize_32, + uintnat * wsize_64) { - long l = Nativeint_val(v); + intnat l = Nativeint_val(v); #ifdef ARCH_SIXTYFOUR if (l <= 0x7FFFFFFFL && l >= -0x80000000L) { caml_serialize_int_1(1); @@ -595,7 +596,7 @@ static void nativeint_serialize(value v, unsigned long * wsize_32, *wsize_64 = 8; } -static unsigned long nativeint_deserialize(void * dst) +static uintnat nativeint_deserialize(void * dst) { switch (caml_deserialize_uint_1()) { case 1: @@ -623,9 +624,9 @@ CAMLexport struct custom_operations caml_nativeint_ops = { nativeint_deserialize }; -CAMLexport value caml_copy_nativeint(long i) +CAMLexport value caml_copy_nativeint(intnat i) { - value res = caml_alloc_custom(&caml_nativeint_ops, sizeof(long), 0, 1); + value res = caml_alloc_custom(&caml_nativeint_ops, sizeof(intnat), 0, 1); Nativeint_val(res) = i; return res; } @@ -644,7 +645,7 @@ CAMLprim value caml_nativeint_mul(value v1, value v2) CAMLprim value caml_nativeint_div(value v1, value v2) { - long divisor = Nativeint_val(v2); + intnat divisor = Nativeint_val(v2); if (divisor == 0) caml_raise_zero_divide(); #ifdef NONSTANDARD_DIV_MOD return caml_copy_nativeint(caml_safe_div(Nativeint_val(v1), divisor)); @@ -655,7 +656,7 @@ CAMLprim value caml_nativeint_div(value v1, value v2) CAMLprim value caml_nativeint_mod(value v1, value v2) { - long divisor = Nativeint_val(v2); + intnat divisor = Nativeint_val(v2); if (divisor == 0) caml_raise_zero_divide(); #ifdef NONSTANDARD_DIV_MOD return caml_copy_nativeint(caml_safe_mod(Nativeint_val(v1), divisor)); @@ -680,7 +681,7 @@ CAMLprim value caml_nativeint_shift_right(value v1, value v2) { return caml_copy_nativeint(Nativeint_val(v1) >> Int_val(v2)); } CAMLprim value caml_nativeint_shift_right_unsigned(value v1, value v2) -{ return caml_copy_nativeint((unsigned long)Nativeint_val(v1) >> Int_val(v2)); } +{ return caml_copy_nativeint((uintnat)Nativeint_val(v1) >> Int_val(v2)); } CAMLprim value caml_nativeint_of_int(value v) { return caml_copy_nativeint(Long_val(v)); } @@ -689,7 +690,7 @@ CAMLprim value caml_nativeint_to_int(value v) { return Val_long(Nativeint_val(v)); } CAMLprim value caml_nativeint_of_float(value v) -{ return caml_copy_nativeint((long)(Double_val(v))); } +{ return caml_copy_nativeint((intnat)(Double_val(v))); } CAMLprim value caml_nativeint_to_float(value v) { return caml_copy_double((double)(Nativeint_val(v))); } @@ -702,8 +703,8 @@ CAMLprim value caml_nativeint_to_int32(value v) CAMLprim value caml_nativeint_compare(value v1, value v2) { - long i1 = Nativeint_val(v1); - long i2 = Nativeint_val(v2); + intnat i1 = Nativeint_val(v1); + intnat i2 = Nativeint_val(v2); int res = (i1 > i2) - (i1 < i2); return Val_int(res); } @@ -716,7 +717,8 @@ CAMLprim value caml_nativeint_format(value fmt, value arg) char conv; value res; - buffer = parse_format(fmt, "l", format_string, default_format_buffer, &conv); + buffer = parse_format(fmt, ARCH_INTNAT_PRINTF_FORMAT, + format_string, default_format_buffer, &conv); sprintf(buffer, format_string, (long) Nativeint_val(arg)); res = caml_copy_string(buffer); if (buffer != default_format_buffer) caml_stat_free(buffer); @@ -725,5 +727,5 @@ CAMLprim value caml_nativeint_format(value fmt, value arg) CAMLprim value caml_nativeint_of_string(value s) { - return caml_copy_nativeint(parse_long(s, 8 * sizeof(value))); + return caml_copy_nativeint(parse_intnat(s, 8 * sizeof(value))); } diff --git a/byterun/io.c b/byterun/io.c index 070bb1d96..63bbfc058 100644 --- a/byterun/io.c +++ b/byterun/io.c @@ -199,7 +199,7 @@ CAMLexport void caml_putword(struct channel *channel, uint32 w) putch(channel, w); } -CAMLexport int caml_putblock(struct channel *channel, char *p, long int len) +CAMLexport int caml_putblock(struct channel *channel, char *p, intnat len) { int n, free, towrite, written; @@ -224,7 +224,8 @@ CAMLexport int caml_putblock(struct channel *channel, char *p, long int len) } } -CAMLexport void caml_really_putblock(struct channel *channel, char *p, long len) +CAMLexport void caml_really_putblock(struct channel *channel, + char *p, intnat len) { int written; while (len > 0) { @@ -288,7 +289,7 @@ CAMLexport uint32 caml_getword(struct channel *channel) return res; } -CAMLexport int caml_getblock(struct channel *channel, char *p, long int len) +CAMLexport int caml_getblock(struct channel *channel, char *p, intnat len) { int n, avail, nread; @@ -314,7 +315,7 @@ CAMLexport int caml_getblock(struct channel *channel, char *p, long int len) } } -CAMLexport int caml_really_getblock(struct channel *chan, char *p, long int n) +CAMLexport int caml_really_getblock(struct channel *chan, char *p, intnat n) { int r; while (n > 0) { @@ -343,7 +344,7 @@ CAMLexport file_offset caml_pos_in(struct channel *channel) return channel->offset - (file_offset)(channel->max - channel->curr); } -CAMLexport long caml_input_scan_line(struct channel *channel) +CAMLexport intnat caml_input_scan_line(struct channel *channel) { char * p; int n; @@ -580,8 +581,8 @@ CAMLprim value caml_ml_output(value vchannel, value buff, value start, { CAMLparam4 (vchannel, buff, start, length); struct channel * channel = Channel(vchannel); - long pos = Long_val(start); - long len = Long_val(length); + intnat pos = Long_val(start); + intnat len = Long_val(length); Lock(channel); while (len > 0) { @@ -637,7 +638,7 @@ CAMLprim value caml_ml_input_char(value vchannel) CAMLprim value caml_ml_input_int(value vchannel) { struct channel * channel = Channel(vchannel); - long i; + intnat i; Lock(channel); i = caml_getword(channel); @@ -653,7 +654,7 @@ CAMLprim value caml_ml_input(value vchannel, value buff, value vstart, { CAMLparam4 (vchannel, buff, vstart, vlength); struct channel * channel = Channel(vchannel); - long start, len; + intnat start, len; int n, avail, nread; Lock(channel); @@ -716,7 +717,7 @@ CAMLprim value caml_ml_pos_in_64(value vchannel) CAMLprim value caml_ml_input_scan_line(value vchannel) { struct channel * channel = Channel(vchannel); - long res; + intnat res; Lock(channel); res = caml_input_scan_line(channel); diff --git a/byterun/io.h b/byterun/io.h index 21bb64e42..7bb2e693b 100644 --- a/byterun/io.h +++ b/byterun/io.h @@ -77,13 +77,13 @@ CAMLextern int caml_channel_binary_mode (struct channel *); CAMLextern int caml_flush_partial (struct channel *); CAMLextern void caml_flush (struct channel *); CAMLextern void caml_putword (struct channel *, uint32); -CAMLextern int caml_putblock (struct channel *, char *, long); -CAMLextern void caml_really_putblock (struct channel *, char *, long); +CAMLextern int caml_putblock (struct channel *, char *, intnat); +CAMLextern void caml_really_putblock (struct channel *, char *, intnat); CAMLextern unsigned char caml_refill (struct channel *); CAMLextern uint32 caml_getword (struct channel *); -CAMLextern int caml_getblock (struct channel *, char *, long); -CAMLextern int caml_really_getblock (struct channel *, char *, long); +CAMLextern int caml_getblock (struct channel *, char *, intnat); +CAMLextern int caml_really_getblock (struct channel *, char *, intnat); /* Extract a struct channel * from the heap object representing it */ diff --git a/byterun/major_gc.c b/byterun/major_gc.c index 26f657e45..4457ddd1a 100644 --- a/byterun/major_gc.c +++ b/byterun/major_gc.c @@ -29,8 +29,8 @@ #include "roots.h" #include "weak.h" -unsigned long caml_percent_free; -long caml_major_heap_increment; +uintnat caml_percent_free; +intnat caml_major_heap_increment; CAMLexport char *caml_heap_start, *caml_heap_end; CAMLexport page_table_entry *caml_page_table; asize_t caml_page_low, caml_page_high; @@ -41,10 +41,10 @@ static value *gray_vals_cur, *gray_vals_end; static asize_t gray_vals_size; static int heap_is_pure; /* The heap is pure if the only gray objects below [markhp] are also in [gray_vals]. */ -unsigned long caml_allocated_words; -unsigned long caml_dependent_size, caml_dependent_allocated; +uintnat caml_allocated_words; +uintnat caml_dependent_size, caml_dependent_allocated; double caml_extra_heap_resources; -unsigned long caml_fl_size_at_phase_change = 0; +uintnat caml_fl_size_at_phase_change = 0; extern char *caml_fl_merge; /* Defined in freelist.c. */ @@ -62,8 +62,9 @@ static void realloc_gray_vals (void) Assert (gray_vals_cur == gray_vals_end); if (gray_vals_size < caml_stat_heap_size / 128){ - caml_gc_message (0x08, "Growing gray_vals to %luk bytes\n", - (long) gray_vals_size * sizeof (value) / 512); + caml_gc_message (0x08, "Growing gray_vals to %" + ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n", + (intnat) gray_vals_size * sizeof (value) / 512); new = (value *) realloc ((char *) gray_vals, 2 * gray_vals_size * sizeof (value)); if (new == NULL){ @@ -109,7 +110,7 @@ static void start_cycle (void) #endif } -static void mark_slice (long work) +static void mark_slice (intnat work) { value *gray_vals_ptr; /* Local copy of gray_vals_cur */ value v, child; @@ -245,7 +246,7 @@ static void mark_slice (long work) gray_vals_cur = gray_vals_ptr; } -static void sweep_slice (long work) +static void sweep_slice (intnat work) { char *hp; header_t hd; @@ -294,10 +295,10 @@ static void sweep_slice (long work) [howmuch] is the amount of work to do, 0 to let the GC compute it. Return the computed amount of work to do. */ -long caml_major_collection_slice (long howmuch) +intnat caml_major_collection_slice (intnat howmuch) { double p, dp; - long computed_work; + intnat computed_work; /* Free memory at the start of the GC cycle (garbage + free list) (assumed): FM = caml_stat_heap_size * caml_percent_free @@ -343,17 +344,21 @@ long caml_major_collection_slice (long howmuch) if (p < dp) p = dp; if (p < caml_extra_heap_resources) p = caml_extra_heap_resources; - caml_gc_message (0x40, "allocated_words = %lu\n", caml_allocated_words); - caml_gc_message (0x40, "extra_heap_resources = %luu\n", - (unsigned long) (caml_extra_heap_resources * 1000000)); - caml_gc_message (0x40, "amount of work to do = %luu\n", - (unsigned long) (p * 1000000)); + caml_gc_message (0x40, "allocated_words = %" + ARCH_INTNAT_PRINTF_FORMAT "u\n", + caml_allocated_words); + caml_gc_message (0x40, "extra_heap_resources = %" + ARCH_INTNAT_PRINTF_FORMAT "uu\n", + (uintnat) (caml_extra_heap_resources * 1000000)); + caml_gc_message (0x40, "amount of work to do = %" + ARCH_INTNAT_PRINTF_FORMAT "uu\n", + (uintnat) (p * 1000000)); if (caml_gc_phase == Phase_mark){ - computed_work = 2 * (long) (p * Wsize_bsize (caml_stat_heap_size) * 100 + computed_work = 2 * (intnat) (p * Wsize_bsize (caml_stat_heap_size) * 100 / (100 + caml_percent_free)); }else{ - computed_work = 2 * (long) (p * Wsize_bsize (caml_stat_heap_size)); + computed_work = 2 * (intnat) (p * Wsize_bsize (caml_stat_heap_size)); } caml_gc_message (0x40, "ordered work = %ld words\n", howmuch); caml_gc_message (0x40, "computed work = %ld words\n", computed_work); @@ -438,7 +443,7 @@ void caml_init_major_heap (asize_t heap_size) caml_fatal_error ("Fatal error: not enough memory for the initial heap.\n"); Chunk_next (caml_heap_start) = NULL; caml_heap_end = caml_heap_start + caml_stat_heap_size; - Assert ((unsigned long) caml_heap_end % Page_size == 0); + Assert ((uintnat) caml_heap_end % Page_size == 0); caml_stat_heap_chunks = 1; diff --git a/byterun/major_gc.h b/byterun/major_gc.h index 3a53d04ac..47aa5e59f 100644 --- a/byterun/major_gc.h +++ b/byterun/major_gc.h @@ -33,10 +33,10 @@ typedef struct { #define Chunk_block(c) (((heap_chunk_head *) (c)) [-1]).block extern int caml_gc_phase; -extern unsigned long caml_allocated_words; +extern uintnat caml_allocated_words; extern double caml_extra_heap_resources; -extern unsigned long caml_dependent_size, caml_dependent_allocated; -extern unsigned long caml_fl_size_at_phase_change; +extern uintnat caml_dependent_size, caml_dependent_allocated; +extern uintnat caml_fl_size_at_phase_change; #define Phase_mark 0 #define Phase_sweep 1 @@ -50,14 +50,14 @@ typedef char page_table_entry; CAMLextern char *caml_heap_start; CAMLextern char *caml_heap_end; -extern unsigned long total_heap_size; +extern uintnat total_heap_size; CAMLextern page_table_entry *caml_page_table; extern asize_t caml_page_low, caml_page_high; extern char *caml_gc_sweep_hp; #define In_heap 1 #define Not_in_heap 0 -#define Page(p) ((unsigned long) (p) >> Page_log) +#define Page(p) ((uintnat) (p) >> Page_log) #define Is_in_heap(p) \ (Assert (Is_block ((value) (p))), \ (addr)(p) >= (addr)caml_heap_start && (addr)(p) < (addr)caml_heap_end \ @@ -66,7 +66,7 @@ extern char *caml_gc_sweep_hp; void caml_init_major_heap (asize_t); /* size in bytes */ asize_t caml_round_heap_chunk_size (asize_t); /* size in bytes */ void caml_darken (value, value *); -long caml_major_collection_slice (long); +intnat caml_major_collection_slice (long); void major_collection (void); void caml_finish_major_cycle (void); diff --git a/byterun/md5.c b/byterun/md5.c index 985717471..aa18b7240 100644 --- a/byterun/md5.c +++ b/byterun/md5.c @@ -39,7 +39,7 @@ CAMLprim value caml_md5_chan(value vchan, value len) struct channel * chan = Channel(vchan); struct MD5Context ctx; value res; - long toread, read; + intnat toread, read; char buffer[4096]; Lock(chan); @@ -118,7 +118,7 @@ CAMLexport void caml_MD5Init(struct MD5Context *ctx) * of bytes. */ CAMLexport void caml_MD5Update(struct MD5Context *ctx, unsigned char *buf, - unsigned long len) + uintnat len) { uint32 t; diff --git a/byterun/md5.h b/byterun/md5.h index 5e50125b3..ff8c23ee0 100644 --- a/byterun/md5.h +++ b/byterun/md5.h @@ -33,7 +33,7 @@ struct MD5Context { CAMLextern void caml_MD5Init (struct MD5Context *context); CAMLextern void caml_MD5Update (struct MD5Context *context, unsigned char *buf, - unsigned long len); + uintnat len); CAMLextern void caml_MD5Final (unsigned char *digest, struct MD5Context *ctx); CAMLextern void caml_MD5Transform (uint32 *buf, uint32 *in); diff --git a/byterun/memory.c b/byterun/memory.c index 276e8894b..03d728693 100644 --- a/byterun/memory.c +++ b/byterun/memory.c @@ -290,7 +290,7 @@ CAMLexport value caml_alloc_shr (mlsize_t wosize, tag_t tag) } #ifdef DEBUG { - unsigned long i; + uintnat i; for (i = 0; i < wosize; i++){ Field (Val_hp (hp), i) = Debug_uninit_major; } diff --git a/byterun/memory.h b/byterun/memory.h index 9fdff061e..494fe9ada 100644 --- a/byterun/memory.h +++ b/byterun/memory.h @@ -51,7 +51,7 @@ color_t caml_allocation_color (void *hp); #ifdef DEBUG #define DEBUG_clear(result, wosize) do{ \ - unsigned long caml__DEBUG_i; \ + uintnat caml__DEBUG_i; \ for (caml__DEBUG_i = 0; caml__DEBUG_i < (wosize); ++ caml__DEBUG_i){ \ Field ((result), caml__DEBUG_i) = Debug_uninit_minor; \ } \ @@ -107,8 +107,8 @@ color_t caml_allocation_color (void *hp); struct caml__roots_block { struct caml__roots_block *next; - long ntables; - long nitems; + intnat ntables; + intnat nitems; value *tables [5]; }; diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c index 33b1acc3a..f4958939b 100644 --- a/byterun/minor_gc.c +++ b/byterun/minor_gc.c @@ -217,7 +217,7 @@ void caml_empty_minor_heap (void) */ CAMLexport void caml_minor_collection (void) { - long prev_alloc_words = caml_allocated_words; + intnat prev_alloc_words = caml_allocated_words; caml_empty_minor_heap (); @@ -254,7 +254,9 @@ void caml_realloc_ref_table (void) ref_table_size *= 2; sz = (ref_table_size + ref_table_reserve) * sizeof (value *); - caml_gc_message (0x08, "Growing ref_table to %ldk bytes\n", (long) sz/1024); + caml_gc_message (0x08, "Growing ref_table to %" + ARCH_INTNAT_PRINTF_FORMAT "dk bytes\n", + (intnat) sz/1024); ref_table = (value **) realloc ((char *) ref_table, sz); if (ref_table == NULL){ caml_fatal_error ("Fatal error: ref_table overflow\n"); diff --git a/byterun/misc.c b/byterun/misc.c index 8791eca42..b725ba0c7 100644 --- a/byterun/misc.c +++ b/byterun/misc.c @@ -31,9 +31,9 @@ int caml_failed_assert (char * expr, char * file, int line) #endif /* DEBUG */ -unsigned long caml_verb_gc = 0; +uintnat caml_verb_gc = 0; -void caml_gc_message (int level, char *msg, unsigned long arg) +void caml_gc_message (int level, char *msg, uintnat arg) { if (level < 0 || (caml_verb_gc & level) != 0){ fprintf (stderr, msg, arg); @@ -64,20 +64,20 @@ CAMLexport void caml_fatal_error_arg2 (char *fmt1, char *arg1, char *caml_aligned_malloc (asize_t size, int modulo, void **block) { char *raw_mem; - unsigned long aligned_mem; + uintnat aligned_mem; Assert (modulo < Page_size); raw_mem = (char *) malloc (size + Page_size); if (raw_mem == NULL) return NULL; *block = raw_mem; raw_mem += modulo; /* Address to be aligned */ - aligned_mem = (((unsigned long) raw_mem / Page_size + 1) * Page_size); + aligned_mem = (((uintnat) raw_mem / Page_size + 1) * Page_size); #ifdef DEBUG { - unsigned long *p; - unsigned long *p0 = (void *) *block, - *p1 = (void *) (aligned_mem - modulo), - *p2 = (void *) (aligned_mem - modulo + size), - *p3 = (void *) ((char *) *block + size + Page_size); + uintlong *p; + uintlong *p0 = (void *) *block, + *p1 = (void *) (aligned_mem - modulo), + *p2 = (void *) (aligned_mem - modulo + size), + *p3 = (void *) ((char *) *block + size + Page_size); for (p = p0; p < p1; p++) *p = Debug_filler_align; for (p = p1; p < p2; p++) *p = Debug_uninit_align; diff --git a/byterun/misc.h b/byterun/misc.h index bda864fc4..a1b2b9260 100644 --- a/byterun/misc.h +++ b/byterun/misc.h @@ -93,8 +93,8 @@ extern void caml_ext_table_free(struct ext_table * tbl, int free_entries); /* GC flags and messages */ -extern unsigned long caml_verb_gc; -void caml_gc_message (int, char *, unsigned long); +extern uintnat caml_verb_gc; +void caml_gc_message (int, char *, uintnat); /* Memory routines */ @@ -103,10 +103,10 @@ char *caml_aligned_malloc (asize_t, int, void **); #ifdef DEBUG #ifdef ARCH_SIXTYFOUR #define Debug_tag(x) (0xD700D7D7D700D6D7ul \ - | ((unsigned long) (x) << 16) \ - | ((unsigned long) (x) << 48)) + | ((uintnat) (x) << 16) \ + | ((uintnat) (x) << 48)) #else -#define Debug_tag(x) (0xD700D6D7ul | ((unsigned long) (x) << 16)) +#define Debug_tag(x) (0xD700D6D7ul | ((uintnat) (x) << 16)) #endif /* ARCH_SIXTYFOUR */ /* diff --git a/byterun/mlvalues.h b/byterun/mlvalues.h index 8e177940f..74638a9c9 100644 --- a/byterun/mlvalues.h +++ b/byterun/mlvalues.h @@ -26,7 +26,7 @@ word: Four bytes on 32 and 16 bit architectures, eight bytes on 64 bit architectures. - long: A C long integer. + long: A C integer having the same number of bytes as a word. val: The ML representation of something. A long or a block or a pointer outside the heap. If it is a block, it is the (encoded) address of an object. If it is a long, it is encoded as well. @@ -53,12 +53,12 @@ This is for use only by the GC. */ -typedef long value; -typedef unsigned long header_t; -typedef unsigned long mlsize_t; +typedef intnat value; +typedef uintnat header_t; +typedef uintnat mlsize_t; typedef unsigned int tag_t; /* Actually, an unsigned char */ -typedef unsigned long color_t; -typedef unsigned long mark_t; +typedef uintnat color_t; +typedef uintnat mark_t; /* Longs vs blocks. */ #define Is_long(x) (((x) & 1) != 0) @@ -66,13 +66,13 @@ typedef unsigned long mark_t; /* Conversion macro names are always of the form "to_from". */ /* Example: Val_long as in "Val from long" or "Val of long". */ -#define Val_long(x) (((long)(x) << 1) + 1) +#define Val_long(x) (((intnat)(x) << 1) + 1) #define Long_val(x) ((x) >> 1) #define Max_long ((1L << (8 * sizeof(value) - 2)) - 1) #define Min_long (-(1L << (8 * sizeof(value) - 2))) #define Val_int(x) Val_long(x) #define Int_val(x) ((int) Long_val(x)) -#define Unsigned_long_val(x) ((unsigned long)(x) >> 1) +#define Unsigned_long_val(x) ((uintnat)(x) >> 1) #define Unsigned_int_val(x) ((int) Unsigned_long_val(x)) /* Structure of the header: @@ -254,7 +254,7 @@ struct custom_operations; /* defined in [custom.h] */ /* Int32.t, Int64.t and Nativeint.t are represented as custom blocks. */ #define Int32_val(v) (*((int32 *) Data_custom_val(v))) -#define Nativeint_val(v) (*((long *) Data_custom_val(v))) +#define Nativeint_val(v) (*((intnat *) Data_custom_val(v))) #ifndef ARCH_ALIGN_INT64 #define Int64_val(v) (*((int64 *) Data_custom_val(v))) #else diff --git a/byterun/roots.c b/byterun/roots.c index 83c59dd88..2ff876216 100644 --- a/byterun/roots.c +++ b/byterun/roots.c @@ -38,7 +38,7 @@ void caml_oldify_local_roots (void) register value * sp; struct global_root * gr; struct caml__roots_block *lr; - long i, j; + intnat i, j; /* The stack */ for (sp = caml_extern_sp; sp < caml_stack_high; sp++) { diff --git a/byterun/roots.h b/byterun/roots.h index acd406deb..95c2f63f7 100644 --- a/byterun/roots.h +++ b/byterun/roots.h @@ -29,7 +29,7 @@ CAMLextern void caml_do_local_roots (scanning_action, value *, value *, struct caml__roots_block *); #else CAMLextern void caml_do_local_roots(scanning_action f, char * bottom_of_stack, - unsigned long last_retaddr, value * gc_regs, + uintnat last_retaddr, value * gc_regs, struct caml__roots_block * local_roots); #endif diff --git a/byterun/signals.c b/byterun/signals.c index 5d5534f1c..a4851e7c8 100644 --- a/byterun/signals.c +++ b/byterun/signals.c @@ -36,7 +36,7 @@ extern sighandler caml_win32_signal(int sig, sighandler action); #define signal(sig,act) caml_win32_signal(sig,act) #endif -CAMLexport long volatile caml_pending_signals[NSIG]; +CAMLexport intnat volatile caml_pending_signals[NSIG]; CAMLexport int volatile caml_something_to_do = 0; int volatile caml_force_major_slice = 0; value caml_signal_handlers = 0; @@ -45,7 +45,7 @@ CAMLexport void (* volatile caml_async_action_hook)(void) = NULL; static void caml_process_pending_signals(void) { int signal_num; - long signal_state; + intnat signal_state; for (signal_num = 0; signal_num < NSIG; signal_num++) { Read_and_clear(signal_state, caml_pending_signals[signal_num]); @@ -64,7 +64,7 @@ void caml_process_event(void) if (async_action != NULL) (*async_action)(); } -static long volatile caml_async_signal_mode = 0; +static intnat volatile caml_async_signal_mode = 0; static void caml_enter_blocking_section_default(void) { @@ -80,7 +80,7 @@ static void caml_leave_blocking_section_default(void) static int caml_try_leave_blocking_section_default(void) { - long res; + intnat res; Read_and_clear(res, caml_async_signal_mode); return res; } @@ -145,7 +145,7 @@ void caml_urge_major_slice (void) CAMLexport void caml_enter_blocking_section(void) { int i; - long pending; + intnat pending; while (1){ /* Process all pending signals now */ diff --git a/byterun/signals.h b/byterun/signals.h index 7a581b531..d77917ef8 100644 --- a/byterun/signals.h +++ b/byterun/signals.h @@ -24,7 +24,7 @@ /* <private> */ extern value caml_signal_handlers; -CAMLextern long volatile caml_pending_signals[]; +CAMLextern intnat volatile caml_pending_signals[]; CAMLextern int volatile caml_something_to_do; extern int volatile caml_force_major_slice; /* </private> */ diff --git a/byterun/stacks.c b/byterun/stacks.c index ed8f06527..f43a44230 100644 --- a/byterun/stacks.c +++ b/byterun/stacks.c @@ -30,9 +30,9 @@ CAMLexport value * caml_trapsp; CAMLexport value * caml_trap_barrier; value caml_global_data; -unsigned long caml_max_stack_size; /* also used in gc_ctrl.c */ +uintnat caml_max_stack_size; /* also used in gc_ctrl.c */ -void caml_init_stack (long unsigned int initial_max_size) +void caml_init_stack (uintnat initial_max_size) { caml_stack_low = (value *) caml_stat_alloc(Stack_size); caml_stack_high = caml_stack_low + Stack_size / sizeof (value); @@ -57,8 +57,9 @@ void caml_realloc_stack(asize_t required_space) if (size >= caml_max_stack_size) caml_raise_stack_overflow(); size *= 2; } while (size < caml_stack_high - caml_extern_sp + required_space); - caml_gc_message (0x08, "Growing stack to %luk bytes\n", - (unsigned long) size * sizeof(value) / 1024); + caml_gc_message (0x08, "Growing stack to %" + ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n", + (uintnat) size * sizeof(value) / 1024); new_low = (value *) caml_stat_alloc(size * sizeof(value)); new_high = new_low + size; @@ -89,7 +90,7 @@ CAMLprim value caml_ensure_stack_capacity(value required_space) return Val_unit; } -void caml_change_max_stack_size (long unsigned int new_max_size) +void caml_change_max_stack_size (uintnat new_max_size) { asize_t size = caml_stack_high - caml_extern_sp + Stack_threshold / sizeof (value); diff --git a/byterun/stacks.h b/byterun/stacks.h index f33e9ad43..0c23a0a39 100644 --- a/byterun/stacks.h +++ b/byterun/stacks.h @@ -33,9 +33,9 @@ CAMLextern value * caml_trap_barrier; #define Trap_pc(tp) (((code_t *)(tp))[0]) #define Trap_link(tp) (((value **)(tp))[1]) -void caml_init_stack (unsigned long init_max_size); +void caml_init_stack (uintnat init_max_size); void caml_realloc_stack (asize_t required_size); -void caml_change_max_stack_size (unsigned long new_max_size); +void caml_change_max_stack_size (uintnat new_max_size); #endif /* CAML_STACKS_H */ diff --git a/byterun/startup.c b/byterun/startup.c index 58904287e..c2cea2c4b 100644 --- a/byterun/startup.c +++ b/byterun/startup.c @@ -106,7 +106,7 @@ int caml_attempt_open(char **name, struct exec_trailer *trail, truename = caml_search_exe_in_path(*name); *name = truename; caml_gc_message(0x100, "Opening bytecode executable %s\n", - (unsigned long) truename); + (uintnat) truename); fd = open(truename, O_RDONLY | O_BINARY); if (fd == -1) { caml_gc_message(0x100, "Cannot open file\n", 0); @@ -220,12 +220,12 @@ Algorithm: /* Configuration parameters and flags */ -static unsigned long percent_free_init = Percent_free_def; -static unsigned long max_percent_free_init = Max_percent_free_def; -static unsigned long minor_heap_init = Minor_heap_def; -static unsigned long heap_chunk_init = Heap_chunk_def; -static unsigned long heap_size_init = Init_heap_def; -static unsigned long max_stack_init = Max_stack_def; +static uintnat percent_free_init = Percent_free_def; +static uintnat max_percent_free_init = Max_percent_free_def; +static uintnat minor_heap_init = Minor_heap_def; +static uintnat heap_chunk_init = Heap_chunk_def; +static uintnat heap_size_init = Init_heap_def; +static uintnat max_stack_init = Max_stack_def; /* Parse options on the command line */ @@ -277,14 +277,18 @@ static int parse_command_line(char **argv) /* If you change these functions, see also their copy in asmrun/startup.c */ -static void scanmult (char *opt, long unsigned int *var) +static void scanmult (char *opt, uintnat *var) { char mult = ' '; - sscanf (opt, "=%lu%c", var, &mult); - sscanf (opt, "=0x%lx%c", var, &mult); - if (mult == 'k') *var = *var * 1024; - if (mult == 'M') *var = *var * 1024 * 1024; - if (mult == 'G') *var = *var * 1024 * 1024 * 1024; + int val; + sscanf (opt, "=%u%c", &val, &mult); + sscanf (opt, "=0x%x%c", &val, &mult); + switch (mult) { + case 'k': *var = (uintnat) val * 1024; break; + case 'M': *var = (uintnat) val * 1024 * 1024; break; + case 'G': *var = (uintnat) val * 1024 * 1024 * 1024; break; + default: *var = (uintnat) val; break; + } } static void parse_camlrunparam(void) diff --git a/byterun/str.c b/byterun/str.c index 8151fa37c..79e4ef81b 100644 --- a/byterun/str.c +++ b/byterun/str.c @@ -52,14 +52,14 @@ CAMLprim value caml_create_string(value len) CAMLprim value caml_string_get(value str, value index) { - long idx = Long_val(index); + intnat idx = Long_val(index); if (idx < 0 || idx >= caml_string_length(str)) caml_array_bound_error(); return Val_int(Byte_u(str, idx)); } CAMLprim value caml_string_set(value str, value index, value newval) { - long idx = Long_val(index); + intnat idx = Long_val(index); if (idx < 0 || idx >= caml_string_length(str)) caml_array_bound_error(); Byte_u(str, idx) = Int_val(newval); return Val_unit; diff --git a/byterun/sys.c b/byterun/sys.c index c5f5c60e1..59c0be983 100644 --- a/byterun/sys.c +++ b/byterun/sys.c @@ -226,7 +226,7 @@ CAMLprim value caml_sys_system_command(value command) CAMLparam1 (command); int status, retcode; char *buf; - unsigned long len; + intnat len; len = caml_string_length (command); buf = caml_stat_alloc (len + 1); @@ -264,7 +264,7 @@ CAMLprim value caml_sys_time(value unit) CAMLprim value caml_sys_random_seed (value unit) { - long seed; + intnat seed; #ifdef HAS_GETTIMEOFDAY struct timeval tv; gettimeofday(&tv, NULL); diff --git a/byterun/unix.c b/byterun/unix.c index 217c86124..7bb986008 100644 --- a/byterun/unix.c +++ b/byterun/unix.c @@ -348,21 +348,21 @@ char * caml_dlerror(void) char *caml_aligned_mmap (asize_t size, int modulo, void **block) { char *raw_mem; - unsigned long aligned_mem; + uintnat aligned_mem; Assert (modulo < Page_size); raw_mem = (char *) mmap(NULL, size + Page_size, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); if (raw_mem == MAP_FAILED) return NULL; *block = raw_mem; raw_mem += modulo; /* Address to be aligned */ - aligned_mem = (((unsigned long) raw_mem / Page_size + 1) * Page_size); + aligned_mem = (((uintnat) raw_mem / Page_size + 1) * Page_size); #ifdef DEBUG { - unsigned long *p; - unsigned long *p0 = (void *) *block, - *p1 = (void *) (aligned_mem - modulo), - *p2 = (void *) (aligned_mem - modulo + size), - *p3 = (void *) ((char *) *block + size + Page_size); + uintnat *p; + uintnat *p0 = (void *) *block, + *p1 = (void *) (aligned_mem - modulo), + *p2 = (void *) (aligned_mem - modulo + size), + *p3 = (void *) ((char *) *block + size + Page_size); for (p = p0; p < p1; p++) *p = Debug_filler_align; for (p = p1; p < p2; p++) *p = Debug_uninit_align; diff --git a/byterun/win32.c b/byterun/win32.c index 335247108..2188c77e1 100644 --- a/byterun/win32.c +++ b/byterun/win32.c @@ -70,12 +70,12 @@ char * caml_search_in_path(struct ext_table * path, char * name) strcpy(fullname, (char *)(path->contents[i])); strcat(fullname, "\\"); strcat(fullname, name); - caml_gc_message(0x100, "Searching %s\n", (unsigned long) fullname); + caml_gc_message(0x100, "Searching %s\n", (uintnat) 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", (unsigned long) name); + 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; @@ -98,7 +98,7 @@ CAMLexport char * caml_search_exe_in_path(char * name) &filepart); if (retcode == 0) { caml_gc_message(0x100, "%s not found in search path\n", - (unsigned long) name); + (uintnat) name); strcpy(fullname, name); break; } @@ -345,7 +345,7 @@ CAMLexport void caml_expand_command_line(int * argcp, char *** argvp) int caml_read_directory(char * dirname, struct ext_table * contents) { char * template; - long h; + intptr_t h; struct _finddata_t fileinfo; char * p; diff --git a/config/m-nt.h b/config/m-nt.h index 46e8817bd..f7a3b51e0 100644 --- a/config/m-nt.h +++ b/config/m-nt.h @@ -21,6 +21,7 @@ #undef ARCH_ALIGN_DOUBLE #define SIZEOF_INT 4 #define SIZEOF_LONG 4 +#define SIZEOF_PTR 4 #define SIZEOF_SHORT 2 #ifdef __MINGW32__ #define ARCH_INT64_TYPE long long diff --git a/config/m-templ.h b/config/m-templ.h index fdfc0c8c8..392ec562b 100644 --- a/config/m-templ.h +++ b/config/m-templ.h @@ -18,9 +18,9 @@ #define ARCH_SIXTYFOUR /* Define ARCH_SIXTYFOUR if the processor has a natural word size of 64 bits. - That is, both sizeof(long) = 8 and sizeof(char *) = 8. - Otherwise, leave ARCH_SIXTYFOUR undefined. This assumes - sizeof(long) = sizeof(char *) = 4. */ + That is, sizeof(char *) = 8. + Otherwise, leave ARCH_SIXTYFOUR undefined. + This assumes sizeof(char *) = 4. */ #define ARCH_BIG_ENDIAN @@ -44,10 +44,12 @@ #define SIZEOF_INT 4 #define SIZEOF_LONG 4 +#define SIZEOF_PTR 4 #define SIZEOF_SHORT 2 -/* Define SIZEOF_INT, SIZEOF_LONG and SIZEOF_SHORT to the sizes in byte - of the C types "int", "long" and "short", respectively. */ +/* Define SIZEOF_INT, SIZEOF_LONG, SIZEOF_PTR and SIZEOF_SHORT + to the sizes in bytes of the C types "int", "long", "char *" and "short", + respectively. */ #define ARCH_INT64_TYPE long long #define ARCH_UINT64_TYPE unsigned long long @@ -346,6 +346,7 @@ 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 diff --git a/otherlibs/bigarray/bigarray.h b/otherlibs/bigarray/bigarray.h index 17b2dfe43..57bd152a3 100644 --- a/otherlibs/bigarray/bigarray.h +++ b/otherlibs/bigarray/bigarray.h @@ -16,9 +16,18 @@ #ifndef _bigarray_ #define _bigarray_ - +#include "config.h" #include "mlvalues.h" +typedef signed char int8; +typedef unsigned char uint8; +#if SIZEOF_SHORT == 2 +typedef short int16; +typedef unsigned short uint16; +#else +#error "No 16-bit integer type available" +#endif + #define MAX_NUM_DIMS 16 enum caml_bigarray_kind { @@ -51,17 +60,17 @@ enum caml_bigarray_managed { }; struct caml_bigarray_proxy { - long refcount; /* Reference count */ + intnat refcount; /* Reference count */ void * data; /* Pointer to base of actual data */ - unsigned long size; /* Size of data in bytes (if mapped file) */ + uintnat size; /* Size of data in bytes (if mapped file) */ }; struct caml_bigarray { void * data; /* Pointer to raw data */ - long num_dims; /* Number of dimensions */ - long flags; /* Kind of element array + memory layout + allocation status */ + intnat num_dims; /* Number of dimensions */ + intnat flags; /* Kind of element array + memory layout + allocation status */ struct caml_bigarray_proxy * proxy; /* The proxy for sub-arrays, or NULL */ - long dim[1] /*[num_dims]*/; /* Size in each dimension */ + intnat dim[1] /*[num_dims]*/; /* Size in each dimension */ }; #define Bigarray_val(v) ((struct caml_bigarray *) Data_custom_val(v)) @@ -74,8 +83,8 @@ struct caml_bigarray { #define CAMLBAextern CAMLextern #endif -CAMLBAextern value alloc_bigarray(int flags, int num_dims, void * data, long * dim); +CAMLBAextern value alloc_bigarray(int flags, int num_dims, void * data, intnat * dim); CAMLBAextern value alloc_bigarray_dims(int flags, int num_dims, void * data, - ... /*dimensions, with type long */); + ... /*dimensions, with type intnat */); #endif diff --git a/otherlibs/bigarray/bigarray_stubs.c b/otherlibs/bigarray/bigarray_stubs.c index 331762c10..2fa600d3e 100644 --- a/otherlibs/bigarray/bigarray_stubs.c +++ b/otherlibs/bigarray/bigarray_stubs.c @@ -24,14 +24,14 @@ #include "memory.h" #include "mlvalues.h" -extern void bigarray_unmap_file(void * addr, unsigned long len); +extern void bigarray_unmap_file(void * addr, uintnat len); /* from mmap_xxx.c */ /* Compute the number of elements of a big array */ -static unsigned long bigarray_num_elts(struct caml_bigarray * b) +static uintnat bigarray_num_elts(struct caml_bigarray * b) { - unsigned long num_elts; + uintnat num_elts; int i; num_elts = 1; for (i = 0; i < b->num_dims; i++) num_elts = num_elts * b->dim[i]; @@ -51,7 +51,7 @@ int bigarray_element_size[] = /* Compute the number of bytes for the elements of a big array */ -unsigned long bigarray_byte_size(struct caml_bigarray * b) +uintnat bigarray_byte_size(struct caml_bigarray * b) { return bigarray_num_elts(b) * bigarray_element_size[b->flags & BIGARRAY_KIND_MASK]; @@ -61,9 +61,9 @@ unsigned long bigarray_byte_size(struct caml_bigarray * b) static void bigarray_finalize(value v); static int bigarray_compare(value v1, value v2); -static long bigarray_hash(value v); -static void bigarray_serialize(value, unsigned long *, unsigned long *); -unsigned long bigarray_deserialize(void * dst); +static intnat bigarray_hash(value v); +static void bigarray_serialize(value, uintnat *, uintnat *); +uintnat bigarray_deserialize(void * dst); static struct custom_operations bigarray_ops = { "_bigarray", bigarray_finalize, @@ -75,17 +75,18 @@ static struct custom_operations bigarray_ops = { /* Multiplication of unsigned longs with overflow detection */ -static unsigned long -bigarray_multov(unsigned long a, unsigned long b, int * overflow) +static uintnat +bigarray_multov(uintnat a, uintnat b, int * overflow) { -#define HALF_SIZE (sizeof(unsigned long) * 4) -#define LOW_HALF(x) ((x) & ((1UL << HALF_SIZE) - 1)) +#define HALF_SIZE (sizeof(uintnat) * 4) +#define HALF_MASK (((uintnat)1 << HALF_SIZE) - 1) +#define LOW_HALF(x) ((x) & HALF_MASK) #define HIGH_HALF(x) ((x) >> HALF_SIZE) /* Cut in half words */ - unsigned long al = LOW_HALF(a); - unsigned long ah = HIGH_HALF(a); - unsigned long bl = LOW_HALF(b); - unsigned long bh = HIGH_HALF(b); + uintnat al = LOW_HALF(a); + uintnat ah = HIGH_HALF(a); + uintnat bl = LOW_HALF(b); + uintnat bh = HIGH_HALF(b); /* Exact product is: al * bl + ah * bl << HALF_SIZE @@ -98,11 +99,11 @@ bigarray_multov(unsigned long a, unsigned long b, int * overflow) OR the sum al * bl + LOW_HALF(ah * bl) << HALF_SIZE + LOW_HALF(al * bh) << HALF_SIZE overflows. This sum is equal to p = (a * b) modulo word size. */ - unsigned long p1 = al * bh; - unsigned long p2 = ah * bl; - unsigned long p = a * b; + uintnat p1 = al * bh; + uintnat p2 = ah * bl; + uintnat p = a * b; if (ah != 0 && bh != 0) *overflow = 1; - if (p1 >= (1UL << HALF_SIZE) || p2 >= (1UL << HALF_SIZE)) *overflow = 1; + if (HIGH_HALF(p1) != 0 || HIGH_HALF(p2) != 0) *overflow = 1; p1 <<= HALF_SIZE; p2 <<= HALF_SIZE; p1 += p2; @@ -126,13 +127,13 @@ bigarray_multov(unsigned long a, unsigned long b, int * overflow) [dim] may point into an object in the Caml heap. */ CAMLexport value -alloc_bigarray(int flags, int num_dims, void * data, long * dim) +alloc_bigarray(int flags, int num_dims, void * data, intnat * dim) { - unsigned long num_elts, size; + uintnat num_elts, size; int overflow, i; value res; struct caml_bigarray * b; - long dimcopy[MAX_NUM_DIMS]; + intnat dimcopy[MAX_NUM_DIMS]; Assert(num_dims >= 1 && num_dims <= MAX_NUM_DIMS); Assert((flags & BIGARRAY_KIND_MASK) <= BIGARRAY_COMPLEX64); @@ -154,7 +155,7 @@ alloc_bigarray(int flags, int num_dims, void * data, long * dim) } res = alloc_custom(&bigarray_ops, sizeof(struct caml_bigarray) - + (num_dims - 1) * sizeof(long), + + (num_dims - 1) * sizeof(intnat), size, MAX_BIGARRAY_MEMORY); b = Bigarray_val(res); b->data = data; @@ -171,12 +172,12 @@ alloc_bigarray(int flags, int num_dims, void * data, long * dim) CAMLexport value alloc_bigarray_dims(int flags, int num_dims, void * data, ...) { va_list ap; - long dim[MAX_NUM_DIMS]; + intnat dim[MAX_NUM_DIMS]; int i; value res; va_start(ap, data); - for (i = 0; i < num_dims; i++) dim[i] = va_arg(ap, long); + for (i = 0; i < num_dims; i++) dim[i] = va_arg(ap, intnat); va_end(ap); res = alloc_bigarray(flags, num_dims, data, dim); return res; @@ -186,7 +187,7 @@ CAMLexport value alloc_bigarray_dims(int flags, int num_dims, void * data, ...) CAMLprim value bigarray_create(value vkind, value vlayout, value vdim) { - long dim[MAX_NUM_DIMS]; + intnat dim[MAX_NUM_DIMS]; mlsize_t num_dims; int i, flags; @@ -206,23 +207,23 @@ CAMLprim value bigarray_create(value vkind, value vlayout, value vdim) are within the bounds and return the offset of the corresponding array element in the data part of the array. */ -static long bigarray_offset(struct caml_bigarray * b, long * index) +static long bigarray_offset(struct caml_bigarray * b, intnat * index) { - long offset; + intnat offset; int i; offset = 0; if ((b->flags & BIGARRAY_LAYOUT_MASK) == BIGARRAY_C_LAYOUT) { /* C-style layout: row major, indices start at 0 */ for (i = 0; i < b->num_dims; i++) { - if ((unsigned long) index[i] >= (unsigned long) b->dim[i]) + if ((uintnat) index[i] >= (uintnat) b->dim[i]) array_bound_error(); offset = offset * b->dim[i] + index[i]; } } else { /* Fortran-style layout: column major, indices start at 1 */ for (i = b->num_dims - 1; i >= 0; i--) { - if ((unsigned long) (index[i] - 1) >= (unsigned long) b->dim[i]) + if ((uintnat) (index[i] - 1) >= (uintnat) b->dim[i]) array_bound_error(); offset = offset * b->dim[i] + (index[i] - 1); } @@ -245,9 +246,9 @@ static value copy_two_doubles(double d0, double d1) value bigarray_get_N(value vb, value * vind, int nind) { struct caml_bigarray * b = Bigarray_val(vb); - long index[MAX_NUM_DIMS]; + intnat index[MAX_NUM_DIMS]; int i; - long offset; + intnat offset; /* Check number of indices = number of dimensions of array (maybe not necessary if ML typing guarantees this) */ @@ -265,9 +266,9 @@ value bigarray_get_N(value vb, value * vind, int nind) case BIGARRAY_FLOAT64: return copy_double(((double *) b->data)[offset]); case BIGARRAY_SINT8: - return Val_int(((schar *) b->data)[offset]); + return Val_int(((int8 *) b->data)[offset]); case BIGARRAY_UINT8: - return Val_int(((unsigned char *) b->data)[offset]); + return Val_int(((uint8 *) b->data)[offset]); case BIGARRAY_SINT16: return Val_int(((int16 *) b->data)[offset]); case BIGARRAY_UINT16: @@ -277,9 +278,9 @@ value bigarray_get_N(value vb, value * vind, int nind) case BIGARRAY_INT64: return copy_int64(((int64 *) b->data)[offset]); case BIGARRAY_NATIVE_INT: - return copy_nativeint(((long *) b->data)[offset]); + return copy_nativeint(((intnat *) b->data)[offset]); case BIGARRAY_CAML_INT: - return Val_long(((long *) b->data)[offset]); + return Val_long(((intnat *) b->data)[offset]); case BIGARRAY_COMPLEX32: { float * p = ((float *) b->data) + offset * 2; return copy_two_doubles(p[0], p[1]); } @@ -343,12 +344,12 @@ CAMLprim value bigarray_get_generic(value vb, value vind) /* Generic write to a big array */ -static value bigarray_set_aux(value vb, value * vind, long nind, value newval) +static value bigarray_set_aux(value vb, value * vind, intnat nind, value newval) { struct caml_bigarray * b = Bigarray_val(vb); - long index[MAX_NUM_DIMS]; + intnat index[MAX_NUM_DIMS]; int i; - long offset; + intnat offset; /* Check number of indices = number of dimensions of array (maybe not necessary if ML typing guarantees this) */ @@ -367,7 +368,7 @@ static value bigarray_set_aux(value vb, value * vind, long nind, value newval) ((double *) b->data)[offset] = Double_val(newval); break; case BIGARRAY_SINT8: case BIGARRAY_UINT8: - ((schar *) b->data)[offset] = Int_val(newval); break; + ((int8 *) b->data)[offset] = Int_val(newval); break; case BIGARRAY_SINT16: case BIGARRAY_UINT16: ((int16 *) b->data)[offset] = Int_val(newval); break; @@ -376,9 +377,9 @@ static value bigarray_set_aux(value vb, value * vind, long nind, value newval) case BIGARRAY_INT64: ((int64 *) b->data)[offset] = Int64_val(newval); break; case BIGARRAY_NATIVE_INT: - ((long *) b->data)[offset] = Nativeint_val(newval); break; + ((intnat *) b->data)[offset] = Nativeint_val(newval); break; case BIGARRAY_CAML_INT: - ((long *) b->data)[offset] = Long_val(newval); break; + ((intnat *) b->data)[offset] = Long_val(newval); break; case BIGARRAY_COMPLEX32: { float * p = ((float *) b->data) + offset * 2; p[0] = Double_field(newval, 0); @@ -465,7 +466,7 @@ CAMLprim value bigarray_num_dims(value vb) CAMLprim value bigarray_dim(value vb, value vn) { struct caml_bigarray * b = Bigarray_val(vb); - long n = Long_val(vn); + intnat n = Long_val(vn); if (n >= b->num_dims) invalid_argument("Bigarray.dim"); return Val_long(b->dim[n]); } @@ -522,15 +523,15 @@ static int bigarray_compare(value v1, value v2) { struct caml_bigarray * b1 = Bigarray_val(v1); struct caml_bigarray * b2 = Bigarray_val(v2); - unsigned long n, num_elts; + uintnat n, num_elts; int i; /* Compare number of dimensions */ if (b1->num_dims != b2->num_dims) return b2->num_dims - b1->num_dims; /* Same number of dimensions: compare dimensions lexicographically */ for (i = 0; i < b1->num_dims; i++) { - long d1 = b1->dim[i]; - long d2 = b2->dim[i]; + intnat d1 = b1->dim[i]; + intnat d2 = b2->dim[i]; if (d1 != d2) return d1 < d2 ? -1 : 1; } /* Same dimensions: compare contents lexicographically */ @@ -570,9 +571,9 @@ static int bigarray_compare(value v1, value v2) case BIGARRAY_FLOAT64: DO_FLOAT_COMPARISON(double); case BIGARRAY_SINT8: - DO_INTEGER_COMPARISON(schar); + DO_INTEGER_COMPARISON(int8); case BIGARRAY_UINT8: - DO_INTEGER_COMPARISON(unsigned char); + DO_INTEGER_COMPARISON(uint8); case BIGARRAY_SINT16: DO_INTEGER_COMPARISON(int16); case BIGARRAY_UINT16: @@ -596,7 +597,7 @@ static int bigarray_compare(value v1, value v2) #endif case BIGARRAY_CAML_INT: case BIGARRAY_NATIVE_INT: - DO_INTEGER_COMPARISON(long); + DO_INTEGER_COMPARISON(intnat); default: Assert(0); return 0; /* should not happen */ @@ -607,10 +608,10 @@ static int bigarray_compare(value v1, value v2) /* Hashing of a bigarray */ -static long bigarray_hash(value v) +static intnat bigarray_hash(value v) { struct caml_bigarray * b = Bigarray_val(v); - long num_elts, n, h; + intnat num_elts, n, h; int i; num_elts = 1; @@ -623,13 +624,13 @@ static long bigarray_hash(value v) switch (b->flags & BIGARRAY_KIND_MASK) { case BIGARRAY_SINT8: case BIGARRAY_UINT8: { - unsigned char * p = b->data; + uint8 * p = b->data; for (n = 0; n < num_elts; n++) h = COMBINE(h, *p++); break; } case BIGARRAY_SINT16: case BIGARRAY_UINT16: { - unsigned short * p = b->data; + uint16 * p = b->data; for (n = 0; n < num_elts; n++) h = COMBINE(h, *p++); break; } @@ -654,7 +655,7 @@ static long bigarray_hash(value v) #endif #ifdef ARCH_SIXTYFOUR { - unsigned long * p = b->data; + uintnat * p = b->data; for (n = 0; n < num_elts; n++) h = COMBINE(h, *p++); break; } @@ -677,12 +678,12 @@ static long bigarray_hash(value v) } static void bigarray_serialize_longarray(void * data, - long num_elts, - long min_val, long max_val) + intnat num_elts, + intnat min_val, intnat max_val) { #ifdef ARCH_SIXTYFOUR int overflow_32 = 0; - long * p, n; + intnat * p, n; for (n = 0, p = data; n < num_elts; n++, p++) { if (*p < min_val || *p > max_val) { overflow_32 = 1; break; } } @@ -700,11 +701,11 @@ static void bigarray_serialize_longarray(void * data, } static void bigarray_serialize(value v, - unsigned long * wsize_32, - unsigned long * wsize_64) + uintnat * wsize_32, + uintnat * wsize_64) { struct caml_bigarray * b = Bigarray_val(v); - long num_elts; + intnat num_elts; int i; /* Serialize header information */ @@ -746,14 +747,14 @@ static void bigarray_serialize(value v, *wsize_64 = (4 + b->num_dims) * 8; } -static void bigarray_deserialize_longarray(void * dest, long num_elts) +static void bigarray_deserialize_longarray(void * dest, intnat num_elts) { int sixty = deserialize_uint_1(); #ifdef ARCH_SIXTYFOUR if (sixty) { deserialize_block_8(dest, num_elts); } else { - long * p, n; + intnat * p, n; for (n = 0, p = dest; n < num_elts; n++, p++) *p = deserialize_sint_4(); } #else @@ -764,11 +765,11 @@ static void bigarray_deserialize_longarray(void * dest, long num_elts) #endif } -unsigned long bigarray_deserialize(void * dst) +uintnat bigarray_deserialize(void * dst) { struct caml_bigarray * b = dst; int i, elt_size; - unsigned long num_elts; + uintnat num_elts; /* Read back header information */ b->num_dims = deserialize_uint_4(); @@ -807,7 +808,7 @@ unsigned long bigarray_deserialize(void * dst) case BIGARRAY_NATIVE_INT: bigarray_deserialize_longarray(b->data, num_elts); break; } - return sizeof(struct caml_bigarray) + (b->num_dims - 1) * sizeof(long); + return sizeof(struct caml_bigarray) + (b->num_dims - 1) * sizeof(intnat); } /* Create / update proxy to indicate that b2 is a sub-array of b1 */ @@ -842,10 +843,10 @@ CAMLprim value bigarray_slice(value vb, value vind) CAMLparam2 (vb, vind); #define b ((struct caml_bigarray *) Bigarray_val(vb)) CAMLlocal1 (res); - long index[MAX_NUM_DIMS]; + intnat index[MAX_NUM_DIMS]; int num_inds, i; - long offset; - long * sub_dims; + intnat offset; + intnat * sub_dims; char * sub_data; /* Check number of indices < number of dimensions of array */ @@ -887,10 +888,10 @@ CAMLprim value bigarray_sub(value vb, value vofs, value vlen) CAMLparam3 (vb, vofs, vlen); CAMLlocal1 (res); #define b ((struct caml_bigarray *) Bigarray_val(vb)) - long ofs = Long_val(vofs); - long len = Long_val(vlen); + intnat ofs = Long_val(vofs); + intnat len = Long_val(vlen); int i, changed_dim; - long mul; + intnat mul; char * sub_data; /* Compute offset and check bounds */ @@ -930,7 +931,7 @@ CAMLprim value bigarray_blit(value vsrc, value vdst) struct caml_bigarray * src = Bigarray_val(vsrc); struct caml_bigarray * dst = Bigarray_val(vdst); int i; - long num_bytes; + intnat num_bytes; /* Check same numbers of dimensions and same dimensions */ if (src->num_dims != dst->num_dims) goto blit_error; @@ -953,7 +954,7 @@ CAMLprim value bigarray_blit(value vsrc, value vdst) CAMLprim value bigarray_fill(value vb, value vinit) { struct caml_bigarray * b = Bigarray_val(vb); - long num_elts = bigarray_num_elts(b); + intnat num_elts = bigarray_num_elts(b); switch (b->flags & BIGARRAY_KIND_MASK) { default: @@ -980,7 +981,7 @@ CAMLprim value bigarray_fill(value vb, value vinit) case BIGARRAY_SINT16: case BIGARRAY_UINT16: { int init = Int_val(vinit); - short * p; + int16 * p; for (p = b->data; num_elts > 0; p++, num_elts--) *p = init; break; } @@ -997,14 +998,14 @@ CAMLprim value bigarray_fill(value vb, value vinit) break; } case BIGARRAY_NATIVE_INT: { - long init = Nativeint_val(vinit); - long * p; + intnat init = Nativeint_val(vinit); + intnat * p; for (p = b->data; num_elts > 0; p++, num_elts--) *p = init; break; } case BIGARRAY_CAML_INT: { - long init = Long_val(vinit); - long * p; + intnat init = Long_val(vinit); + intnat * p; for (p = b->data; num_elts > 0; p++, num_elts--) *p = init; break; } @@ -1034,9 +1035,9 @@ CAMLprim value bigarray_reshape(value vb, value vdim) CAMLparam2 (vb, vdim); CAMLlocal1 (res); #define b ((struct caml_bigarray *) Bigarray_val(vb)) - long dim[MAX_NUM_DIMS]; + intnat dim[MAX_NUM_DIMS]; mlsize_t num_dims; - unsigned long num_elts; + uintnat num_elts; int i; num_dims = Wosize_val(vdim); diff --git a/otherlibs/bigarray/mmap_unix.c b/otherlibs/bigarray/mmap_unix.c index e0f649f92..94570773c 100644 --- a/otherlibs/bigarray/mmap_unix.c +++ b/otherlibs/bigarray/mmap_unix.c @@ -41,10 +41,10 @@ CAMLprim value bigarray_map_file(value vfd, value vkind, value vlayout, value vshared, value vdim) { int fd, flags, major_dim, shared; - long num_dims, i; - long dim[MAX_NUM_DIMS]; - long currpos, file_size; - unsigned long array_size; + intnat num_dims, i; + intnat dim[MAX_NUM_DIMS]; + intnat currpos, file_size; + uintnat array_size; char c; void * addr; @@ -75,9 +75,9 @@ CAMLprim value bigarray_map_file(value vfd, value vkind, value vlayout, /* Check if the first/last dimension is unknown */ if (dim[major_dim] == -1) { /* Determine first/last dimension from file size */ - if ((unsigned long) file_size % array_size != 0) + if ((uintnat) file_size % array_size != 0) failwith("Bigarray.mmap: file size doesn't match array dimensions"); - dim[major_dim] = (unsigned long) file_size / array_size; + dim[major_dim] = (uintnat) file_size / array_size; array_size = file_size; } else { /* Check that file is large enough, and grow it otherwise */ @@ -109,7 +109,7 @@ value bigarray_map_file(value vfd, value vkind, value vlayout, #endif -void bigarray_unmap_file(void * addr, unsigned long len) +void bigarray_unmap_file(void * addr, uintnat len) { #if defined(HAS_MMAP) munmap(addr, len); diff --git a/otherlibs/bigarray/mmap_win32.c b/otherlibs/bigarray/mmap_win32.c index a3701611d..647c9c536 100644 --- a/otherlibs/bigarray/mmap_win32.c +++ b/otherlibs/bigarray/mmap_win32.c @@ -24,6 +24,8 @@ #include "sys.h" #include "unixsupport.h" +/* TODO: handle mappings larger than 2^32 bytes on Win64 */ + extern int bigarray_element_size[]; /* from bigarray_stubs.c */ static void bigarray_sys_error(void); @@ -33,10 +35,10 @@ CAMLprim value bigarray_map_file(value vfd, value vkind, value vlayout, { HANDLE fd, fmap; int flags, major_dim, mode, perm; - long num_dims, i; - long dim[MAX_NUM_DIMS]; - long currpos, file_size; - unsigned long array_size; + intnat num_dims, i; + intnat dim[MAX_NUM_DIMS]; + DWORD currpos, file_size; + uintnat array_size; char c; void * addr; @@ -56,9 +58,9 @@ CAMLprim value bigarray_map_file(value vfd, value vkind, value vlayout, } /* Determine file size */ currpos = SetFilePointer(fd, 0, NULL, FILE_CURRENT); - if (currpos == -1) bigarray_sys_error(); + if (currpos == INVALID_SET_FILE_POINTER) bigarray_sys_error(); file_size = SetFilePointer(fd, 0, NULL, FILE_END); - if (file_size == -1) bigarray_sys_error(); + if (file_size == INVALID_SET_FILE_POINTER) bigarray_sys_error(); /* Determine array size in bytes (or size of array without the major dimension if that dimension wasn't specified) */ array_size = bigarray_element_size[flags & BIGARRAY_KIND_MASK]; @@ -67,9 +69,9 @@ CAMLprim value bigarray_map_file(value vfd, value vkind, value vlayout, /* Check if the first/last dimension is unknown */ if (dim[major_dim] == -1) { /* Determine first/last dimension from file size */ - if ((unsigned long) file_size % array_size != 0) + if ((uintnat) file_size % array_size != 0) failwith("Bigarray.mmap: file size doesn't match array dimensions"); - dim[major_dim] = (unsigned long) file_size / array_size; + dim[major_dim] = (uintnat) file_size / array_size; array_size = file_size; } /* Restore original file position */ @@ -93,7 +95,7 @@ CAMLprim value bigarray_map_file(value vfd, value vkind, value vlayout, return alloc_bigarray(flags | BIGARRAY_MAPPED_FILE, num_dims, addr, dim); } -void bigarray_unmap_file(void * addr, unsigned long len) +void bigarray_unmap_file(void * addr, uintnat len) { UnmapViewOfFile(addr); } @@ -101,7 +103,7 @@ void bigarray_unmap_file(void * addr, unsigned long len) static void bigarray_sys_error(void) { char buffer[512]; - unsigned long errnum; + DWORD errnum; errnum = GetLastError(); if (!FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS, diff --git a/otherlibs/labltk/support/cltkMain.c b/otherlibs/labltk/support/cltkMain.c index 6a3a35641..655da151b 100644 --- a/otherlibs/labltk/support/cltkMain.c +++ b/otherlibs/labltk/support/cltkMain.c @@ -91,7 +91,7 @@ CAMLprim value camltk_opentk(value argv) /* Register cltclinterp for use in other related extensions */ value *interp = caml_named_value("cltclinterp"); if (interp != NULL) - Store_field(*interp,0,copy_nativeint((long)cltclinterp)); + Store_field(*interp,0,copy_nativeint((intnat)cltclinterp)); } if (Tcl_Init(cltclinterp) != TCL_OK) diff --git a/otherlibs/num/bng.c b/otherlibs/num/bng.c index 8eef7ca07..f7dcd7d0a 100644 --- a/otherlibs/num/bng.c +++ b/otherlibs/num/bng.c @@ -317,7 +317,7 @@ static bngdigit bng_generic_div_rem_norm_digit (bng a/*[len-1]*/, bng b/*[len]*/, bngsize len, bngdigit d) { bngdigit topdigit, quo, rem; - long i; + intnat i; topdigit = b[len - 1]; for (i = len - 2; i >= 0; i--) { diff --git a/otherlibs/num/bng.h b/otherlibs/num/bng.h index 28c6b2d10..74dd1bd6e 100644 --- a/otherlibs/num/bng.h +++ b/otherlibs/num/bng.h @@ -14,11 +14,12 @@ /* $Id$ */ #include <string.h> +#include "config.h" -typedef unsigned long bngdigit; +typedef uintnat bngdigit; typedef bngdigit * bng; typedef unsigned int bngcarry; -typedef unsigned long bngsize; +typedef uintnat bngsize; #define BNG_BITS_PER_DIGIT (sizeof(bngdigit) * 8) #define BNG_BITS_PER_HALF_DIGIT (sizeof(bngdigit) * 4) diff --git a/otherlibs/num/nat_stubs.c b/otherlibs/num/nat_stubs.c index e2c8fbc6f..50cda6584 100644 --- a/otherlibs/num/nat_stubs.c +++ b/otherlibs/num/nat_stubs.c @@ -26,8 +26,8 @@ /* Stub code for the Nat module. */ -static void serialize_nat(value, unsigned long *, unsigned long *); -static unsigned long deserialize_nat(void * dst); +static void serialize_nat(value, uintnat *, uintnat *); +static uintnat deserialize_nat(void * dst); static struct custom_operations nat_operations = { "_nat", @@ -323,8 +323,8 @@ CAMLprim value lxor_digit_nat(value nat1, value ofs1, value nat2, value ofs2) of 64-bit words to obtain the correct behavior. */ static void serialize_nat(value nat, - unsigned long * wsize_32, - unsigned long * wsize_64) + uintnat * wsize_32, + uintnat * wsize_64) { mlsize_t len = Wosize_val(nat) - 1; @@ -349,7 +349,7 @@ static void serialize_nat(value nat, *wsize_64 = len * 4; } -static unsigned long deserialize_nat(void * dst) +static uintnat deserialize_nat(void * dst) { mlsize_t len; diff --git a/otherlibs/num/test/Makefile b/otherlibs/num/test/Makefile index ce56b35d7..feafae198 100644 --- a/otherlibs/num/test/Makefile +++ b/otherlibs/num/test/Makefile @@ -18,7 +18,7 @@ include ../../../config/Makefile CAMLC=../../../boot/ocamlrun ../../../ocamlc -I ../../../stdlib CAMLOPT=../../../boot/ocamlrun ../../../ocamlopt -I ../../../stdlib CC=$(BYTECC) -CFLAGS=-I.. $(BYTECCCOMPOPTS) +CFLAGS=-I.. -I../../../byterun $(BYTECCCOMPOPTS) test: test.byt test.opt if $(SUPPORTS_SHARED_LIBRARIES); then ../../../byterun/ocamlrun -I .. ./test.byt; else ./test.byt; fi diff --git a/otherlibs/str/strstubs.c b/otherlibs/str/strstubs.c index a399c24eb..13b5d2cc1 100644 --- a/otherlibs/str/strstubs.c +++ b/otherlibs/str/strstubs.c @@ -33,9 +33,9 @@ union backtrack_point { } undo; }; -#define Set_tag(p) ((value *) ((long)(p) | 1)) -#define Clear_tag(p) ((value *) ((long)(p) & ~1)) -#define Tag_is_set(p) ((long)(p) & 1) +#define Set_tag(p) ((value *) ((intnat)(p) | 1)) +#define Clear_tag(p) ((value *) ((intnat)(p) & ~1)) +#define Tag_is_set(p) ((intnat)(p) & 1) #define BACKTRACK_STACK_BLOCK_SIZE 500 @@ -45,8 +45,8 @@ struct backtrack_stack { }; #define Opcode(x) ((x) & 0xFF) -#define Arg(x) ((unsigned long)(x) >> 8) -#define SignedArg(x) ((long)(x) >> 8) +#define Arg(x) ((uintnat)(x) >> 8) +#define SignedArg(x) ((intnat)(x) >> 8) enum { CHAR, /* match a single character */ @@ -123,7 +123,7 @@ static int re_match(value re, int accept_partial_match) { register value * pc; - long instr; + intnat instr; struct backtrack_stack * stack; union backtrack_point * sp; value cpool; diff --git a/otherlibs/systhreads/posix.c b/otherlibs/systhreads/posix.c index 254d6abe1..460a396bc 100644 --- a/otherlibs/systhreads/posix.c +++ b/otherlibs/systhreads/posix.c @@ -75,7 +75,7 @@ struct caml_thread_struct { struct caml_thread_struct * prev; #ifdef NATIVE_CODE char * bottom_of_stack; /* Saved value of caml_bottom_of_stack */ - unsigned long last_retaddr; /* Saved value of caml_last_return_address */ + uintnat last_retaddr; /* Saved value of caml_last_return_address */ value * gc_regs; /* Saved value of caml_gc_regs */ char * exception_pointer; /* Saved value of caml_exception_pointer */ struct caml__roots_block * local_roots; /* Saved value of local_roots */ @@ -120,7 +120,7 @@ static pthread_key_t thread_descriptor_key; static pthread_key_t last_channel_locked_key; /* Identifier for next thread creation */ -static long thread_next_ident = 0; +static intnat thread_next_ident = 0; /* Whether to use sched_yield() or not */ static int broken_sched_yield = 0; diff --git a/otherlibs/systhreads/win32.c b/otherlibs/systhreads/win32.c index 843796593..67901875d 100644 --- a/otherlibs/systhreads/win32.c +++ b/otherlibs/systhreads/win32.c @@ -74,7 +74,7 @@ struct caml_thread_struct { struct caml_thread_struct * prev; #ifdef NATIVE_CODE char * bottom_of_stack; /* Saved value of caml_bottom_of_stack */ - unsigned long last_retaddr; /* Saved value of caml_last_return_address */ + uintnat last_retaddr; /* Saved value of caml_last_return_address */ value * gc_regs; /* Saved value of caml_gc_regs */ char * exception_pointer; /* Saved value of caml_exception_pointer */ struct caml__roots_block * local_roots; /* Saved value of local_roots */ @@ -110,7 +110,7 @@ static DWORD thread_descriptor_key; static DWORD last_channel_locked_key; /* Identifier for next thread creation */ -static long thread_next_ident = 0; +static intnat thread_next_ident = 0; /* Forward declarations */ @@ -277,7 +277,7 @@ CAMLprim value caml_thread_initialize(value unit) value vthread = Val_unit; value descr; HANDLE tick_thread; - unsigned long tick_id; + uintnat tick_id; /* Protect against repeated initialization (PR#1325) */ if (curr_thread != NULL) return Val_unit; @@ -367,7 +367,7 @@ CAMLprim value caml_thread_new(value clos) caml_thread_t th; value vthread = Val_unit; value descr; - unsigned long th_id; + uintnat th_id; Begin_roots2 (clos, vthread) /* Create a finalized value to hold thread handle */ @@ -563,7 +563,7 @@ CAMLprim value caml_thread_delay(value val) /* Conditions operations */ struct caml_condvar { - unsigned long count; /* Number of waiting threads */ + uintnat count; /* Number of waiting threads */ HANDLE sem; /* Semaphore on which threads are waiting */ }; @@ -645,7 +645,7 @@ CAMLprim value caml_condition_signal(value cond) CAMLprim value caml_condition_broadcast(value cond) { HANDLE s = Condition_val(cond)->sem; - unsigned long c = Condition_val(cond)->count; + uintnat c = Condition_val(cond)->count; if (c > 0) { Condition_val(cond)->count = 0; diff --git a/otherlibs/threads/scheduler.c b/otherlibs/threads/scheduler.c index fb62442d7..c73ac67e8 100644 --- a/otherlibs/threads/scheduler.c +++ b/otherlibs/threads/scheduler.c @@ -653,7 +653,7 @@ value thread_inchan_ready(value vchan) /* ML */ value thread_outchan_ready(value vchan, value vsize) /* ML */ { struct channel * chan = Channel(vchan); - long size = Long_val(vsize); + intnat size = Long_val(vsize); /* Negative size means we want to flush the buffer entirely */ if (size < 0) { return Val_bool(chan->curr == chan->buff); diff --git a/otherlibs/win32unix/lockf.c b/otherlibs/win32unix/lockf.c index 918305281..3aa902d42 100644 --- a/otherlibs/win32unix/lockf.c +++ b/otherlibs/win32unix/lockf.c @@ -62,7 +62,7 @@ static void set_file_pointer(HANDLE h, LARGE_INTEGER dest, LONG high = dest.HighPart; DWORD ret = SetFilePointer(h, dest.LowPart, &high, method); if (ret == INVALID_SET_FILE_POINTER) { - long err = GetLastError(); + DWORD err = GetLastError(); if (err != NO_ERROR) { win32_maperr(err); uerror("lockf", Nothing); } } if (cur != NULL) { cur->LowPart = ret; cur->HighPart = high; } diff --git a/otherlibs/win32unix/sendrecv.c b/otherlibs/win32unix/sendrecv.c index cbb8ff42b..773aa9260 100644 --- a/otherlibs/win32unix/sendrecv.c +++ b/otherlibs/win32unix/sendrecv.c @@ -27,7 +27,7 @@ static int msg_flag_table[] = { CAMLprim value unix_recv(value sock, value buff, value ofs, value len, value flags) { int ret; - long numbytes; + intnat numbytes; char iobuf[UNIX_BUFFER_SIZE]; Begin_root (buff); @@ -49,7 +49,7 @@ CAMLprim value unix_recv(value sock, value buff, value ofs, value len, value fla CAMLprim value unix_recvfrom(value sock, value buff, value ofs, value len, value flags) { int ret; - long numbytes; + intnat numbytes; char iobuf[UNIX_BUFFER_SIZE]; value res; value adr = Val_unit; @@ -82,7 +82,7 @@ CAMLprim value unix_recvfrom(value sock, value buff, value ofs, value len, value CAMLprim value unix_send(value sock, value buff, value ofs, value len, value flags) { int ret; - long numbytes; + intnat numbytes; char iobuf[UNIX_BUFFER_SIZE]; numbytes = Long_val(len); @@ -102,7 +102,7 @@ CAMLprim value unix_send(value sock, value buff, value ofs, value len, value fla value unix_sendto_native(value sock, value buff, value ofs, value len, value flags, value dest) { int ret; - long numbytes; + intnat numbytes; char iobuf[UNIX_BUFFER_SIZE]; union sock_addr_union addr; socklen_param_type addr_len; diff --git a/otherlibs/win32unix/unixsupport.c b/otherlibs/win32unix/unixsupport.c index c8f3dd23a..90cade2a0 100644 --- a/otherlibs/win32unix/unixsupport.c +++ b/otherlibs/win32unix/unixsupport.c @@ -33,9 +33,9 @@ static int win_handle_compare(value v1, value v2) return h1 == h2 ? 0 : h1 < h2 ? -1 : 1; } -static long win_handle_hash(value v) +static intnat win_handle_hash(value v) { - return (long) Handle_val(v); + return (intnat) Handle_val(v); } static struct custom_operations win_handle_ops = { @@ -77,7 +77,7 @@ value win_alloc_handle_or_socket(HANDLE h) /* Mapping of Windows error codes to POSIX error codes */ -struct error_entry { unsigned long win_code; int range; int posix_code; }; +struct error_entry { DWORD win_code; int range; int posix_code; }; static struct error_entry win_error_table[] = { { ERROR_INVALID_FUNCTION, 0, EINVAL}, @@ -148,7 +148,7 @@ static struct error_entry win_error_table[] = { { 0, -1, 0 } }; -void win32_maperr(unsigned long errcode) +void win32_maperr(DWORD errcode) { int i; diff --git a/otherlibs/win32unix/unixsupport.h b/otherlibs/win32unix/unixsupport.h index 2b1ff71ea..b7d6ed64e 100644 --- a/otherlibs/win32unix/unixsupport.h +++ b/otherlibs/win32unix/unixsupport.h @@ -46,7 +46,7 @@ extern value win_alloc_socket(SOCKET); #define NO_CRT_FD (-1) #define Nothing ((value) 0) -extern void win32_maperr(unsigned long errcode); +extern void win32_maperr(DWORD errcode); extern void unix_error (int errcode, char * cmdname, value arg); extern void uerror (char * cmdname, value arg); extern value unix_freeze_buffer (value); diff --git a/otherlibs/win32unix/winwait.c b/otherlibs/win32unix/winwait.c index db3a62dde..0a68076b4 100644 --- a/otherlibs/win32unix/winwait.c +++ b/otherlibs/win32unix/winwait.c @@ -28,7 +28,7 @@ static value alloc_process_status(HANDLE pid, int status) Field(st, 0) = Val_int(status); Begin_root (st); res = alloc_small(2, 0); - Field(res, 0) = Val_long((long) pid); + Field(res, 0) = Val_long((intnat) pid); Field(res, 1) = st; End_roots(); return res; diff --git a/otherlibs/win32unix/write.c b/otherlibs/win32unix/write.c index 862e50791..8c255e11a 100644 --- a/otherlibs/win32unix/write.c +++ b/otherlibs/win32unix/write.c @@ -22,7 +22,7 @@ CAMLprim value unix_write(value fd, value buf, value vofs, value vlen) { - long ofs, len, written; + intnat ofs, len, written; DWORD numbytes, numwritten; char iobuf[UNIX_BUFFER_SIZE]; @@ -65,7 +65,7 @@ CAMLprim value unix_write(value fd, value buf, value vofs, value vlen) CAMLprim value unix_single_write(value fd, value buf, value vofs, value vlen) { - long ofs, len, written; + intnat ofs, len, written; DWORD numbytes, numwritten; char iobuf[UNIX_BUFFER_SIZE]; |