diff options
author | Olivier Andrieu <oandrieu@gmail.com> | 2017-02-27 17:32:44 +0100 |
---|---|---|
committer | David Allsopp <david.allsopp@metastack.com> | 2017-08-14 21:19:16 +0100 |
commit | ad273c995a78bee2e7158c15093e0f4c322708fa (patch) | |
tree | 3842ac6f78c257ed7f9345043bc1a239bad4882a | |
parent | a1fa0338ef7e11052ef304936694bddda3214fc4 (diff) | |
download | ocaml-ad273c995a78bee2e7158c15093e0f4c322708fa.tar.gz |
Fix several printf format string issues
- enable gcc typechecking for the format string in caml_alloc_sprintf and
caml_gc_message
- make caml_gc_message a variadic function
- use the proper format type modifier for intnat/uintnat arguments:
ARCH_INTNAT_PRINTF_FORMAT rather than %ld/%lu
-rw-r--r-- | Changes | 5 | ||||
-rw-r--r-- | asmrun/startup.c | 2 | ||||
-rw-r--r-- | byterun/caml/alloc.h | 6 | ||||
-rw-r--r-- | byterun/caml/misc.h | 6 | ||||
-rw-r--r-- | byterun/compact.c | 11 | ||||
-rw-r--r-- | byterun/compare.c | 2 | ||||
-rw-r--r-- | byterun/dynlink.c | 4 | ||||
-rw-r--r-- | byterun/extern.c | 2 | ||||
-rw-r--r-- | byterun/finalise.c | 4 | ||||
-rw-r--r-- | byterun/gc_ctrl.c | 59 | ||||
-rw-r--r-- | byterun/instrtrace.c | 4 | ||||
-rw-r--r-- | byterun/intern.c | 2 | ||||
-rw-r--r-- | byterun/interp.c | 3 | ||||
-rw-r--r-- | byterun/major_gc.c | 26 | ||||
-rw-r--r-- | byterun/memory.c | 15 | ||||
-rw-r--r-- | byterun/meta.c | 3 | ||||
-rw-r--r-- | byterun/minor_gc.c | 4 | ||||
-rw-r--r-- | byterun/misc.c | 12 | ||||
-rw-r--r-- | byterun/stacks.c | 6 | ||||
-rw-r--r-- | byterun/startup.c | 13 | ||||
-rw-r--r-- | byterun/sys.c | 26 | ||||
-rw-r--r-- | byterun/win32.c | 7 |
22 files changed, 134 insertions, 88 deletions
@@ -390,6 +390,11 @@ Working version ### Runtime system: +- GPR#1070: enable gcc typechecking for caml_alloc_sprintf, caml_gc_message. + Make caml_gc_message a variadic function. Fix many caml_gc_message format + strings. + (Olivier Andrieu) + - GPR#71: The runtime can now be shut down gracefully by means of the new caml_shutdown and caml_startup_pooled functions. The new 'c' flag in OCAMLRUNPARAM enables shutting the runtime properly on process exit. diff --git a/asmrun/startup.c b/asmrun/startup.c index 41c1878e0a..3c8f8a0a70 100644 --- a/asmrun/startup.c +++ b/asmrun/startup.c @@ -114,7 +114,7 @@ value caml_startup_common(char **argv, int pooling) #endif caml_parse_ocamlrunparam(); #ifdef DEBUG - caml_gc_message (-1, "### OCaml runtime: debug mode ###\n", 0); + caml_gc_message (-1, "### OCaml runtime: debug mode ###\n"); #endif if (caml_cleanup_on_exit) pooling = 1; diff --git a/byterun/caml/alloc.h b/byterun/caml/alloc.h index cf1377b061..81fff85821 100644 --- a/byterun/caml/alloc.h +++ b/byterun/caml/alloc.h @@ -41,7 +41,11 @@ CAMLextern value caml_copy_int64 (int64_t); /* defined in [ints.c] */ CAMLextern value caml_copy_nativeint (intnat); /* defined in [ints.c] */ CAMLextern value caml_alloc_array (value (*funct) (char const *), char const ** array); -CAMLextern value caml_alloc_sprintf(const char * format, ...); +CAMLextern value caml_alloc_sprintf(const char * format, ...) +#ifdef __GNUC__ + __attribute__ ((format (printf, 1, 2))) +#endif +; CAMLextern value caml_alloc_with_profinfo (mlsize_t, tag_t, intnat); CAMLextern value caml_alloc_small_with_my_or_given_profinfo ( diff --git a/byterun/caml/misc.h b/byterun/caml/misc.h index d0b6927e47..415dda1877 100644 --- a/byterun/caml/misc.h +++ b/byterun/caml/misc.h @@ -286,7 +286,11 @@ CAMLextern int caml_read_directory(char * dirname, struct ext_table * contents); /* GC flags and messages */ extern uintnat caml_verb_gc; -void caml_gc_message (int, char *, uintnat); +void caml_gc_message (int, char *, ...) +#ifdef __GNUC__ + __attribute__ ((format (printf, 2, 3))) +#endif +; /* Runtime warnings */ extern uintnat caml_runtime_warnings; diff --git a/byterun/compact.c b/byterun/compact.c index 76f7af6a9f..7b7188ab80 100644 --- a/byterun/compact.c +++ b/byterun/compact.c @@ -160,7 +160,7 @@ static void do_compaction (void) { char *ch, *chend; CAMLassert (caml_gc_phase == Phase_idle); - caml_gc_message (0x10, "Compacting heap...\n", 0); + caml_gc_message (0x10, "Compacting heap...\n"); #ifdef DEBUG caml_heap_check (); @@ -417,7 +417,7 @@ static void do_compaction (void) } } ++ caml_stat_compactions; - caml_gc_message (0x10, "done.\n", 0); + caml_gc_message (0x10, "done.\n"); } uintnat caml_percent_max; /* used in gc_ctrl.c and memory.c */ @@ -474,7 +474,8 @@ void caml_compact_heap (void) /* Recompact. */ char *chunk; - caml_gc_message (0x10, "Recompacting heap (target=%luk words)\n", + caml_gc_message (0x10, "Recompacting heap (target=%" + ARCH_INTNAT_PRINTF_FORMAT "uk words)\n", target_wsz / 1024); chunk = caml_alloc_for_heap (Bsize_wsize (target_wsz)); @@ -543,7 +544,7 @@ void caml_compact_heap_maybe (void) ARCH_INTNAT_PRINTF_FORMAT "u%%\n", (uintnat) fp); if (fp >= caml_percent_max){ - caml_gc_message (0x200, "Automatic compaction triggered.\n", 0); + caml_gc_message (0x200, "Automatic compaction triggered.\n"); caml_empty_minor_heap (); /* minor heap must be empty for compaction */ caml_finish_major_cycle (); @@ -555,7 +556,7 @@ void caml_compact_heap_maybe (void) if (fp >= caml_percent_max) caml_compact_heap (); else - caml_gc_message (0x200, "Automatic compaction aborted.\n", 0); + caml_gc_message (0x200, "Automatic compaction aborted.\n"); } } diff --git a/byterun/compare.c b/byterun/compare.c index 0a1f30e345..a6582f02c1 100644 --- a/byterun/compare.c +++ b/byterun/compare.c @@ -54,7 +54,7 @@ static void compare_free_stack(struct compare_stack* stk) /* Same, then raise Out_of_memory */ static void compare_stack_overflow(struct compare_stack* stk) { - caml_gc_message (0x04, "Stack overflow in structural comparison\n", 0); + caml_gc_message (0x04, "Stack overflow in structural comparison\n"); compare_free_stack(stk); caml_raise_out_of_memory(); } diff --git a/byterun/dynlink.c b/byterun/dynlink.c index a7dd5f53b4..f0c07cd7a0 100644 --- a/byterun/dynlink.c +++ b/byterun/dynlink.c @@ -123,7 +123,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", - (uintnat) realname); + realname); caml_enter_blocking_section(); handle = caml_dlopen(realname, 1, 1); caml_leave_blocking_section(); @@ -218,7 +218,7 @@ CAMLprim value caml_dynlink_open_lib(value mode, value filename) char * p; caml_gc_message(0x100, "Opening shared library %s\n", - (uintnat) String_val(filename)); + String_val(filename)); p = caml_stat_strdup(String_val(filename)); caml_enter_blocking_section(); handle = caml_dlopen(p, Int_val(mode), 1); diff --git a/byterun/extern.c b/byterun/extern.c index d2fa830989..d550d8b13f 100644 --- a/byterun/extern.c +++ b/byterun/extern.c @@ -300,7 +300,7 @@ static void extern_failwith(char *msg) static void extern_stack_overflow(void) { - caml_gc_message (0x04, "Stack overflow in marshaling value\n", 0); + caml_gc_message (0x04, "Stack overflow in marshaling value\n"); extern_replay_trail(); free_extern_output(); caml_raise_out_of_memory(); diff --git a/byterun/finalise.c b/byterun/finalise.c index ebc772effe..12fe92b494 100644 --- a/byterun/finalise.c +++ b/byterun/finalise.c @@ -178,7 +178,7 @@ void caml_final_do_calls (void) if (running_finalisation_function) return; if (to_do_hd != NULL){ if (caml_finalise_begin_hook != NULL) (*caml_finalise_begin_hook) (); - caml_gc_message (0x80, "Calling finalisation functions.\n", 0); + caml_gc_message (0x80, "Calling finalisation functions.\n"); while (1){ while (to_do_hd != NULL && to_do_hd->size == 0){ struct to_do *next_hd = to_do_hd->next; @@ -205,7 +205,7 @@ void caml_final_do_calls (void) running_finalisation_function = 0; if (Is_exception_result (res)) caml_raise (Extract_exception (res)); } - caml_gc_message (0x80, "Done calling finalisation functions.\n", 0); + caml_gc_message (0x80, "Done calling finalisation functions.\n"); if (caml_finalise_end_hook != NULL) (*caml_finalise_end_hook) (); } } diff --git a/byterun/gc_ctrl.c b/byterun/gc_ctrl.c index 986bddcec0..18b4565489 100644 --- a/byterun/gc_ctrl.c +++ b/byterun/gc_ctrl.c @@ -143,7 +143,7 @@ static value heap_stats (int returnstats) header_t cur_hd; #ifdef DEBUG - caml_gc_message (-1, "### OCaml runtime: heap check ###\n", 0); + caml_gc_message (-1, "### OCaml runtime: heap check ###\n"); #endif while (chunk != NULL){ @@ -415,31 +415,35 @@ CAMLprim value caml_gc_set(value v) newpf = norm_pfree (Long_val (Field (v, 2))); if (newpf != caml_percent_free){ caml_percent_free = newpf; - caml_gc_message (0x20, "New space overhead: %d%%\n", caml_percent_free); + caml_gc_message (0x20, "New space overhead: %" + ARCH_INTNAT_PRINTF_FORMAT "u%%\n", caml_percent_free); } newpm = norm_pmax (Long_val (Field (v, 4))); if (newpm != caml_percent_max){ caml_percent_max = newpm; - caml_gc_message (0x20, "New max overhead: %d%%\n", caml_percent_max); + caml_gc_message (0x20, "New max overhead: %" + ARCH_INTNAT_PRINTF_FORMAT "u%%\n", caml_percent_max); } newheapincr = Long_val (Field (v, 1)); if (newheapincr != caml_major_heap_increment){ caml_major_heap_increment = newheapincr; if (newheapincr > 1000){ - caml_gc_message (0x20, "New heap increment size: %luk words\n", + caml_gc_message (0x20, "New heap increment size: %" + ARCH_INTNAT_PRINTF_FORMAT "uk words\n", caml_major_heap_increment/1024); }else{ - caml_gc_message (0x20, "New heap increment size: %lu%%\n", + caml_gc_message (0x20, "New heap increment size: %" + ARCH_INTNAT_PRINTF_FORMAT "u%%\n", caml_major_heap_increment); } } oldpolicy = caml_allocation_policy; caml_set_allocation_policy (Long_val (Field (v, 6))); if (oldpolicy != caml_allocation_policy){ - caml_gc_message (0x20, "New allocation policy: %d\n", - caml_allocation_policy); + caml_gc_message (0x20, "New allocation policy: %" + ARCH_INTNAT_PRINTF_FORMAT "u\n", caml_allocation_policy); } /* This field was added in 4.03.0. */ @@ -456,8 +460,8 @@ CAMLprim value caml_gc_set(value v) (thus invalidating [v]) and it can raise [Out_of_memory]. */ newminwsz = norm_minsize (Long_val (Field (v, 0))); if (newminwsz != caml_minor_heap_wsz){ - caml_gc_message (0x20, "New minor heap size: %luk words\n", - newminwsz / 1024); + caml_gc_message (0x20, "New minor heap size: %" + ARCH_INTNAT_PRINTF_FORMAT "uk words\n", newminwsz / 1024); caml_set_minor_heap_size (Bsize_wsize (newminwsz)); } CAML_INSTR_TIME (tmr, "explicit/gc_set"); @@ -484,7 +488,7 @@ static void test_and_compact (void) ARCH_INTNAT_PRINTF_FORMAT "u%%\n", (uintnat) fp); if (fp >= caml_percent_max){ - caml_gc_message (0x200, "Automatic compaction triggered.\n", 0); + caml_gc_message (0x200, "Automatic compaction triggered.\n"); caml_compact_heap (); } } @@ -493,7 +497,7 @@ CAMLprim value caml_gc_major(value v) { CAML_INSTR_SETUP (tmr, ""); CAMLassert (v == Val_unit); - caml_gc_message (0x1, "Major GC cycle requested\n", 0); + caml_gc_message (0x1, "Major GC cycle requested\n"); caml_empty_minor_heap (); caml_finish_major_cycle (); test_and_compact (); @@ -506,7 +510,7 @@ CAMLprim value caml_gc_full_major(value v) { CAML_INSTR_SETUP (tmr, ""); CAMLassert (v == Val_unit); - caml_gc_message (0x1, "Full major GC cycle requested\n", 0); + caml_gc_message (0x1, "Full major GC cycle requested\n"); caml_empty_minor_heap (); caml_finish_major_cycle (); caml_final_do_calls (); @@ -531,7 +535,7 @@ CAMLprim value caml_gc_compaction(value v) { CAML_INSTR_SETUP (tmr, ""); CAMLassert (v == Val_unit); - caml_gc_message (0x10, "Heap compaction requested\n", 0); + caml_gc_message (0x10, "Heap compaction requested\n"); caml_empty_minor_heap (); caml_finish_major_cycle (); caml_final_do_calls (); @@ -598,21 +602,27 @@ void caml_init_gc (uintnat minor_size, uintnat major_size, caml_percent_max = norm_pmax (percent_m); caml_init_major_heap (major_heap_size); caml_major_window = norm_window (window); - caml_gc_message (0x20, "Initial minor heap size: %luk words\n", + caml_gc_message (0x20, "Initial minor heap size: %" + ARCH_INTNAT_PRINTF_FORMAT "uk words\n", caml_minor_heap_wsz / 1024); - caml_gc_message (0x20, "Initial major heap size: %luk bytes\n", + caml_gc_message (0x20, "Initial major heap size: %" + ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n", major_heap_size / 1024); - caml_gc_message (0x20, "Initial space overhead: %lu%%\n", caml_percent_free); - caml_gc_message (0x20, "Initial max overhead: %lu%%\n", caml_percent_max); + caml_gc_message (0x20, "Initial space overhead: %" + ARCH_INTNAT_PRINTF_FORMAT "u%%\n", caml_percent_free); + caml_gc_message (0x20, "Initial max overhead: %" + ARCH_INTNAT_PRINTF_FORMAT "u%%\n", caml_percent_max); if (caml_major_heap_increment > 1000){ - caml_gc_message (0x20, "Initial heap increment: %luk words\n", + caml_gc_message (0x20, "Initial heap increment: %" + ARCH_INTNAT_PRINTF_FORMAT "uk words\n", caml_major_heap_increment / 1024); }else{ - caml_gc_message (0x20, "Initial heap increment: %lu%%\n", + caml_gc_message (0x20, "Initial heap increment: %" + ARCH_INTNAT_PRINTF_FORMAT "u%%\n", caml_major_heap_increment); } - caml_gc_message (0x20, "Initial allocation policy: %d\n", - caml_allocation_policy); + caml_gc_message (0x20, "Initial allocation policy: %" + ARCH_INTNAT_PRINTF_FORMAT "u\n", caml_allocation_policy); caml_gc_message (0x20, "Initial smoothing window: %d\n", caml_major_window); } @@ -636,16 +646,18 @@ extern int caml_parser_trace; CAMLprim value caml_runtime_parameters (value unit) { +#define F_Z ARCH_INTNAT_PRINTF_FORMAT + CAMLassert (unit == Val_unit); return caml_alloc_sprintf - ("a=%d,b=%d,H=%lu,i=%lu,l=%lu,o=%lu,O=%lu,p=%d,s=%lu,t=%lu,v=%lu,w=%d,W=%lu", + ("a=%d,b=%d,H=%"F_Z"u,i=%"F_Z"u,l=%"F_Z"u,o=%"F_Z"u,O=%"F_Z"u,p=%d,s=%"F_Z"u,t=%"F_Z"u,v=%"F_Z"u,w=%d,W=%"F_Z"u", /* a */ (int) caml_allocation_policy, /* b */ caml_backtrace_active, /* h */ /* missing */ /* FIXME add when changed to min_heap_size */ /* H */ caml_use_huge_pages, /* i */ caml_major_heap_increment, #ifdef NATIVE_CODE - /* l */ 0UL, + /* l */ (uintnat) 0, #else /* l */ caml_max_stack_size, #endif @@ -659,6 +671,7 @@ CAMLprim value caml_runtime_parameters (value unit) /* w */ caml_major_window, /* W */ caml_runtime_warnings ); +#undef F_Z } /* Control runtime warnings */ diff --git a/byterun/instrtrace.c b/byterun/instrtrace.c index c2ad8348b4..fe99f6867a 100644 --- a/byterun/instrtrace.c +++ b/byterun/instrtrace.c @@ -181,7 +181,7 @@ void caml_trace_value_file (value v, code_t prog, int proglen, FILE * f) { int i; - fprintf (f, "%#lx", v); + fprintf (f, "%#" ARCH_INTNAT_PRINTF_FORMAT "x", v); if (!v) return; if (prog && v % sizeof (int) == 0 @@ -239,7 +239,7 @@ caml_trace_value_file (value v, code_t prog, int proglen, FILE * f) }; if (i > 0) putc (' ', f); - fprintf (f, "%#lx", Field (v, i)); + fprintf (f, "%#" ARCH_INTNAT_PRINTF_FORMAT "x", Field (v, i)); }; if (s > 0) putc (')', f); diff --git a/byterun/intern.c b/byterun/intern.c index beab3d8320..ba78846fd4 100644 --- a/byterun/intern.c +++ b/byterun/intern.c @@ -266,7 +266,7 @@ static void intern_free_stack(void) /* Same, then raise Out_of_memory */ static void intern_stack_overflow(void) { - caml_gc_message (0x04, "Stack overflow in un-marshaling value\n", 0); + caml_gc_message (0x04, "Stack overflow in un-marshaling value\n"); intern_free_stack(); caml_raise_out_of_memory(); } diff --git a/byterun/interp.c b/byterun/interp.c index 2415aa8f12..2af27ccdbe 100644 --- a/byterun/interp.c +++ b/byterun/interp.c @@ -276,7 +276,8 @@ value caml_interprete(code_t prog, asize_t prog_size) #ifdef DEBUG caml_bcodcount++; if (caml_icount-- == 0) caml_stop_here (); - if (caml_trace_level>1) printf("\n##%ld\n", caml_bcodcount); + if (caml_trace_level>1) printf("\n##%" ARCH_INTNAT_PRINTF_FORMAT "d\n", + caml_bcodcount); if (caml_trace_level>0) caml_disasm_instr(pc); if (caml_trace_level>1) { printf("env="); diff --git a/byterun/major_gc.c b/byterun/major_gc.c index e56b1399d5..cc82b7e228 100644 --- a/byterun/major_gc.c +++ b/byterun/major_gc.c @@ -132,7 +132,7 @@ static void realloc_gray_vals (void) 2 * gray_vals_size * sizeof (value)); if (new == NULL){ - caml_gc_message (0x08, "No room for growing gray_vals\n", 0); + caml_gc_message (0x08, "No room for growing gray_vals\n"); gray_vals_cur = gray_vals; heap_is_pure = 0; }else{ @@ -188,7 +188,7 @@ static void start_cycle (void) { CAMLassert (caml_gc_phase == Phase_idle); CAMLassert (gray_vals_cur == gray_vals); - caml_gc_message (0x01, "Starting new major GC cycle\n", 0); + caml_gc_message (0x01, "Starting new major GC cycle\n"); caml_darken_all_roots_start (); caml_gc_phase = Phase_mark; caml_gc_subphase = Subphase_mark_roots; @@ -383,8 +383,8 @@ static void mark_slice (intnat work) #endif int slice_pointers = 0; /** gcc removes it when not in CAML_INSTR */ - caml_gc_message (0x40, "Marking %ld words\n", work); - caml_gc_message (0x40, "Subphase = %ld\n", caml_gc_subphase); + caml_gc_message (0x40, "Marking %"ARCH_INTNAT_PRINTF_FORMAT"d words\n", work); + caml_gc_message (0x40, "Subphase = %d\n", caml_gc_subphase); gray_vals_ptr = gray_vals_cur; v = current_value; start = current_index; @@ -514,7 +514,8 @@ static void clean_slice (intnat work) { value v; - caml_gc_message (0x40, "Cleaning %ld words\n", work); + caml_gc_message (0x40, "Cleaning %" + ARCH_INTNAT_PRINTF_FORMAT "d words\n", work); while (work > 0){ v = *ephes_to_check; if (v != (value) NULL){ @@ -541,7 +542,8 @@ static void sweep_slice (intnat work) char *hp; header_t hd; - caml_gc_message (0x40, "Sweeping %ld words\n", work); + caml_gc_message (0x40, "Sweeping %" + ARCH_INTNAT_PRINTF_FORMAT "d words\n", work); while (work > 0){ if (caml_gc_sweep_hp < limit){ hp = caml_gc_sweep_hp; @@ -687,7 +689,8 @@ void caml_major_collection_slice (intnat howmuch) CAML_INSTR_INT ("major/work/extra#", (uintnat) (caml_extra_heap_resources * 1000000)); - caml_gc_message (0x40, "ordered work = %ld words\n", howmuch); + caml_gc_message (0x40, "ordered work = %" + ARCH_INTNAT_PRINTF_FORMAT "d words\n", howmuch); caml_gc_message (0x40, "allocated_words = %" ARCH_INTNAT_PRINTF_FORMAT "u\n", caml_allocated_words); @@ -765,21 +768,22 @@ void caml_major_collection_slice (intnat howmuch) }else{ computed_work = (intnat) (p * caml_stat_heap_wsz * 5 / 3); } - caml_gc_message (0x40, "computed work = %ld words\n", computed_work); + caml_gc_message (0x40, "computed work = %" + ARCH_INTNAT_PRINTF_FORMAT "d words\n", computed_work); if (caml_gc_phase == Phase_mark){ CAML_INSTR_INT ("major/work/mark#", computed_work); mark_slice (computed_work); CAML_INSTR_TIME (tmr, mark_slice_name[caml_gc_subphase]); - caml_gc_message (0x02, "!", 0); + caml_gc_message (0x02, "!"); }else if (caml_gc_phase == Phase_clean){ clean_slice (computed_work); - caml_gc_message (0x02, "%%", 0); + caml_gc_message (0x02, "%%"); }else{ CAMLassert (caml_gc_phase == Phase_sweep); CAML_INSTR_INT ("major/work/sweep#", computed_work); sweep_slice (computed_work); CAML_INSTR_TIME (tmr, "major/sweep"); - caml_gc_message (0x02, "$", 0); + caml_gc_message (0x02, "$"); } if (caml_gc_phase == Phase_idle){ diff --git a/byterun/memory.c b/byterun/memory.c index e8798b9248..8f048edfaf 100644 --- a/byterun/memory.c +++ b/byterun/memory.c @@ -128,12 +128,13 @@ static int caml_page_table_resize(void) uintnat * new_entries; uintnat i, h; - caml_gc_message (0x08, "Growing page table to %lu entries\n", + caml_gc_message (0x08, "Growing page table to %" + ARCH_INTNAT_PRINTF_FORMAT "u entries\n", caml_page_table.size); new_entries = caml_stat_calloc_noexc(2 * old.size, sizeof(uintnat)); if (new_entries == NULL) { - caml_gc_message (0x08, "No room for growing page table\n", 0); + caml_gc_message (0x08, "No room for growing page table\n"); return -1; } @@ -331,7 +332,8 @@ int caml_add_to_heap (char *m) /* Should check the contents of the block. */ #endif /* DEBUG */ - caml_gc_message (0x04, "Growing heap to %luk bytes\n", + caml_gc_message (0x04, "Growing heap to %" + ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n", (Bsize_wsize (caml_stat_heap_wsz) + Chunk_size (m)) / 1024); /* Register block in page table */ @@ -381,7 +383,7 @@ static value *expand_heap (mlsize_t request) malloc_request = caml_clip_heap_chunk_wsz (over_request); mem = (value *) caml_alloc_for_heap (Bsize_wsize (malloc_request)); if (mem == NULL){ - caml_gc_message (0x04, "No room for growing heap\n", 0); + caml_gc_message (0x04, "No room for growing heap\n"); return NULL; } remain = Wsize_bsize (Chunk_size (mem)); @@ -435,8 +437,9 @@ void caml_shrink_heap (char *chunk) if (chunk == caml_heap_start) return; caml_stat_heap_wsz -= Wsize_bsize (Chunk_size (chunk)); - caml_gc_message (0x04, "Shrinking heap to %luk words\n", - (unsigned long) caml_stat_heap_wsz / 1024); + caml_gc_message (0x04, "Shrinking heap to %" + ARCH_INTNAT_PRINTF_FORMAT "uk words\n", + caml_stat_heap_wsz / 1024); #ifdef DEBUG { diff --git a/byterun/meta.c b/byterun/meta.c index c54ffc0e72..03e0479d04 100644 --- a/byterun/meta.c +++ b/byterun/meta.c @@ -123,7 +123,8 @@ CAMLprim value caml_realloc_global(value size) actual_size = Wosize_val(caml_global_data); if (requested_size >= actual_size) { requested_size = (requested_size + 0x100) & 0xFFFFFF00; - caml_gc_message (0x08, "Growing global data to %lu entries\n", + caml_gc_message (0x08, "Growing global data to %" + ARCH_INTNAT_PRINTF_FORMAT "u entries\n", requested_size); new_global_data = caml_alloc_shr(requested_size, 0); for (i = 0; i < actual_size; i++) diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c index 6458e60075..9e366da176 100644 --- a/byterun/minor_gc.c +++ b/byterun/minor_gc.c @@ -342,7 +342,7 @@ void caml_empty_minor_heap (void) CAML_INSTR_SETUP (tmr, "minor"); prev_alloc_words = caml_allocated_words; caml_in_minor_collection = 1; - caml_gc_message (0x02, "<", 0); + caml_gc_message (0x02, "<"); caml_oldify_local_roots(); CAML_INSTR_TIME (tmr, "minor/local_roots"); for (r = caml_ref_table.base; r < caml_ref_table.ptr; r++){ @@ -390,7 +390,7 @@ void caml_empty_minor_heap (void) clear_table ((struct generic_table *) &caml_ref_table); clear_table ((struct generic_table *) &caml_ephe_ref_table); clear_table ((struct generic_table *) &caml_custom_table); - caml_gc_message (0x02, ">", 0); + caml_gc_message (0x02, ">"); caml_in_minor_collection = 0; caml_final_empty_young (); CAML_INSTR_TIME (tmr, "minor/finalized"); diff --git a/byterun/misc.c b/byterun/misc.c index 59d4f7fc63..46e40992b4 100644 --- a/byterun/misc.c +++ b/byterun/misc.c @@ -17,6 +17,7 @@ #include <stdio.h> #include <string.h> +#include <stdarg.h> #include "caml/config.h" #include "caml/misc.h" #include "caml/memory.h" @@ -52,10 +53,13 @@ void caml_set_fields (value v, unsigned long start, unsigned long filler) uintnat caml_verb_gc = 0; -void caml_gc_message (int level, char *msg, uintnat arg) +void caml_gc_message (int level, char *msg, ...) { if ((caml_verb_gc & level) != 0){ - fprintf (stderr, msg, arg); + va_list ap; + va_start(ap, msg); + vfprintf (stderr, msg, ap); + va_end(ap); fflush (stderr); } } @@ -259,11 +263,11 @@ void CAML_INSTR_ATEXIT (void) for (p = CAML_INSTR_LOG; p != NULL; p = p->next){ for (i = 0; i < p->index; i++){ fprintf (f, "@@ %19ld %19ld %s\n", - Get_time (p, i), Get_time(p, i+1), p->tag[i+1]); + (long) Get_time (p, i), (long) Get_time(p, i+1), p->tag[i+1]); } if (p->tag[0][0] != '\000'){ fprintf (f, "@@ %19ld %19ld %s\n", - Get_time (p, 0), Get_time(p, p->index), p->tag[0]); + (long) Get_time (p, 0), (long) Get_time(p, p->index), p->tag[0]); } } fclose (f); diff --git a/byterun/stacks.c b/byterun/stacks.c index 83442dd1b8..d6e7f53ce4 100644 --- a/byterun/stacks.c +++ b/byterun/stacks.c @@ -43,7 +43,8 @@ void caml_init_stack (uintnat initial_max_size) caml_trapsp = caml_stack_high; caml_trap_barrier = caml_stack_high + 1; caml_max_stack_size = initial_max_size; - caml_gc_message (0x08, "Initial stack limit: %luk bytes\n", + caml_gc_message (0x08, "Initial stack limit: %" + ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n", caml_max_stack_size / 1024 * sizeof (value)); } @@ -99,7 +100,8 @@ void caml_change_max_stack_size (uintnat new_max_size) if (new_max_size < size) new_max_size = size; if (new_max_size != caml_max_stack_size){ - caml_gc_message (0x08, "Changing stack limit to %luk bytes\n", + caml_gc_message (0x08, "Changing stack limit to %" + ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n", new_max_size * sizeof (value) / 1024); } caml_max_stack_size = new_max_size; diff --git a/byterun/startup.c b/byterun/startup.c index 136ad77fc7..a52d62a10e 100644 --- a/byterun/startup.c +++ b/byterun/startup.c @@ -97,12 +97,11 @@ int caml_attempt_open(char **name, struct exec_trailer *trail, char buf [2]; truename = caml_search_exe_in_path(*name); - caml_gc_message(0x100, "Opening bytecode executable %s\n", - (uintnat) truename); + caml_gc_message(0x100, "Opening bytecode executable %s\n", truename); fd = open(truename, O_RDONLY | O_BINARY); if (fd == -1) { caml_stat_free(truename); - caml_gc_message(0x100, "Cannot open file\n", 0); + caml_gc_message(0x100, "Cannot open file\n"); return FILE_NOT_FOUND; } if (!do_open_script) { @@ -110,7 +109,7 @@ int caml_attempt_open(char **name, struct exec_trailer *trail, if (err < 2 || (buf [0] == '#' && buf [1] == '!')) { close(fd); caml_stat_free(truename); - caml_gc_message(0x100, "Rejected #! script\n", 0); + caml_gc_message(0x100, "Rejected #! script\n"); return BAD_BYTECODE; } } @@ -118,7 +117,7 @@ int caml_attempt_open(char **name, struct exec_trailer *trail, if (err != 0) { close(fd); caml_stat_free(truename); - caml_gc_message(0x100, "Not a bytecode executable\n", 0); + caml_gc_message(0x100, "Not a bytecode executable\n"); return err; } *name = truename; @@ -292,7 +291,7 @@ CAMLexport void caml_main(char **argv) #endif caml_parse_ocamlrunparam(); #ifdef DEBUG - caml_gc_message (-1, "### OCaml runtime: debug mode ###\n", 0); + caml_gc_message (-1, "### OCaml runtime: debug mode ###\n"); #endif if (!caml_startup_aux(/* pooling */ caml_cleanup_on_exit)) return; @@ -416,7 +415,7 @@ CAMLexport value caml_startup_code_exn( #endif caml_parse_ocamlrunparam(); #ifdef DEBUG - caml_gc_message (-1, "### OCaml runtime: debug mode ###\n", 0); + caml_gc_message (-1, "### OCaml runtime: debug mode ###\n"); #endif if (caml_cleanup_on_exit) pooling = 1; diff --git a/byterun/sys.c b/byterun/sys.c index 1df9f961b5..3486f7af21 100644 --- a/byterun/sys.c +++ b/byterun/sys.c @@ -130,16 +130,22 @@ CAMLprim value caml_sys_exit(value retcode_v) intnat heap_chunks = caml_stat_heap_chunks; intnat top_heap_words = caml_stat_top_heap_wsz; intnat cpct = caml_stat_compactions; - caml_gc_message(0x400, "allocated_words: %ld\n", (long)allocated_words); - caml_gc_message(0x400, "minor_words: %ld\n", (long) minwords); - caml_gc_message(0x400, "promoted_words: %ld\n", (long) prowords); - caml_gc_message(0x400, "major_words: %ld\n", (long) majwords); - caml_gc_message(0x400, "minor_collections: %d\n", mincoll); - caml_gc_message(0x400, "major_collections: %d\n", majcoll); - caml_gc_message(0x400, "heap_words: %d\n", heap_words); - caml_gc_message(0x400, "heap_chunks: %d\n", heap_chunks); - caml_gc_message(0x400, "top_heap_words: %d\n", top_heap_words); - caml_gc_message(0x400, "compactions: %d\n", cpct); + caml_gc_message(0x400, "allocated_words: %.0f\n", allocated_words); + caml_gc_message(0x400, "minor_words: %.0f\n", minwords); + caml_gc_message(0x400, "promoted_words: %.0f\n", prowords); + caml_gc_message(0x400, "major_words: %.0f\n", majwords); + caml_gc_message(0x400, "minor_collections: %"ARCH_INTNAT_PRINTF_FORMAT"d\n", + mincoll); + caml_gc_message(0x400, "major_collections: %"ARCH_INTNAT_PRINTF_FORMAT"d\n", + majcoll); + caml_gc_message(0x400, "heap_words: %"ARCH_INTNAT_PRINTF_FORMAT"d\n", + heap_words); + caml_gc_message(0x400, "heap_chunks: %"ARCH_INTNAT_PRINTF_FORMAT"d\n", + heap_chunks); + caml_gc_message(0x400, "top_heap_words: %"ARCH_INTNAT_PRINTF_FORMAT"d\n", + top_heap_words); + caml_gc_message(0x400, "compactions: %"ARCH_INTNAT_PRINTF_FORMAT"d\n", + cpct); } #ifndef NATIVE_CODE diff --git a/byterun/win32.c b/byterun/win32.c index 5ca43b5c1d..dab12586fb 100644 --- a/byterun/win32.c +++ b/byterun/win32.c @@ -161,13 +161,13 @@ caml_stat_string caml_search_in_path(struct ext_table * path, const char * name) if (dir[0] == 0) continue; /* not sure what empty path components mean under Windows */ fullname = caml_stat_strconcat(3, dir, "\\", name); - caml_gc_message(0x100, "Searching %s\n", (uintnat) fullname); + caml_gc_message(0x100, "Searching %s\n", fullname); if (stat(fullname, &st) == 0 && S_ISREG(st.st_mode)) return fullname; caml_stat_free(fullname); } not_found: - caml_gc_message(0x100, "%s not found in search path\n", (uintnat) name); + caml_gc_message(0x100, "%s not found in search path\n", name); return caml_stat_strdup(name); } @@ -188,8 +188,7 @@ CAMLexport caml_stat_string caml_search_exe_in_path(const char * name) fullname, &filepart); if (retcode == 0) { - caml_gc_message(0x100, "%s not found in search path\n", - (uintnat) name); + caml_gc_message(0x100, "%s not found in search path\n", name); caml_stat_free(fullname); return caml_stat_strdup(name); } |