From 3e8dc5cd19466157a901792a22ce0eef1fbabc3a Mon Sep 17 00:00:00 2001
From: Vitor Santos Costa <vsc@dcc.fc.up.pt>
Date: Thu, 29 Apr 2010 10:29:06 +0100
Subject: [PATCH] try to handle overflows in stack dumpers.

---
 C/cdmgr.c   | 58 +++++++++++++++++++++++++++++++++++++++++++----------
 C/errors.c  | 15 +++++++++++---
 C/sysbits.c |  6 +++++-
 3 files changed, 64 insertions(+), 15 deletions(-)

diff --git a/C/cdmgr.c b/C/cdmgr.c
index 9fdb8d55a..a7505cfd2 100644
--- a/C/cdmgr.c
+++ b/C/cdmgr.c
@@ -3461,17 +3461,23 @@ static Term
 all_envs(CELL *env_ptr)
 {
   Term tf = AbsPair(H);
+  CELL *start = H;
   CELL *bp = NULL;
   
   /* walk the environment chain */
-  while (env_ptr != NULL) {
+  while (env_ptr) {
     bp = H;
     H += 2;
     /* notice that MkIntegerTerm may increase the Heap */
     bp[0] = MkIntegerTerm(LCL0-env_ptr);
-    if (H >= ASP) {
-      bp[1] = TermNil;
-      return tf;
+    if (H >= ASP-1024) {
+      H = start;
+      Yap_Error_Size = (ASP-1024)-H;
+      while (env_ptr) {
+	Yap_Error_Size += 2;
+	env_ptr = (CELL *)(env_ptr[E_E]);      
+      }
+      return 0L;
     } else {
       bp[1] = AbsPair(H);
     }
@@ -3485,16 +3491,22 @@ static Term
 all_cps(choiceptr b_ptr)
 {
   CELL *bp = NULL;
+  CELL *start = H;
   Term tf = AbsPair(H);
 
-  while (b_ptr != NULL) {
+  while (b_ptr) {
     bp = H;
     H += 2;
     /* notice that MkIntegerTerm may increase the Heap */
     bp[0] = MkIntegerTerm((Int)(LCL0-(CELL *)b_ptr));
-    if (H >= ASP) {
-      bp[1] = TermNil;
-      return tf;
+    if (H >= ASP-1024) {
+      H = start;
+      Yap_Error_Size = (ASP-1024)-H;
+      while (b_ptr) {
+	Yap_Error_Size += 2;
+	b_ptr = b_ptr->cp_b;
+      }
+      return 0L;
     } else {
       bp[1] = AbsPair(H);
     }
@@ -3516,6 +3528,9 @@ all_calls(void)
   if (yap_flags[STACK_DUMP_ON_ERROR_FLAG]) {
     ts[2] = all_envs(ENV);
     ts[3] = all_cps(B);
+    if (ts[2] == 0L ||
+	ts[3] == 0L)
+      return 0L;
   } else {
     ts[2] = ts[3] = TermNil;
   }
@@ -3531,13 +3546,27 @@ Yap_all_calls(void)
 static Int
 p_all_choicepoints(void)
 {
-  return Yap_unify(ARG1,all_cps(B));
+  Term t;
+  while ((t = all_cps(B)) == 0L) {
+    if (!Yap_gcl(Yap_Error_Size, 1, ENV, gc_P(P,CP))) {
+      Yap_Error(OUT_OF_STACK_ERROR, TermNil, "while dumping choicepoints");
+      return FALSE;
+    }
+  }
+  return Yap_unify(ARG1,t);
 }
 
 static Int
 p_all_envs(void)
 {
-  return Yap_unify(ARG1,all_envs(ENV));
+  Term t;
+  while ((t = all_envs(ENV)) == 0L) {
+    if (!Yap_gcl(Yap_Error_Size, 1, ENV, gc_P(P,CP))) {
+      Yap_Error(OUT_OF_STACK_ERROR, TermNil, "while dumping environments");
+      return FALSE;
+    }
+  }
+  return Yap_unify(ARG1,t);
 }
 
 static Int
@@ -3546,7 +3575,14 @@ p_current_stack(void)
 #ifdef YAPOR
   return(FALSE);
 #else
-  return(Yap_unify(ARG1,all_calls()));
+  Term t;
+  while ((t = all_calls()) == 0L) {
+    if (!Yap_gcl(Yap_Error_Size, 1, ENV, gc_P(P,CP))) {
+      Yap_Error(OUT_OF_STACK_ERROR, TermNil, "while dumping stack");
+      return FALSE;
+    }
+  }
+  return Yap_unify(ARG1,t);
 #endif
 }
 
diff --git a/C/errors.c b/C/errors.c
index 16ff4954f..f5cfe1688 100644
--- a/C/errors.c
+++ b/C/errors.c
@@ -1819,7 +1819,15 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
     nt[1] = MkAtomTerm(Yap_LookupAtom(tmpbuf));
     break;
   default:
-    nt[1] = MkPairTerm(MkAtomTerm(Yap_LookupAtom(tmpbuf)), Yap_all_calls());
+    {
+      Term stack_dump;
+
+      if ((stack_dump = Yap_all_calls()) == 0L) {
+	stack_dump = TermNil;
+	Yap_Error_Size = 0L;
+      }
+      nt[1] = MkPairTerm(MkAtomTerm(Yap_LookupAtom(tmpbuf)), stack_dump);
+    }
   }
   if (serious) {
     /* disable active signals at this point */
@@ -1838,9 +1846,10 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
       siglongjmp(Yap_RestartEnv,1);      
     }
     UNLOCK(SignalLock);
-    if (type == PURE_ABORT)
+    if (type == PURE_ABORT) {
       Yap_JumpToEnv(MkAtomTerm(AtomDAbort));
-    else
+      CreepFlag = LCL0-ASP;
+    } else
       Yap_JumpToEnv(Yap_MkApplTerm(fun, 2, nt));
     P = (yamop *)FAILCODE;
   } else {
diff --git a/C/sysbits.c b/C/sysbits.c
index a13c3f341..2e0905d3a 100755
--- a/C/sysbits.c
+++ b/C/sysbits.c
@@ -1437,6 +1437,10 @@ InteractSIGINT(int ch) {
     /* exit */
     Yap_exit(0);
     return -1;
+  case 'g':
+    /* exit */
+    Yap_signal (YAP_STACK_DUMP_SIGNAL);
+    return -1;
   case 't':
     /* start tracing */
     Yap_signal (YAP_TRACE_SIGNAL);
@@ -1459,7 +1463,7 @@ InteractSIGINT(int ch) {
     /* show an helpful message */
     fprintf(Yap_stderr, "Please press one of:\n");
     fprintf(Yap_stderr, "  a for abort\n  c for continue\n  d for debug\n");
-    fprintf(Yap_stderr, "  e for exit\n  s for statistics\n  t for trace\n");
+    fprintf(Yap_stderr, "  e for exit\n  g for stack dump\n  s for statistics\n  t for trace\n");
     fprintf(Yap_stderr, "  b for break\n");
     return(0);
   }