* error.c, error.h (scm_error_callback): Removed (see NEWS).

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

diff --git a/libguile/error.c b/libguile/error.c
index 68f24a9..175655b 100644 (file)
--- a/libguile/error.c
+++ b/libguile/error.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995,1996 Free Software Foundation, Inc.
+/*     Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -12,7 +12,8 @@
  * 
  * You should have received a copy of the GNU General Public License
  * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
  *
  * As a special exception, the Free Software Foundation gives permission
  * for additional uses of the text contained in its release of GUILE.
@@ -36,8 +37,7 @@
  *
  * If you write modifications of your own for GUILE, it is your choice
  * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.  
- */
+ * If you do not wish that, delete this exception notice.  */
 \f
 
 #include <stdio.h>
@@ -58,73 +58,9 @@
  */
 
 
-/* True between SCM_DEFER_INTS and SCM_ALLOW_INTS, and
- * when the interpreter is not running at all.
- */
-int scm_ints_disabled = 1;
-
 extern int errno;
 
-static void err_head SCM_P ((char *str));
-
-static void 
-err_head (str)
-     char *str;
-{
-  int oerrno = errno;
-  if (SCM_NIMP (scm_cur_outp))
-    scm_fflush (scm_cur_outp);
-  scm_gen_putc ('\n', scm_cur_errp);
-#if 0
-  if (SCM_BOOL_F != *scm_loc_loadpath)
-    {
-      scm_prin1 (*scm_loc_loadpath, scm_cur_errp, 1);
-      scm_gen_puts (scm_regular_string, ", line ", scm_cur_errp);
-      scm_intprint ((long) scm_linum, 10, scm_cur_errp);
-      scm_gen_puts (scm_regular_string, ": ", scm_cur_errp);
-    }
-#endif
-  scm_fflush (scm_cur_errp);
-  errno = oerrno;
-  if (scm_cur_errp == scm_def_errp)
-    {
-      if (errno > 0)
-       perror (str);
-      fflush (stderr);
-      return;
-    }
-}
-
-
-SCM_PROC(s_errno, "errno", 0, 1, 0, scm_errno);
-SCM
-scm_errno (arg)
-     SCM arg;
-{
-  int old = errno;
-  if (!SCM_UNBNDP (arg))
-    {
-      if (SCM_FALSEP (arg))
-       errno = 0;
-      else
-       errno = SCM_INUM (arg);
-    }
-  return SCM_MAKINUM (old);
-}
-
-SCM_PROC(s_perror, "perror", 1, 0, 0, scm_perror);
-SCM 
-scm_perror (arg)
-     SCM arg;
-{
-  SCM_ASSERT (SCM_NIMP (arg) && SCM_STRINGP (arg), arg, SCM_ARG1, s_perror);
-  err_head (SCM_CHARS (arg));
-  return SCM_UNSPECIFIED;
-}
-
-void (*scm_error_callback) () = 0;
-
-/* all errors thrown from C should pass through here.  */
+/* All errors should pass through here.  */
 void
 scm_error (key, subr, message, args, rest)
      SCM key;
@@ -134,9 +70,6 @@ scm_error (key, subr, message, args, rest)
      SCM rest;
 {
   SCM arg_list;
-  if (scm_error_callback)
-    (*scm_error_callback) (key, subr, message, args, rest);
-
   arg_list = scm_listify (subr ? scm_makfrom0str (subr) : SCM_BOOL_F,
                          message ? scm_makfrom0str (message) : SCM_BOOL_F,
                          args,
@@ -146,10 +79,46 @@ scm_error (key, subr, message, args, rest)
   
   /* No return, but just in case: */
 
-  write (2, "unhandled system error", sizeof ("unhandled system error") - 1);
+  write (2, "unhandled system error\n",
+        sizeof ("unhandled system error\n") - 1);
   exit (1);
 }
 
+/* Scheme interface to scm_error.  */
+SCM_PROC(s_error_scm, "scm-error", 5, 0, 0, scm_error_scm);
+SCM
+scm_error_scm (key, subr, message, args, rest)
+     SCM key;
+     SCM subr;
+     SCM message;
+     SCM args;
+     SCM rest;
+{
+  SCM_ASSERT (SCM_NIMP (key) && SCM_SYMBOLP (key), key, SCM_ARG1, s_error_scm);
+  SCM_ASSERT (SCM_FALSEP (subr) || (SCM_NIMP (subr) && SCM_ROSTRINGP (subr)),
+             subr, SCM_ARG2, s_error_scm);
+  SCM_ASSERT (SCM_FALSEP (message)
+             || (SCM_NIMP (message) && SCM_ROSTRINGP (message)),
+             message, SCM_ARG3, s_error_scm);
+
+  SCM_COERCE_SUBSTR (message);
+
+  scm_error (key,
+            (SCM_FALSEP (subr)) ? NULL : SCM_ROCHARS (subr),
+            (SCM_FALSEP (message)) ? NULL : SCM_ROCHARS (message),
+            args,
+            rest);
+  /* not reached.  */
+}
+
+SCM_PROC (s_strerror, "strerror", 1, 0, 0, scm_strerror);
+SCM
+scm_strerror (SCM err)
+{
+  SCM_ASSERT (SCM_INUMP (err), err, SCM_ARG1, s_strerror);
+  return scm_makfrom0str (strerror (SCM_INUM (err)));
+}
+
 SCM_SYMBOL (scm_system_error_key, "system-error");
 void
 scm_syserror (subr)
@@ -164,16 +133,17 @@ scm_syserror (subr)
 }
 
 void
-scm_syserror_msg (subr, message, args)
+scm_syserror_msg (subr, message, args, eno)
      char *subr;
      char *message;
      SCM args;
+     int eno;
 {
   scm_error (scm_system_error_key,
             subr,
             message,
             args,
-            scm_listify (SCM_MAKINUM (errno), SCM_UNDEFINED));
+            scm_listify (SCM_MAKINUM (eno), SCM_UNDEFINED));
 }
 
 void
@@ -282,7 +252,7 @@ scm_wta (arg, pos, s_subr)
   if ((~0x1fL) & (long) pos)
     {
       /* error string supplied.  */
-      scm_misc_error (s_subr, pos, SCM_BOOL_F);
+      scm_misc_error (s_subr, pos, SCM_EOL);
     }
   else
     {
@@ -311,7 +281,7 @@ scm_wta (arg, pos, s_subr)
          scm_memory_error (s_subr);
        default:
          /* this shouldn't happen.  */
-         scm_misc_error (s_subr, "Unknown error", SCM_BOOL_F);
+         scm_misc_error (s_subr, "Unknown error", SCM_EOL);
        }
     }
   return SCM_UNSPECIFIED;
@@ -323,6 +293,7 @@ scm_wta (arg, pos, s_subr)
 void
 scm_init_error ()
 {
+#include "cpp_err_symbols.c"
 #include "error.x"
 }