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

bug de Gc.counters + blindage des macros 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@3635 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Damien Doligez 2001-08-13 13:53:51 +00:00
parent 13b6fa0a4a
commit 5f4fd94902
14 changed files with 97 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
asmrun/signals.c
View File

@ -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

54
asmrun/stack.h
View File

@ -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 */

2
byterun/compare.c
View File

@ -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];

8
byterun/debugger.c
View File

@ -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)
{

2
byterun/finalise.c
View File

@ -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.

42
byterun/gc_ctrl.c
View File

@ -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);
}

2
byterun/intern.c
View File

@ -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)
{

7
byterun/io.h
View File

@ -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 \

2
byterun/lexing.c
View File

@ -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 */

28
byterun/memory.h
View File

@ -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]*,

1
byterun/minor_gc.c
View File

@ -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;

17
byterun/mlvalues.h
View File

@ -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)

4
byterun/terminfo.c
View File

@ -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)

2
byterun/weak.c
View File

@ -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 */