diff --git a/asmrun/signals.c b/asmrun/signals.c index 9b4b5a489..158558a88 100644 --- a/asmrun/signals.c +++ b/asmrun/signals.c @@ -42,11 +42,11 @@ #ifdef _AIXVERSION_430 #define STRUCT_SIGCONTEXT struct __sigcontext #define CONTEXT_GPR(ctx, regno) \ - ((ctx)->__sc_jmpbuf.__jmp_context.__gpr[regno]) + ((ctx)->__sc_jmpbuf.__jmp_context.__gpr[(regno)]) #else #define STRUCT_SIGCONTEXT struct sigcontext #define CONTEXT_GPR(ctx, regno) \ - ((ctx)->sc_jmpbuf.jmp_context.gpr[regno]) + ((ctx)->sc_jmpbuf.jmp_context.gpr[(regno)]) #endif #endif diff --git a/asmrun/stack.h b/asmrun/stack.h index 0b2367c24..117ad80da 100644 --- a/asmrun/stack.h +++ b/asmrun/stack.h @@ -19,63 +19,63 @@ /* Macros to access the stack frame */ #ifdef TARGET_alpha -#define Saved_return_address(sp) *((long *)(sp - 8)) -#define Already_scanned(sp, retaddr) (retaddr & 1L) -#define Mark_scanned(sp, retaddr) (*((long *)(sp - 8)) = retaddr | 1L) -#define Mask_already_scanned(retaddr) (retaddr & ~1L) -#define Callback_link(sp) ((struct caml_context *)(sp + 16)) +#define Saved_return_address(sp) *((long *)((sp) - 8)) +#define Already_scanned(sp, retaddr) ((retaddr) & 1L) +#define Mark_scanned(sp, retaddr) (*((long *)((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 Callback_link(sp) ((struct caml_context *)(sp + 104)) +#define Saved_return_address(sp) *((long *)((sp) + 92)) +#define Callback_link(sp) ((struct caml_context *)((sp) + 104)) #endif #ifdef TARGET_i386 -#define Saved_return_address(sp) *((long *)(sp - 4)) -#define Callback_link(sp) ((struct caml_context *)(sp + 8)) +#define Saved_return_address(sp) *((long *)((sp) - 4)) +#define Callback_link(sp) ((struct caml_context *)((sp) + 8)) #endif #ifdef TARGET_mips -#define Saved_return_address(sp) *((long *)(sp - 4)) -#define Callback_link(sp) ((struct caml_context *)(sp + 16)) +#define Saved_return_address(sp) *((long *)((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 Callback_link(sp) ((struct caml_context *)(sp - 24)) +#define Saved_return_address(sp) *((long *)(sp)) +#define Callback_link(sp) ((struct caml_context *)((sp) - 24)) #endif #ifdef TARGET_power -#define Saved_return_address(sp) *((long *)(sp - 4)) -#define Already_scanned(sp, retaddr) (retaddr & 1) -#define Mark_scanned(sp, retaddr) (*((long *)(sp - 4)) = retaddr | 1) -#define Mask_already_scanned(retaddr) (retaddr & ~1) +#define Saved_return_address(sp) *((long *)((sp) - 4)) +#define Already_scanned(sp, retaddr) ((retaddr) & 1) +#define Mark_scanned(sp, retaddr) (*((long *)((sp) - 4)) = (retaddr) | 1) +#define Mask_already_scanned(retaddr) ((retaddr) & ~1) #ifdef SYS_aix #define Trap_frame_size 24 #else #define Trap_frame_size 8 #endif -#define Callback_link(sp) ((struct caml_context *)(sp + Trap_frame_size)) +#define Callback_link(sp) ((struct caml_context *)((sp) + Trap_frame_size)) #endif #ifdef TARGET_m68k -#define Saved_return_address(sp) *((long *)(sp - 4)) -#define Callback_link(sp) ((struct caml_context *)(sp + 8)) +#define Saved_return_address(sp) *((long *)((sp) - 4)) +#define Callback_link(sp) ((struct caml_context *)((sp) + 8)) #endif #ifdef TARGET_arm -#define Saved_return_address(sp) *((long *)(sp - 4)) -#define Callback_link(sp) ((struct caml_context *)(sp + 8)) +#define Saved_return_address(sp) *((long *)((sp) - 4)) +#define Callback_link(sp) ((struct caml_context *)((sp) + 8)) #endif #ifdef TARGET_ia64 -#define Saved_return_address(sp) *((long *)(sp + 8)) -#define Already_scanned(sp, retaddr) (retaddr & 1L) -#define Mark_scanned(sp, retaddr) (*((long *)(sp + 8)) = retaddr | 1L) -#define Mask_already_scanned(retaddr) (retaddr & ~1L) -#define Callback_link(sp) ((struct caml_context *)(sp + 32)) +#define Saved_return_address(sp) *((long *)((sp) + 8)) +#define Already_scanned(sp, retaddr) ((retaddr) & 1L) +#define Mark_scanned(sp, retaddr) (*((long *)((sp) + 8)) = (retaddr) | 1L) +#define Mask_already_scanned(retaddr) ((retaddr) & ~1L) +#define Callback_link(sp) ((struct caml_context *)((sp) + 32)) #endif /* Structure of Caml callback contexts */ diff --git a/byterun/compare.c b/byterun/compare.c index 8c220bf6d..2d0ec368e 100644 --- a/byterun/compare.c +++ b/byterun/compare.c @@ -25,7 +25,7 @@ struct compare_item { value * v1, * v2; mlsize_t count; }; #define COMPARE_STACK_INIT_SIZE 256 -#define COMPARE_STACK_MAX_SIZE 1024*1024 +#define COMPARE_STACK_MAX_SIZE (1024*1024) static struct compare_item compare_stack_init[COMPARE_STACK_INIT_SIZE]; diff --git a/byterun/debugger.c b/byterun/debugger.c index afaba483f..a030f6fd3 100644 --- a/byterun/debugger.c +++ b/byterun/debugger.c @@ -160,10 +160,10 @@ static void safe_output_value(struct channel *chan, value val) external_raise = saved_external_raise; } -#define Pc(sp) ((code_t)(sp[0])) -#define Env(sp) (sp[1]) -#define Extra_args(sp) (Long_val((sp[2]))) -#define Locals(sp) (sp + 3) +#define Pc(sp) ((code_t)((sp)[0])) +#define Env(sp) ((sp)[1]) +#define Extra_args(sp) (Long_val(((sp)[2]))) +#define Locals(sp) ((sp) + 3) void debugger(enum event_kind event) { diff --git a/byterun/finalise.c b/byterun/finalise.c index c4e5147bf..2ff11ad44 100644 --- a/byterun/finalise.c +++ b/byterun/finalise.c @@ -77,7 +77,7 @@ void final_do_calls (void) } /* Call a scanning_action [f] on [x]. */ -#define Call_action(f,x) (*f) (x, &(x)) +#define Call_action(f,x) (*(f)) ((x), &(x)) /* Call [*f] on the closures of the finalisable set and the closures and values of the finalising set. diff --git a/byterun/gc_ctrl.c b/byterun/gc_ctrl.c index 472856637..b269a18f2 100644 --- a/byterun/gc_ctrl.c +++ b/byterun/gc_ctrl.c @@ -204,16 +204,23 @@ static value heap_stats (int returnstats) if (returnstats){ CAMLlocal1 (res); + /* get a copy of these before allocating anything... */ + double minwords = stat_minor_words + + (double) Wsize_bsize (young_end - young_ptr); + double prowords = stat_promoted_words; + double majwords = stat_major_words + (double) allocated_words; + long mincoll = stat_major_collections; + long majcoll = stat_minor_collections; + long heapsz = stat_heap_size; + long cpct = stat_compactions; + res = alloc_tuple (14); - Store_field (res, 0, - copy_double (stat_minor_words - + (double) Wsize_bsize (young_end - young_ptr))); - Store_field (res, 1, copy_double (stat_promoted_words)); - Store_field (res, 2, - copy_double (stat_major_words + (double) allocated_words)); - Store_field (res, 3, Val_long (stat_minor_collections)); - Store_field (res, 4, Val_long (stat_major_collections)); - Store_field (res, 5, Val_long (Wsize_bsize (stat_heap_size))); + Store_field (res, 0, copy_double (minwords)); + Store_field (res, 1, copy_double (prowords)); + Store_field (res, 2, copy_double (majwords)); + Store_field (res, 3, Val_long (mincoll)); + Store_field (res, 4, Val_long (majcoll)); + Store_field (res, 5, Val_long (heapsz)); Store_field (res, 6, Val_long (heap_chunks)); Store_field (res, 7, Val_long (live_words)); Store_field (res, 8, Val_long (live_blocks)); @@ -221,7 +228,7 @@ static value heap_stats (int returnstats) Store_field (res, 10, Val_long (free_blocks)); Store_field (res, 11, Val_long (largest_free)); Store_field (res, 12, Val_long (fragments)); - Store_field (res, 13, Val_long (stat_compactions)); + Store_field (res, 13, Val_long (cpct)); CAMLreturn (res); }else{ CAMLreturn (Val_unit); @@ -246,13 +253,16 @@ value gc_counters(value v) /* ML */ CAMLparam0 (); /* v is ignored */ CAMLlocal1 (res); + /* get a copy of these before allocating anything... */ + double minwords = stat_minor_words + + (double) Wsize_bsize (young_end - young_ptr); + double prowords = stat_promoted_words; + double majwords = stat_major_words + (double) allocated_words; + res = alloc_tuple (3); - Store_field (res, 0, - copy_double (stat_minor_words - + (double) Wsize_bsize (young_end - young_ptr))); - Store_field (res, 1, copy_double (stat_promoted_words)); - Store_field (res, 2, - copy_double (stat_major_words + (double) allocated_words)); + Store_field (res, 0, copy_double (minwords)); + Store_field (res, 1, copy_double (prowords)); + Store_field (res, 2, copy_double (majwords)); CAMLreturn (res); } diff --git a/byterun/intern.c b/byterun/intern.c index 19fe83744..edf856f94 100644 --- a/byterun/intern.c +++ b/byterun/intern.c @@ -93,7 +93,7 @@ static long read64s(void) #endif #define readblock(dest,len) \ - (memmove(dest, intern_src, len), intern_src += len) + (memmove((dest), intern_src, (len)), intern_src += (len)) static void intern_cleanup(void) { diff --git a/byterun/io.h b/byterun/io.h index ee6ae4016..0be5adaf1 100644 --- a/byterun/io.h +++ b/byterun/io.h @@ -44,9 +44,10 @@ struct channel { /* Functions and macros that can be called from C. Take arguments of type struct channel *. No locking is performed. */ -#define putch(channel, ch) \ - { if ((channel)->curr >= (channel)->end) flush_partial(channel); \ - *((channel)->curr)++ = (ch); } +#define putch(channel, ch) do{ \ + if ((channel)->curr >= (channel)->end) flush_partial(channel); \ + *((channel)->curr)++ = (ch); \ +}while(0) #define getch(channel) \ ((channel)->curr >= (channel)->max \ diff --git a/byterun/lexing.c b/byterun/lexing.c index a139dfde6..790053c46 100644 --- a/byterun/lexing.c +++ b/byterun/lexing.c @@ -43,7 +43,7 @@ struct lexing_table { (*((unsigned char *)((tbl) + (n) * 2)) + \ (*((schar *)((tbl) + (n) * 2 + 1)) << 8)) #else -#define Short(tbl,n) (((short *)(tbl))[n]) +#define Short(tbl,n) (((short *)(tbl))[(n)]) #endif value lex_engine(struct lexing_table *tbl, value start_state, struct lexer_buffer *lexbuf) /* ML */ diff --git a/byterun/memory.h b/byterun/memory.h index e665c0bc2..f0167cb4c 100644 --- a/byterun/memory.h +++ b/byterun/memory.h @@ -41,20 +41,21 @@ color_t allocation_color (void *hp); /* void shrink_heap (char *); Only used in compact.c */ #ifdef DEBUG -#define DEBUG_clear(result, wosize) { \ - unsigned long __DEBUG_i; \ - for (__DEBUG_i = 0; __DEBUG_i < wosize; ++ __DEBUG_i){ \ - Field (result, __DEBUG_i) = Debug_uninit_minor; \ +#define DEBUG_clear(result, wosize) do{ \ + unsigned long caml__DEBUG_i; \ + for (caml__DEBUG_i = 0; caml__DEBUG_i < (wosize); ++ caml__DEBUG_i){ \ + Field ((result), caml__DEBUG_i) = Debug_uninit_minor; \ } \ -} +}while(0) #else #define DEBUG_clear(result, wosize) #endif -#define Alloc_small(result, wosize, tag) { CAMLassert (wosize >= 1); \ +#define Alloc_small(result, wosize, tag) do{ CAMLassert (wosize >= 1); \ CAMLassert ((tag_t) tag < 256); \ young_ptr -= Bhsize_wosize (wosize); \ if (young_ptr < young_limit){ \ + young_ptr += Bhsize_wosize (wosize); \ Setup_for_gc; \ minor_collection (); \ Restore_after_gc; \ @@ -62,15 +63,15 @@ color_t allocation_color (void *hp); } \ Hd_hp (young_ptr) = Make_header ((wosize), (tag), Caml_black); \ (result) = Val_hp (young_ptr); \ - DEBUG_clear (result, wosize); \ -} + DEBUG_clear ((result), (wosize)); \ +}while(0) /* You must use [Modify] to change a field of an existing shared block, unless you are sure the value being overwritten is not a shared block and the value being written is not a young block. */ /* [Modify] never calls the GC. */ -#define Modify(fp, val) { \ +#define Modify(fp, val) do{ \ value _old_ = *(fp); \ *(fp) = (val); \ if (Is_in_heap (fp)){ \ @@ -84,8 +85,7 @@ color_t allocation_color (void *hp); } \ } \ } \ -} \ - +}while(0) struct caml__roots_block { struct caml__roots_block *next; @@ -258,7 +258,11 @@ extern struct caml__roots_block *local_roots; /* defined in roots.c */ }while(0) /* convenience macro */ -#define Store_field(block, offset, val) modify (&Field (block, offset), val) +#define Store_field(block, offset, val) do{ \ + mlsize_t caml__temp_offset = (offset); \ + value caml__temp_val = (val); \ + modify (&Field ((block), caml__temp_offset), caml__temp_val); \ +}while(0) /* NOTE: [Begin_roots] and [End_roots] are superseded by [CAMLparam]*, diff --git a/byterun/minor_gc.c b/byterun/minor_gc.c index 9dcc79890..890522bee 100644 --- a/byterun/minor_gc.c +++ b/byterun/minor_gc.c @@ -130,6 +130,7 @@ void empty_minor_heap (void) gc_message (0x02, "<", 0); oldify_local_roots(); for (r = ref_table; r < ref_table_ptr; r++) oldify (**r, *r); + if (young_ptr < young_limit) young_ptr = young_limit; stat_minor_words += Wsize_bsize (young_end - young_ptr); young_ptr = young_end; ref_table_ptr = ref_table; diff --git a/byterun/mlvalues.h b/byterun/mlvalues.h index a2d1f006e..daef67348 100644 --- a/byterun/mlvalues.h +++ b/byterun/mlvalues.h @@ -67,7 +67,7 @@ typedef unsigned long mark_t; #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 Val_long +#define Val_int(x) Val_long(x) #define Int_val(x) ((int) Long_val(x)) /* Structure of the header: @@ -173,8 +173,8 @@ typedef opcode_t * code_t; /* Another special case: objects */ #define Object_tag 248 -#define Class_val(val) Field(val, 0) -#define Oid_val(val) Long_val(Field(val, 1)) +#define Class_val(val) Field((val), 0) +#define Oid_val(val) Long_val(Field((val), 1)) /* Another special case: variants */ extern value hash_variant(char * tag); @@ -212,8 +212,11 @@ void Store_double_val (value,double); /* Arrays of floating-point numbers. */ #define Double_array_tag 254 #define Double_field(v,i) Double_val((value)((double *)(v) + (i))) -#define Store_double_field(v,i,d) \ - Store_double_val((value)((double *)(v) + (i)),d) +#define Store_double_field(v,i,d) do{ \ + mlsize_t caml__temp_i = (i); \ + value caml__temp_d = (d); \ + Store_double_val((value)((double *) v + caml__temp_i), caml__temp_d); \ +}while(0) /* Custom blocks. They contain a pointer to a "method suite" of functions (for finalization, comparison, hashing, etc) @@ -221,7 +224,7 @@ void Store_double_val (value,double); the GC; therefore, they must not contain any [value]. See [custom.h] for operations on method suites. */ #define Custom_tag 255 -#define Data_custom_val(v) ((void *) &Field(v, 1)) +#define Data_custom_val(v) ((void *) &Field((v), 1)) struct custom_operations; /* defined in [custom.h] */ /* Int32.t, Int64.t and Nativeint.t are represented as custom blocks. */ @@ -237,7 +240,7 @@ extern int64 Int64_val(value v); /* 3- Atoms are 0-tuples. They are statically allocated once and for all. */ extern header_t atom_table[]; -#define Atom(tag) (Val_hp (&(atom_table [tag]))) +#define Atom(tag) (Val_hp (&(atom_table [(tag)]))) /* Is_atom tests whether a well-formed block is statically allocated outside the heap. For the bytecode system, only zero-sized block (Atoms) diff --git a/byterun/terminfo.c b/byterun/terminfo.c index 5e19233a6..2f648ad71 100644 --- a/byterun/terminfo.c +++ b/byterun/terminfo.c @@ -20,8 +20,8 @@ #include "io.h" #include "mlvalues.h" -#define Uninitialised Val_int(0) -#define Bad_term Val_int(1) +#define Uninitialised (Val_int(0)) +#define Bad_term (Val_int(1)) #define Good_term_tag 0 #if defined (HAS_TERMCAP) && !defined (NATIVE_CODE) diff --git a/byterun/weak.c b/byterun/weak.c index a9956ef1f..728818845 100644 --- a/byterun/weak.c +++ b/byterun/weak.c @@ -37,7 +37,7 @@ value weak_create (value len) /* ML */ return res; } -#define None_val Val_int(0) +#define None_val (Val_int(0)) #define Some_tag 0 value weak_set (value ar, value n, value el) /* ML */