[Guile-commits] GNU Guile branch, master, updated. release_1-9-8-37-g3ccee39

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=3ccee39194a2ae967eb12dd9c0adceeddb305646

The branch, master has been updated
       via  3ccee39194a2ae967eb12dd9c0adceeddb305646 (commit)
       via  29366989cf19c844c8d46e456da03466db534ddf (commit)
      from  9a1c6f1f0c6b07725a240160b79acc54303d7891 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 3ccee39194a2ae967eb12dd9c0adceeddb305646
Author: Andy Wingo <address@hidden>
Date:   Wed Feb 24 18:55:34 2010 +0100

    add %default-prompt-tag, and error (not abort()) on an abort to bad tag
    
    * libguile/init.c (scm_i_init_guile): Call scm_init_control after
      initing fluids.
    * libguile/control.h (scm_sys_default_prompt_tag): New internal var.
    * libguile/control.c (scm_c_abort): If abort is called for an unknown
      tag, raise an exception, except if the tag was the default prompt tag,
      in which case really abort -- to prevent recursion when some other
      patches land.
      (scm_init_control): Define %default-prompt-tag in the default
      environment.

commit 29366989cf19c844c8d46e456da03466db534ddf
Author: Andy Wingo <address@hidden>
Date:   Wed Feb 24 18:51:25 2010 +0100

    turn abort() calls in vm.c into exceptions
    
    * libguile/vm.c (vm_return_to_continuation, vm_abort):
      (vm_reinstate_partial_continuation, really_make_boot_program): Turn
      some abort()s into scm_misc_errors.

-----------------------------------------------------------------------

Summary of changes:
 libguile/control.c |   19 +++++++++++++++----
 libguile/control.h |    3 +++
 libguile/init.c    |    2 +-
 libguile/vm.c      |   22 ++++++++++++----------
 4 files changed, 31 insertions(+), 15 deletions(-)

diff --git a/libguile/control.c b/libguile/control.c
index 49a19cf..05a8dab 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -28,6 +28,9 @@
 
 
 
+SCM scm_sys_default_prompt_tag;
+
+
 SCM
 scm_c_make_prompt (SCM vm, SCM k, scm_t_uint8 escape_only_p,
                    scm_t_int64 vm_cookie)
@@ -193,9 +196,13 @@ scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv, 
scm_t_int64 cookie)
      any code that might throw up. */
   if (scm_is_false (prompt))
     {
-      /* FIXME: jump to default */
-      /* scm_handle_by_message (NULL, key, args); */
-      abort ();
+      if (scm_is_eq (tag, scm_fluid_ref (scm_sys_default_prompt_tag)))
+        {
+          fprintf (stderr, "No prompt found for abort to default prompt 
tag!\n");
+          abort ();
+        }
+      else
+        scm_misc_error ("abort", "abort to unknown tag", scm_list_1 (tag));
     }
 
   cont = reify_partial_continuation (vm, prompt, winds, cookie);
@@ -250,9 +257,13 @@ SCM_DEFINE (scm_at_abort, "@abort", 2, 0, 0, (SCM tag, SCM 
args),
 }
 #undef FUNC_NAME
 
-void scm_init_control (void)
+void
+scm_init_control (void)
 {
 #include "control.x"
+  scm_sys_default_prompt_tag = scm_make_fluid ();
+  scm_fluid_set_x (scm_sys_default_prompt_tag, scm_gensym (SCM_UNDEFINED));
+  scm_c_define ("%default-prompt-tag", scm_sys_default_prompt_tag);
 }
 
 /*
diff --git a/libguile/control.h b/libguile/control.h
index 160728d..146e216 100644
--- a/libguile/control.h
+++ b/libguile/control.h
@@ -42,6 +42,9 @@ struct scm_prompt_registers
 };
 
 
+SCM_INTERNAL SCM scm_sys_default_prompt_tag;
+
+
 SCM_INTERNAL SCM scm_c_make_prompt (SCM vm, SCM k, scm_t_uint8 escape_only_p,
                                     scm_t_int64 cookie);
 SCM_INTERNAL SCM scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv,
diff --git a/libguile/init.c b/libguile/init.c
index e72b946..9879cb3 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -470,7 +470,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_async ();              /* requires smob_prehistory */
   scm_init_boolean ();
   scm_init_chars ();
-  scm_init_control ();
 #ifdef GUILE_DEBUG_MALLOC
   scm_init_debug_malloc ();
 #endif
@@ -478,6 +477,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_eq ();
   scm_init_error ();
   scm_init_fluids ();
+  scm_init_control ();            /* requires fluids */
   scm_init_feature ();
   scm_init_backtrace ();
   scm_init_fports ();
diff --git a/libguile/vm.c b/libguile/vm.c
index 6fecd60..eb11cd0 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -138,10 +138,9 @@ vm_return_to_continuation (SCM vm, SCM cont, size_t n, SCM 
*argv)
                     SCM_EOL);
 
   if (vp->stack_size < cp->stack_size + n + 1)
-    {
-      /* puts ("FIXME: Need to expand"); */
-      abort ();
-    }
+    scm_misc_error ("vm-engine", "not enough space to reinstate continuation",
+                    scm_list_2 (vm, cont));
+
 #ifdef VM_ENABLE_STACK_NULLING
   {
     scm_t_ptrdiff nzero = (vp->sp - cp->sp);
@@ -215,7 +214,9 @@ vm_abort (SCM vm, size_t n, scm_t_int64 vm_cookie)
   /* NULLSTACK (1) */
   tail_len = scm_ilength (tail);
   if (tail_len < 0)
-    abort ();
+    scm_misc_error ("vm-engine", "tail values to abort should be a list",
+                    scm_list_1 (tail));
+
   tag = SCM_VM_DATA (vm)->sp[-n];
   argv = alloca ((n + tail_len) * sizeof (SCM));
   for (i = 0; i < n; i++)
@@ -247,10 +248,9 @@ vm_reinstate_partial_continuation (SCM vm, SCM cont, SCM 
intwinds,
 #define RELOC(scm_p) (scm_p + cp->reloc + (base - cp->stack_base))
 
   if ((base - vp->stack_base) + cp->stack_size + n + 1 > vp->stack_size)
-    {
-      /* puts ("FIXME: Need to expand"); */
-      abort ();
-    }
+    scm_misc_error ("vm-engine",
+                    "not enough space to instate partial continuation",
+                    scm_list_2 (vm, cont));
 
   memcpy (base, cp->stack_base, cp->stack_size * sizeof (SCM));
 
@@ -316,7 +316,9 @@ really_make_boot_program (long nargs)
   SCM ret;
 
   if (SCM_UNLIKELY (nargs > 255 || nargs < 0))
-    abort ();
+    scm_misc_error ("vm-engine", "too many args when making boot procedure",
+                    scm_list_1 (scm_from_long (nargs)));
+
   text[1] = (scm_t_uint8)nargs;
 
   bp = scm_malloc (sizeof (struct scm_objcode) + sizeof (text));


hooks/post-receive
-- 
GNU Guile