GPR#156: Optimize reallocation of caml_frame_descriptors

(Pierre Chambart)

It now reallocates and reinitialises the whole table only when it is
too small. This avoids quadratic behavior when loading a lot of module
with dynlink.

This was problematic on frama-c when inlining increase the code
size. The frame table initialisation took ~0.5 second. This is quite
noticeable on real examples where the whole frama-c analysis is ~1.5s
long.

Also allows to unregister a frametable.

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

Changes

@@ -174,6 +174,8 @@ Features wishes:
   (Vladimir Brankov, review by Gabriel Scherer)
 - GPR#147: [type 'a result = Ok of 'a | Error of 'b] in Pervasives
   (Yaron Minsky)
+- GPR#156: Optimize reallocation of caml_frame_descriptors (dynlink speedup)
+  (Pierre Chambart, review by François Bobot, Xavier Leroy and Damien Doligez)
 - GPR#171: allow custom warning printers / catchers
   (Benjamin Canou, review by Damien Doligez)
 - GPR#191: Making gc.h and some part of memory.h public

asmrun/backtrace.c

@@ -75,8 +75,6 @@ frame_descr * caml_next_frame_descriptor(uintnat * pc, char ** sp)
   frame_descr * d;
   uintnat h;
 
-  if (caml_frame_descriptors == NULL) caml_init_frame_descriptors();
-
   while (1) {
     h = Hash_retaddr(*pc);
     while (1) {

asmrun/roots.c

@@ -32,9 +32,8 @@ struct caml__roots_block *caml_local_roots = NULL;
 void (*caml_scan_roots_hook) (scanning_action) = NULL;
 
 /* The hashtable of frame descriptors */
-
 frame_descr ** caml_frame_descriptors = NULL;
-int caml_frame_descriptors_mask;
+int caml_frame_descriptors_mask = 0;
 
 /* Linked-list */
 
@@ -56,52 +55,43 @@ static link *cons(void *data, link *tl) {
 /* Linked-list of frametables */
 
 static link *frametables = NULL;
+static intnat num_descr = 0;
 
-void caml_register_frametable(intnat *table) {
-  frametables = cons(table,frametables);
-
-  if (NULL != caml_frame_descriptors) {
-    caml_stat_free(caml_frame_descriptors);
-    caml_frame_descriptors = NULL;
-    /* force caml_init_frame_descriptors to be called */
-  }
-}
-
-void caml_init_frame_descriptors(void)
-{
-  intnat num_descr, tblsize, i, j, len;
-  intnat * tbl;
-  frame_descr * d;
-  uintnat nextd;
-  uintnat h;
+static int count_descriptors(link *list) {
+  intnat num_descr = 0;
   link *lnk;
-
-  static int inited = 0;
-
-  if (!inited) {
-    for (i = 0; caml_frametable[i] != 0; i++)
-      caml_register_frametable(caml_frametable[i]);
-    inited = 1;
-  }
-
-  /* Count the frame descriptors */
-  num_descr = 0;
-  iter_list(frametables,lnk) {
+  iter_list(list,lnk) {
     num_descr += *((intnat*) lnk->data);
   }
+  return num_descr;
+}
 
-  /* The size of the hashtable is a power of 2 greater or equal to
-     2 times the number of descriptors */
-  tblsize = 4;
-  while (tblsize < 2 * num_descr) tblsize *= 2;
+static link* frametables_list_tail(link *list) {
+  link *lnk, *tail = NULL;
+  iter_list(list,lnk) {
+    tail = lnk;
+  }
+  return tail;
+}
 
-  /* Allocate the hash table */
-  caml_frame_descriptors =
-    (frame_descr **) caml_stat_alloc(tblsize * sizeof(frame_descr *));
-  for (i = 0; i < tblsize; i++) caml_frame_descriptors[i] = NULL;
-  caml_frame_descriptors_mask = tblsize - 1;
+static frame_descr * next_frame_descr(frame_descr * d) {
+  uintnat nextd;
+  nextd =
+    ((uintnat)d +
+     sizeof(char *) + sizeof(short) + sizeof(short) +
+     sizeof(short) * d->num_live + sizeof(frame_descr *) - 1)
+    & -sizeof(frame_descr *);
+  if (d->frame_size & 1) nextd += 8;
+  return((frame_descr *) nextd);
+}
+
+static void fill_hashtable(link *frametables) {
+  intnat len, j;
+  intnat * tbl;
+  frame_descr * d;
+  uintnat h;
+  link *lnk = NULL;
 
-  /* Fill the hash table */
   iter_list(frametables,lnk) {
     tbl = (intnat*) lnk->data;
     len = *tbl;
@@ -112,17 +102,115 @@ void caml_init_frame_descriptors(void)
         h = (h+1) & caml_frame_descriptors_mask;
       }
       caml_frame_descriptors[h] = d;
-      nextd =
-        ((uintnat)d +
-         sizeof(char *) + sizeof(short) + sizeof(short) +
-         sizeof(short) * d->num_live + sizeof(frame_descr *) - 1)
-        & -sizeof(frame_descr *);
-      if (d->frame_size & 1) nextd += 8;
-      d = (frame_descr *) nextd;
+      d = next_frame_descr(d);
     }
   }
 }
 
+static void init_frame_descriptors(link *new_frametables)
+{
+  intnat tblsize, increase, i;
+  link *tail = NULL;
+
+  Assert(new_frametables);
+
+  tail = frametables_list_tail(new_frametables);
+  increase = count_descriptors(new_frametables);
+  tblsize = caml_frame_descriptors_mask + 1;
+
+  /* Reallocate the caml_frame_descriptor table if it is too small */
+  if(tblsize < (num_descr + increase) * 2) {
+
+    /* Merge both lists */
+    tail->next = frametables;
+    frametables = NULL;
+
+    /* [num_descr] can be less than [num_descr + increase] if frame
+       tables where unregistered */
+    num_descr = count_descriptors(new_frametables);
+
+    tblsize = 4;
+    while (tblsize < 2 * num_descr) tblsize *= 2;
+
+    caml_frame_descriptors_mask = tblsize - 1;
+    if(caml_frame_descriptors) caml_stat_free(caml_frame_descriptors);
+    caml_frame_descriptors =
+      (frame_descr **) caml_stat_alloc(tblsize * sizeof(frame_descr *));
+    for (i = 0; i < tblsize; i++) caml_frame_descriptors[i] = NULL;
+  } else {
+    num_descr += increase;
+  }
+
+  fill_hashtable(new_frametables);
+  tail->next = frametables;
+}
+
+void caml_init_frame_descriptors(void) {
+  intnat i;
+  link *new_frametables = NULL;
+  for (i = 0; caml_frametable[i] != 0; i++)
+    new_frametables = cons(caml_frametable[i],new_frametables);
+  init_frame_descriptors(new_frametables);
+}
+
+void caml_register_frametable(intnat *table) {
+  link *new_frametables = cons(table,NULL);
+  init_frame_descriptors(new_frametables);
+}
+
+static void remove_entry(frame_descr * d) {
+  uintnat i;
+  uintnat r;
+  uintnat j;
+
+  i = Hash_retaddr(d->retaddr);
+  while (caml_frame_descriptors[i] != d) {
+    i = (i+1) & caml_frame_descriptors_mask;
+  }
+
+ r1:
+  j = i;
+  caml_frame_descriptors[i] = NULL;
+ r2:
+  i = (i+1) & caml_frame_descriptors_mask;
+  // r3
+  if(caml_frame_descriptors[i] == NULL) return;
+  r = Hash_retaddr(caml_frame_descriptors[i]->retaddr);
+  /* If r is between i and j (cyclically), i.e. if
+     caml_frame_descriptors[i]->retaddr don't need to be moved */
+  if(( ( j < r )  && ( r <= i ) ) ||
+     ( ( i < j )  && ( j < r )  ) ||      /* i cycled, r not */
+     ( ( r <= i ) && ( i < j ) )     ) {  /* i and r cycled */
+    goto r2;
+  }
+  // r4
+  caml_frame_descriptors[j] = caml_frame_descriptors[i];
+  goto r1;
+}
+
+void caml_unregister_frametable(intnat *table) {
+  intnat len, j;
+  link *lnk;
+  link *previous = frametables;
+  frame_descr * d;
+
+  len = *table;
+  d = (frame_descr *)(table + 1);
+  for (j = 0; j < len; j++) {
+    remove_entry(d);
+    d = next_frame_descr(d);
+  }
+
+  iter_list(frametables,lnk) {
+    if(lnk->data == table) {
+      previous->next = lnk->next;
+      caml_stat_free(lnk);
+      break;
+    }
+    previous = lnk;
+  }
+}
+
 /* Communication with [caml_start_program] and [caml_call_gc]. */
 
 char * caml_top_of_stack;
@@ -177,7 +265,6 @@ void caml_oldify_local_roots (void)
   }
 
   /* The stack and local roots */
-  if (caml_frame_descriptors == NULL) caml_init_frame_descriptors();
   sp = caml_bottom_of_stack;
   retaddr = caml_last_return_address;
   regs = caml_gc_regs;
@@ -272,7 +359,6 @@ void caml_do_roots (scanning_action f)
   }
 
   /* The stack and local roots */
-  if (caml_frame_descriptors == NULL) caml_init_frame_descriptors();
   caml_do_local_roots(f, caml_bottom_of_stack, caml_last_return_address,
                       caml_gc_regs, caml_local_roots);
   /* Global C roots */

asmrun/stack.h

@@ -97,6 +97,7 @@ extern int caml_frame_descriptors_mask;
 
 extern void caml_init_frame_descriptors(void);
 extern void caml_register_frametable(intnat *);
+extern void caml_unregister_frametable(intnat *);
 extern void caml_register_dyn_global(void *);
 
 CAMLextern void extract_location_info(frame_descr * d,

asmrun/startup.c

@@ -101,6 +101,7 @@ void caml_main(char **argv)
   value res;
   char tos;
 
+  caml_init_frame_descriptors();
   caml_init_ieee_floats();
 #ifdef _MSC_VER
   caml_install_invalid_parameter_handler();