ajout Weak.get_copy

Assert -> CAMLassert
suppression des conjonctions dans les Assert


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@3279 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

9 files changed, 62 insertions, 18 deletions

diff --git a/byterun/alloc.c b/byterun/alloc.c
index d0fc9d65c..9bb3575d1 100644
--- a/byterun/alloc.c
+++ b/byterun/alloc.c
@@ -52,7 +52,8 @@ value alloc_small (mlsize_t wosize, tag_t tag)
 {
   value result;
 
-  Assert (wosize > 0 && wosize <= Max_young_wosize);
+  Assert (wosize > 0)
+  Assert (wosize <= Max_young_wosize);
   Assert (tag < 256);
   Alloc_small (result, wosize, tag);
   return result;
diff --git a/byterun/debugger.c b/byterun/debugger.c
index 298642a67..8a41312a7 100644
--- a/byterun/debugger.c
+++ b/byterun/debugger.c
@@ -216,17 +216,20 @@ void debugger(enum event_kind event)
     switch(getch(dbg_in)) {
     case REQ_SET_EVENT:
       pos = getword(dbg_in);
-      Assert(pos >= 0 && pos < code_size);
+      Assert (pos >= 0);
+      Assert (pos < code_size);
       set_instruction(start_code + pos / sizeof(opcode_t), EVENT);
       break;
     case REQ_SET_BREAKPOINT:
       pos = getword(dbg_in);
-      Assert(pos >= 0 && pos < code_size);
+      Assert (pos >= 0);
+      Assert (pos < code_size);
       set_instruction(start_code + pos / sizeof(opcode_t), BREAK);
       break;
     case REQ_RESET_INSTR:
       pos = getword(dbg_in);
-      Assert(pos >= 0 && pos < code_size);
+      Assert (pos >= 0);
+      Assert (pos < code_size);
       pos = pos / sizeof(opcode_t);
       set_instruction(start_code + pos, saved_code[pos]);
       break;
diff --git a/byterun/finalise.c b/byterun/finalise.c
index e0c548226..c4e5147bf 100644
--- a/byterun/finalise.c
+++ b/byterun/finalise.c
@@ -45,7 +45,8 @@ void final_update (void)
   Assert (young == old);
   Assert (young <= active);
   for (i = 0; i < old; i++){
-    Assert (Is_block (final_table[i].val) && Is_in_heap (final_table[i].val));
+    Assert (Is_block (final_table[i].val));
+    Assert (Is_in_heap (final_table[i].val));
     if (Is_white_val (final_table[i].val)){
       struct final f = final_table[i];
       final_table[i] = final_table[--old];
@@ -147,7 +148,8 @@ value final_register (value f, value v)       /* ML */
     if (final_table == NULL){
       unsigned long new_size = 30;
       final_table = stat_alloc (new_size * sizeof (struct final));
-      Assert (old == 0 && young == 0);
+      Assert (old == 0);
+      Assert (young == 0);
       active = size = new_size;
     }else{
       unsigned long new_size = size * 2;
diff --git a/byterun/gc_ctrl.c b/byterun/gc_ctrl.c
index cdd2cc32a..570d2a289 100644
--- a/byterun/gc_ctrl.c
+++ b/byterun/gc_ctrl.c
@@ -47,7 +47,8 @@ extern unsigned long percent_max;     /*        see compact.c */
 /* Check that [v]'s header looks good.  [v] must be a block in the heap. */
 static void check_head (value v)
 {
-  Assert (Is_block (v) && Is_in_heap (v));
+  Assert (Is_block (v));
+  Assert (Is_in_heap (v));
 
   Assert (Wosize_val (v) != 0);
   Assert (Color_hd (Hd_val (v)) != Caml_blue);
@@ -83,7 +84,8 @@ static void check_block (char *hp)
     /* not true when check_urgent_gc is called by alloc or alloc_string:
        lastbyte = Bosize_val (v) - 1;
        i = Byte (v, lastbyte);
-       Assert (i >= 0 && i < sizeof (value));
+       Assert (i >= 0);
+       Assert (i < sizeof (value));
        Assert (Byte (v, lastbyte - i) == 0);
     */
     break;
diff --git a/byterun/intern.c b/byterun/intern.c
index 6c34111ee..bec0ed8be 100644
--- a/byterun/intern.c
+++ b/byterun/intern.c
@@ -181,7 +181,9 @@ static void intern_rec(value *dest)
       case CODE_SHARED8:
         ofs = read8u();
       read_shared:
-        Assert(ofs > 0 && ofs <= obj_counter && intern_obj_table != NULL); 
+        Assert (ofs > 0);
+        Assert (ofs <= obj_counter);
+        Assert (intern_obj_table != NULL); 
         v = intern_obj_table[obj_counter - ofs];
         break;
       case CODE_SHARED16:
diff --git a/byterun/interp.c b/byterun/interp.c
index 2ef623db7..f9eae04e0 100644
--- a/byterun/interp.c
+++ b/byterun/interp.c
@@ -737,7 +737,8 @@ value interprete(code_t prog, asize_t prog_size)
       uint32 sizes = *pc++;
       if (Is_block(accu)) {
         long index = Tag_val(accu);
-        Assert(index >= 0 && index < (sizes >> 16));
+        Assert (index >= 0);
+        Assert (index < (sizes >> 16));
         pc += pc[(sizes & 0xFFFF) + index];
       } else {
         long index = Long_val(accu);
diff --git a/byterun/misc.c b/byterun/misc.c
index 2957cd24a..e6fb432f2 100644
--- a/byterun/misc.c
+++ b/byterun/misc.c
@@ -21,7 +21,7 @@
 
 #ifdef DEBUG
 
-void failed_assert (char * expr, char * file, int line)
+void caml_failed_assert (char * expr, char * file, int line)
 {
   fprintf (stderr, "file %s; line %d ### Assertion failed: %s\n",
            file, line, expr);
@@ -148,7 +148,7 @@ char *aligned_malloc (asize_t size, int modulo, void **block)
 {
   char *raw_mem;
   unsigned long aligned_mem;
-                                                 Assert (modulo < Page_size);
+                                                  Assert (modulo < Page_size);
   raw_mem = (char *) malloc (size + Page_size);
   if (raw_mem == NULL) return NULL;
   *block = raw_mem;
diff --git a/byterun/misc.h b/byterun/misc.h
index 3212542a4..5666848cb 100644
--- a/byterun/misc.h
+++ b/byterun/misc.h
@@ -45,10 +45,10 @@ typedef char * addr;
 /* Assertions */
 
 #ifdef DEBUG
-#define Assert(x) if (!(x)) failed_assert ( #x , __FILE__, __LINE__)
-void failed_assert (char *, char *, int) Noreturn;
+#define CAMLassert(x) if (!(x)) caml_failed_assert ( #x , __FILE__, __LINE__)
+void caml_failed_assert (char *, char *, int) Noreturn;
 #else
-#define Assert(x)
+#define CAMLassert(x)
 #endif
 
 void fatal_error (char *) Noreturn;
@@ -96,4 +96,9 @@ char *aligned_malloc (asize_t, int, void **);
 #endif
 
 
+#ifndef CAML_AVOID_CONFLICTS
+#define Assert CAMLassert
+#endif
+
+
 #endif /* _misc_ */
diff --git a/byterun/weak.c b/byterun/weak.c
index a9d67b56c..c9657fb33 100644
--- a/byterun/weak.c
+++ b/byterun/weak.c
@@ -27,7 +27,7 @@ value weak_create (value len)        /* ML */
   value res;
 
   size = Long_val (len) + 1;
-  if (size > Max_wosize) invalid_argument ("Weak.create");
+  if (size <= 0 || size > Max_wosize) invalid_argument ("Weak.create");
   res = alloc_shr (size, Abstract_tag);
   for (i = 1; i < size; i++) Field (res, i) = 0;
   Field (res, 0) = weak_list_head;
@@ -44,7 +44,7 @@ value weak_set (value ar, value n, value el)     /* ML */
                                                    Assert (Is_in_heap (ar));
   if (offset < 1 || offset >= Wosize_val (ar)) invalid_argument ("Weak.set");
   Field (ar, offset) = 0;
-  if (el != None_val){                  Assert (Wosize_val (el) == 1);
+  if (el != None_val){                        Assert (Wosize_val (el) == 1);
     Modify (&Field (ar, offset), Field (el, 0));
   }
   return Val_unit;
@@ -74,10 +74,38 @@ value weak_get (value ar, value n)        /* ML */
 #undef Setup_for_gc
 #undef Restore_after_gc
 
+value weak_get_copy (value ar, value n)        /* ML */
+{
+  CAMLparam2 (ar, n);
+  mlsize_t offset = Long_val (n) + 1;
+  CAMLlocal2 (res, elt);
+  value v;  /* Caution: this is NOT a local root. */
+                                                   Assert (Is_in_heap (ar));
+  if (offset < 1 || offset >= Wosize_val (ar)) invalid_argument ("Weak.get");
+
+  v = Field (ar, offset);
+  if (v == 0) CAMLreturn (None_val);
+  elt = alloc (Wosize_val (v), Tag_val (v)); /* The GC may erase or move v. */
+  v = Field (ar, offset);
+  if (v == 0) CAMLreturn (None_val);
+  if (Tag_val (v) < No_scan_tag){
+    mlsize_t i;
+    for (i = 0; i < Wosize_val (v); i++){
+      Store_field (elt, i, Field (v, i));
+    }
+  }else{
+    memmove (Bp_val (elt), Bp_val (v), Bosize_val (v));
+  }
+  res = alloc_small (1, Some_tag);
+  Field (res, 0) = elt;
+
+  CAMLreturn (res);
+}
+
 value weak_check (value ar, value n)        /* ML */
 {
   mlsize_t offset = Long_val (n) + 1;
-                                                    Assert (Is_in_heap (ar));
+                                                   Assert (Is_in_heap (ar));
   if (offset < 1 || offset >= Wosize_val (ar)) invalid_argument ("Weak.get");
   return Val_bool (Field (ar, offset) != 0);
 }