From 48eaa975f21903deeb154385bb543bd8622a6238 Mon Sep 17 00:00:00 2001
From: Vitor Santos Costa <vsc@dcc.fc.up.pt>
Date: Fri, 27 Feb 2009 00:31:29 +0000
Subject: [PATCH] if we have many embedded calls to nb_queue, make sure we
 don't allocate a lot of memory for each one.

---
 C/globals.c | 9 +++++++++
 C/heapgc.c  | 6 +++---
 C/init.c    | 2 ++
 C/tracer.c  | 3 ---
 H/Heap.h    | 4 ++++
 5 files changed, 18 insertions(+), 6 deletions(-)

diff --git a/C/globals.c b/C/globals.c
index 4c96da844..6b5db145f 100644
--- a/C/globals.c
+++ b/C/globals.c
@@ -24,6 +24,7 @@ static char SccsId[] = "%W% %G%";
 #include "yapio.h"
 #include "iopreds.h"
 #include "attvar.h"
+#include <math.h>
 
 /* Non-backtrackable terms will from now on be stored on arenas, a
    special term on the heap. Arenas automatically contract as we add terms to
@@ -44,6 +45,7 @@ static char SccsId[] = "%W% %G%";
 #define HEAP_START 4
 
 #define MIN_ARENA_SIZE 2048
+#define MAX_ARENA_SIZE (2048*16)
 
 #define Global_MkIntegerTerm(I) MkIntegerTerm(I)
 
@@ -265,6 +267,7 @@ adjust_cps(UInt size)
 static int
 GrowArena(Term arena, CELL *pt, UInt old_size, UInt size, UInt arity)
 {
+  ArenaOverflows++;
   if (size == 0) {
     if (old_size < 1024*1024) {
       size = old_size;
@@ -1423,8 +1426,13 @@ p_nb_queue(void)
 #endif
   Term t = Deref(ARG1);
   UInt arena_sz = (ASP-H)/16;
+  DepthArenas++;
+  if (DepthArenas > 1)
+    arena_sz /= log(MIN_ARENA_SIZE);
   if (arena_sz < MIN_ARENA_SIZE)
     arena_sz = MIN_ARENA_SIZE;
+  if (arena_sz > MAX_ARENA_SIZE)
+    arena_sz = MAX_ARENA_SIZE;
 
   if (!IsVarTerm(t)) {
     if (!IsApplTerm(t)) {
@@ -1539,6 +1547,7 @@ p_nb_queue_close(void)
   Term t = Deref(ARG1);
   Int out;
 
+  DepthArenas--;
   if (!IsVarTerm(t)) {
     CELL *qp;
 
diff --git a/C/heapgc.c b/C/heapgc.c
index 3edc00bc4..281046a5d 100644
--- a/C/heapgc.c
+++ b/C/heapgc.c
@@ -3907,8 +3907,6 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
   }
   if (gc_margin < gc_lim)
     gc_margin = gc_lim;
-  if (gc_margin < CalculateStackGap())
-    gc_margin = CalculateStackGap();
   GcCalls++;
   HGEN = VarOfTerm(Yap_ReadTimedVar(GcGeneration));
   if (gc_on && !(Yap_PrologMode & InErrorMode) &&
@@ -3929,7 +3927,9 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop)
   if (ASP - H < gc_margin/sizeof(CELL) ||
       effectiveness < 20) {
     LeaveGCMode();
-    return Yap_growstack(gc_margin);
+    if (gc_margin < 2*CalculateStackGap())
+      gc_margin = 2*CalculateStackGap();
+    return Yap_growstack(gc_margin*sizeof(CELL));
   }
   /*
    * debug for(save_total=1; save_total<=N; ++save_total)
diff --git a/C/init.c b/C/init.c
index 4543ba136..86d9ee51b 100644
--- a/C/init.c
+++ b/C/init.c
@@ -1416,6 +1416,8 @@ Yap_InitWorkspace(int Heap, int Stack, int Trail, int max_table_size,
   ActiveSignals = 0;
   DoingUndefp = FALSE;
   DelayArenaOverflows = 0;
+  ArenaOverflows = 0;
+  DepthArenas = 0;
   DBErasedList = NULL;
   DBErasedIList = NULL;
   Yap_heap_regs->IntLUKeys = NULL;
diff --git a/C/tracer.c b/C/tracer.c
index 886d86797..0ee421545 100644
--- a/C/tracer.c
+++ b/C/tracer.c
@@ -172,9 +172,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
   LOCK(Yap_heap_regs->low_level_trace_lock);
   sc = Yap_heap_regs;
   vsc_count++;
-  if (vsc_count == 231868LL)
-    jmp_deb(1);
-  return;
 #ifdef THREADS
   Yap_heap_regs->thread_handle[worker_id].thread_inst_count++;
 #endif  
diff --git a/H/Heap.h b/H/Heap.h
index 0e088faec..ab204a4c2 100644
--- a/H/Heap.h
+++ b/H/Heap.h
@@ -106,6 +106,8 @@ extern struct restore_info rinfo;
 typedef struct worker_local_struct {
   struct format_status *f_info;
   Int delay_arena_overflows;
+  Int arena_overflows;
+  Int depth_arenas;
   char *scanner_stack;
   struct scanner_extra_alloc *scanner_extra_blocks;
 #if defined(YAPOR) || defined(THREADS)
@@ -690,6 +692,8 @@ extern struct various_codes *Yap_heap_regs;
 #define  DebugOn                  Yap_heap_regs->WL.debug_on
 #define  FormatInfo               Yap_heap_regs->WL.f_info
 #define  DelayArenaOverflows      Yap_heap_regs->WL.delay_arena_overflows
+#define  ArenaOverflows		  Yap_heap_regs->WL.arena_overflows
+#define  DepthArenas		  Yap_heap_regs->WL.depth_arenas
 #define  ScannerStack             Yap_heap_regs->WL.scanner_stack
 #define  ScannerExtraBlocks       Yap_heap_regs->WL.scanner_extra_blocks
 #define  Yap_BigTmp               Yap_heap_regs->WL.big_tmp