* variable.c, threads.c, struct.c, stackchk.c, smob.c, root.c,

[bpt/guile.git] / libguile / throw.c

diff --git a/libguile/throw.c b/libguile/throw.c
index c40000b..b5bbbae 100644 (file)
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -59,7 +59,7 @@ jmpbuffer_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
   scm_puts ("#<jmpbuffer ", port);
   scm_puts (JBACTIVE(exp) ? "(active) " : "(inactive) ", port);
-  scm_intprint((long) JBJMPBUF (exp), 16, port);
+  scm_uintprint((scm_t_bits) JBJMPBUF (exp), 16, port);
   scm_putc ('>', port);
   return 1 ;
 }
@@ -372,8 +372,8 @@ scm_exit_status (SCM args)
     {
       SCM cqa = SCM_CAR (args);
       
-      if (SCM_INUMP (cqa))
-       return (SCM_INUM (cqa));
+      if (scm_is_integer (cqa))
+       return (scm_to_int (cqa));
       else if (scm_is_false (cqa))
        return 1;
     }
@@ -387,18 +387,28 @@ handler_message (void *handler_data, SCM tag, SCM args)
   char *prog_name = (char *) handler_data;
   SCM p = scm_cur_errp;
 
-  if (scm_ilength (args) >= 3)
+  if (scm_ilength (args) == 4)
     {
       SCM stack   = scm_make_stack (SCM_BOOL_T, SCM_EOL);
       SCM subr    = SCM_CAR (args);
       SCM message = SCM_CADR (args);
       SCM parts   = SCM_CADDR (args);
-      SCM rest    = SCM_CDDDR (args);
+      SCM rest    = SCM_CADDDR (args);
 
       if (SCM_BACKTRACE_P && scm_is_true (stack))
        {
+         SCM highlights;
+
+         if (scm_is_eq (tag, scm_arg_type_key)
+             || scm_is_eq (tag, scm_out_of_range_key))
+           highlights = rest;
+         else
+           highlights = SCM_EOL;
+
          scm_puts ("Backtrace:\n", p);
-         scm_display_backtrace (stack, p, SCM_UNDEFINED, SCM_UNDEFINED);
+         scm_display_backtrace_with_highlights (stack, p,
+                                                SCM_BOOL_F, SCM_BOOL_F,
+                                                highlights);
          scm_newline (p);
        }
       scm_i_display_error (stack, p, subr, message, parts, rest);
@@ -444,7 +454,7 @@ handler_message (void *handler_data, SCM tag, SCM args)
 SCM
 scm_handle_by_message (void *handler_data, SCM tag, SCM args)
 {
-  if (scm_is_true (scm_eq_p (tag, scm_str2symbol ("quit"))))
+  if (scm_is_true (scm_eq_p (tag, scm_from_locale_symbol ("quit"))))
     {
       exit (scm_exit_status (args));
     }
@@ -502,7 +512,7 @@ SCM_DEFINE (scm_catch, "catch", 3, 0, 0,
 {
   struct scm_body_thunk_data c;
 
-  SCM_ASSERT (SCM_SYMBOLP (key) || SCM_EQ_P (key, SCM_BOOL_T),
+  SCM_ASSERT (scm_is_symbol (key) || scm_is_eq (key, SCM_BOOL_T),
              key, SCM_ARG1, FUNC_NAME);
 
   c.tag = key;
@@ -530,7 +540,7 @@ SCM_DEFINE (scm_lazy_catch, "lazy-catch", 3, 0, 0,
 {
   struct scm_body_thunk_data c;
 
-  SCM_ASSERT (SCM_SYMBOLP (key) || SCM_EQ_P (key, SCM_BOOL_T),
+  SCM_ASSERT (scm_is_symbol (key) || scm_is_eq (key, SCM_BOOL_T),
              key, SCM_ARG1, FUNC_NAME);
 
   c.tag = key;
@@ -577,14 +587,14 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED)
 
   /* Search the wind list for an appropriate catch.
      "Waiter, please bring us the wind list." */
-  for (winds = scm_dynwinds; SCM_CONSP (winds); winds = SCM_CDR (winds))
+  for (winds = scm_dynwinds; scm_is_pair (winds); winds = SCM_CDR (winds))
     {
       dynpair = SCM_CAR (winds);
-      if (SCM_CONSP (dynpair))
+      if (scm_is_pair (dynpair))
        {
          SCM this_key = SCM_CAR (dynpair);
 
-         if (SCM_EQ_P (this_key, SCM_BOOL_T) || SCM_EQ_P (this_key, key))
+         if (scm_is_eq (this_key, SCM_BOOL_T) || scm_is_eq (this_key, key))
            break;
        }
     }
@@ -592,20 +602,20 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED)
   /* If we didn't find anything, print a message and abort the process
      right here.  If you don't want this, establish a catch-all around
      any code that might throw up. */
-  if (SCM_NULLP (winds))
+  if (scm_is_null (winds))
     {
       scm_handle_by_message (NULL, key, args);
       abort ();
     }
 
   /* If the wind list is malformed, bail.  */
-  if (!SCM_CONSP (winds))
+  if (!scm_is_pair (winds))
     abort ();
       
   jmpbuf = SCM_CDR (dynpair);
   
   for (wind_goal = scm_dynwinds;
-       !SCM_EQ_P (SCM_CDAR (wind_goal), jmpbuf);
+       !scm_is_eq (SCM_CDAR (wind_goal), jmpbuf);
        wind_goal = SCM_CDR (wind_goal))
     ;