* throw.h, throw.c: Use SCM_P instead of #if hair.

Remove special support for uncaught throws; see throw.c for
rationale.
* throw.c (unhandled_throw): New function.
(scm_ithrow): Call unhandled_throw if we don't find a throw
target; don't mess with scm_bad_throw_vcell.
(scm_bad_throw_vcell): Variable deleted.
(scm_init_throw): Don't initialize it.

* throw.c (scm_ithrow): Don't let outer key matches shadow inner
#t catches.

diff --git a/libguile/throw.c b/libguile/throw.c
index 41aff91..4bbbaaa 100644 (file)
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -53,15 +53,12 @@
 #include "continuations.h"
 
 #include "throw.h"
-\f
-
 
+\f
 /* {Catch and Throw} 
  */
 static int scm_tc16_jmpbuffer;
 
-SCM scm_bad_throw_vcell;
-
 #define SCM_JMPBUFP(O) (SCM_TYP16(O) == scm_tc16_jmpbuffer)
 #define JBACTIVE(O) (SCM_CAR (O) & (1L << 16L))
 #define ACTIVATEJB(O)  (SCM_CAR (O) |= (1L << 16L))
@@ -76,30 +73,23 @@ SCM scm_bad_throw_vcell;
 #define SCM_SETJBDFRAME(O,X) SCM_CAR(SCM_CDR (O)) = (SCM)(X)
 #define SETJBJMPBUF(O,X) SCM_SETCDR(SCM_CDR (O), X)
 
-#ifdef __STDC__
-static scm_sizet
-freejb (SCM jbsmob)
-#else
+static scm_sizet freejb SCM_P ((SCM jbsmob));
+
 static scm_sizet
 freejb (jbsmob)
      SCM jbsmob;
-#endif
 {
   scm_must_free ((char *) SCM_CDR (jbsmob));
   return sizeof (scm_cell);
 }
 #endif
 
-#ifdef __STDC__
-static int
-printjb (SCM exp, SCM port, scm_print_state *pstate)
-#else
+static int printjb SCM_P ((SCM exp, SCM port, scm_print_state *pstate));
 static int
 printjb (exp, port, pstate)
      SCM exp;
      SCM port;
      scm_print_state *pstate;
-#endif
 {
   scm_gen_puts (scm_regular_string, "#<jmpbuffer ", port);
   scm_gen_puts (scm_regular_string, JBACTIVE(exp) ? "(active) " : "(inactive) ", port);
@@ -119,13 +109,9 @@ static scm_smobfuns jbsmob = {
   0
 };
 
-#ifdef __STDC__
-static SCM
-make_jmpbuf (void)
-#else
+static SCM make_jmpbuf SCM_P ((void));
 static SCM
 make_jmpbuf ()
-#endif
 {
   SCM answer;
   SCM_NEWCELL (answer);
@@ -152,16 +138,11 @@ struct jmp_buf_and_retval /* use only on the stack, in scm_catch */
 };
 
 SCM_PROC(s_catch, "catch", 3, 0, 0, scm_catch);
-#ifdef __STDC__
-SCM
-scm_catch (SCM tag, SCM thunk, SCM handler)
-#else
 SCM
 scm_catch (tag, thunk, handler)
      SCM tag;
      SCM thunk;
      SCM handler;
-#endif
 {
   struct jmp_buf_and_retval jbr;
   SCM jmpbuf;
@@ -206,17 +187,37 @@ scm_catch (tag, thunk, handler)
 }
 
 
+/* The user has thrown to an uncaught key --- print a message and die. 
+   1) If the user wants something different, they can use (catch #t
+   ...) to do what they like.
+   2) Outside the context of a read-eval-print loop, there isn't
+   anything else good to do; libguile should not assume the existence
+   of a read-eval-print loop.
+   3) Given that we shouldn't do anything complex, it's much more
+   robust to do it in C code.  */
+static SCM unhandled_throw SCM_P ((SCM key, SCM args));
+static SCM
+unhandled_throw (key, args)
+     SCM key;
+     SCM args;
+{
+  SCM p = scm_def_errp; 
+  scm_gen_puts (scm_regular_string, "guile: uncaught throw to ", p);
+  scm_prin1 (key, p, 0);
+  scm_gen_puts (scm_regular_string, ": ", p);
+  scm_prin1 (args, p, 1);
+  scm_gen_putc ('\n', p);
+  
+  exit (2);
+}
+
+
 static char s_throw[];
-#ifdef __STDC__
-SCM
-scm_ithrow (SCM key, SCM args, int noreturn)
-#else
 SCM
 scm_ithrow (key, args, noreturn)
      SCM key;
      SCM args;
      int noreturn;
-#endif
 {
   SCM jmpbuf;
   SCM wind_goal;
@@ -236,27 +237,35 @@ scm_ithrow (key, args, noreturn)
   else
     {
       SCM dynpair;
-      SCM hook;
+      SCM winds;
 
       if (noreturn)
        {
-         SCM_ASSERT (SCM_NIMP (key) && SCM_SYMBOLP (key), key, SCM_ARG1, s_throw);
+         SCM_ASSERT (SCM_NIMP (key) && SCM_SYMBOLP (key), key, SCM_ARG1,
+                     s_throw);
        }
       else if (!(SCM_NIMP (key) && SCM_SYMBOLP (key)))
        return SCM_UNSPECIFIED;
 
-      dynpair = scm_sloppy_assq (key, scm_dynwinds);
-
-      if (dynpair == SCM_BOOL_F)
-       dynpair = scm_sloppy_assq (SCM_BOOL_T, scm_dynwinds);
-
-      hook = SCM_CDR (scm_bad_throw_vcell);
-      if ((dynpair == SCM_BOOL_F)
-         && (SCM_BOOL_T == scm_procedure_p (hook)))
+      /* Search the wind list for an appropriate catch.
+        "Waiter, please bring us the wind list." */
+      for (winds = scm_dynwinds;
+          SCM_NIMP (winds) && SCM_CONSP (winds);
+          winds = SCM_CDR (winds))
        {
-         SCM answer;
-         answer = scm_apply (hook, scm_cons (key, args), SCM_EOL);
+         dynpair = SCM_CAR (winds);
+         if (SCM_NIMP (winds) && SCM_CONSP (winds))
+           {
+             SCM this_key = SCM_CAR (dynpair);
+
+             if (this_key == SCM_BOOL_T || this_key == key)
+               break;
+           }
        }
+
+      /* If we didn't find anything, print a message and exit Guile.  */
+      if (SCM_IMP (winds) || SCM_NCONSP (winds))
+       unhandled_throw (key, args);
       
       if (dynpair != SCM_BOOL_F)
        jmpbuf = SCM_CDR (dynpair);
@@ -294,31 +303,19 @@ scm_ithrow (key, args, noreturn)
 
 
 SCM_PROC(s_throw, "throw", 1, 0, 1, scm_throw);
-#ifdef __STDC__
-SCM
-scm_throw (SCM key, SCM args)
-#else
 SCM
 scm_throw (key, args)
      SCM key;
      SCM args;
-#endif
 {
   scm_ithrow (key, args, 1);
   return SCM_BOOL_F;  /* never really returns */
 }
 
 
-#ifdef __STDC__
-void
-scm_init_throw (void)
-#else
 void
 scm_init_throw ()
-#endif
 {
   scm_tc16_jmpbuffer = scm_newsmob (&jbsmob);
-  scm_bad_throw_vcell = scm_sysintern ("%%bad-throw", SCM_BOOL_F);
 #include "throw.x"
 }
-