Add mechanism to allow signalling an error with an arbitrary Scheme

object as an argument.

diff --git a/v7/src/microcode/errors.h b/v7/src/microcode/errors.h
index aaeec0374d0fa4f11f573420a2fefa6ee1bb70e1..56e29fe67961375f06a73293196acac597d8edc2 100644 (file)
--- a/v7/src/microcode/errors.h
+++ b/v7/src/microcode/errors.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: errors.h,v 9.42 1999/01/02 06:11:34 cph Exp $
+$Id: errors.h,v 9.43 2001/03/08 17:03:30 cph Exp $
 
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-2001 Massachusetts Institute of Technology
 
 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
@@ -34,7 +34,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 #define ERR_UNASSIGNED_VARIABLE                        0x02
 #define ERR_INAPPLICABLE_OBJECT                        0x03
 #define ERR_IN_SYSTEM_CALL                     0x04
-/* #define ERR_ENVIRONMENT_CHAIN_TOO_DEEP      0x05 */
+#define ERR_WITH_ARGUMENT                      0x05
 #define ERR_BAD_FRAME                          0x06
 #define ERR_BROKEN_COMPILED_VARIABLE           0x07
 #define ERR_UNDEFINED_USER_TYPE                        0x08

diff --git a/v7/src/microcode/prims.h b/v7/src/microcode/prims.h
index 6433e7a523b14f28659009bac2018845526f2c5a..16eb9dd8da6cdbf964025cfba881583f77fc7d3d 100644 (file)
--- a/v7/src/microcode/prims.h
+++ b/v7/src/microcode/prims.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: prims.h,v 9.47 2001/01/04 22:07:41 cph Exp $
+$Id: prims.h,v 9.48 2001/03/08 17:03:32 cph Exp $
 
 Copyright (c) 1987-2001 Massachusetts Institute of Technology
 
@@ -80,6 +80,7 @@ extern void EXFUN (signal_interrupt_from_primitive, (void));
 extern void EXFUN (error_wrong_type_arg, (int));
 extern void EXFUN (error_bad_range_arg, (int));
 extern void EXFUN (error_external_return, (void));
+extern void EXFUN (error_with_argument, (SCHEME_OBJECT));
 extern long EXFUN (arg_integer, (int));
 extern long EXFUN (arg_nonnegative_integer, (int));
 extern long EXFUN (arg_index_integer, (int, long));

diff --git a/v7/src/microcode/utils.c b/v7/src/microcode/utils.c
index 20395684f555fd7041d83eb74597b163cce9ed1e..ac5c5d1780985874be26991656dac7e98afa73c2 100644 (file)
--- a/v7/src/microcode/utils.c
+++ b/v7/src/microcode/utils.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: utils.c,v 9.75 2000/12/05 21:23:48 cph Exp $
+$Id: utils.c,v 9.76 2001/03/08 17:03:35 cph Exp $
 
 Copyright (c) 1987-2000 Massachusetts Institute of Technology
 
@@ -367,16 +367,27 @@ DEFUN_VOID (error_external_return)
   signal_error_from_primitive (ERR_EXTERNAL_RETURN);
 }
 
-unsigned int syscall_error_code;
-unsigned int syscall_error_name;
+static SCHEME_OBJECT error_argument;
+
+void
+DEFUN (error_with_argument, (argument), SCHEME_OBJECT argument)
+{
+  error_argument = argument;
+  signal_error_from_primitive (ERR_WITH_ARGUMENT);
+  /*NOTREACHED*/
+}
 
 void
 DEFUN (error_in_system_call, (err, name),
        enum syserr_names err AND enum syscall_names name)
 {
-  syscall_error_code = ((unsigned int) err);
-  syscall_error_name = ((unsigned int) name);
-  signal_error_from_primitive (ERR_IN_SYSTEM_CALL);
+  /* System call errors have some additional information.
+     Encode this as a vector in place of the error code.  */
+  SCHEME_OBJECT v = (allocate_marked_vector (TC_VECTOR, 3, 0));
+  VECTOR_SET (v, 0, (LONG_TO_UNSIGNED_FIXNUM (ERR_IN_SYSTEM_CALL)));
+  VECTOR_SET (v, 1, (LONG_TO_UNSIGNED_FIXNUM ((unsigned int) err)));
+  VECTOR_SET (v, 2, (LONG_TO_UNSIGNED_FIXNUM ((unsigned int) name)));
+  error_with_argument (v);
   /*NOTREACHED*/
 }
 
@@ -384,8 +395,7 @@ void
 DEFUN (error_system_call, (code, name),
        int code AND enum syscall_names name)
 {
-  error_in_system_call ((OS_error_code_to_syserr (code)),
-                       name);
+  error_in_system_call ((OS_error_code_to_syserr (code)), name);
   /*NOTREACHED*/
 }
 
@@ -630,20 +640,12 @@ DEFUN (Do_Micro_Error, (Err, From_Pop_Return),
   /* Arg 2:     Int. mask */
   STACK_PUSH (LONG_TO_FIXNUM(FETCH_INTERRUPT_MASK()));
   /* Arg 1:     Err. No   */
-  if (Err == ERR_IN_SYSTEM_CALL)
-    {
-      /* System call errors have some additional information.
-        Encode this as a vector in place of the error code.  */
-      SCHEME_OBJECT v = (allocate_marked_vector (TC_VECTOR, 3, 0));
-      VECTOR_SET (v, 0, (LONG_TO_UNSIGNED_FIXNUM (ERR_IN_SYSTEM_CALL)));
-      VECTOR_SET (v, 1, (LONG_TO_UNSIGNED_FIXNUM (syscall_error_code)));
-      VECTOR_SET (v, 2, (LONG_TO_UNSIGNED_FIXNUM (syscall_error_name)));
-      STACK_PUSH (v);
-    }
+  if (Err == ERR_WITH_ARGUMENT)
+    STACK_PUSH (error_argument);
   else if ((Err >= SMALLEST_FIXNUM) && (Err <= BIGGEST_FIXNUM))
-      STACK_PUSH (LONG_TO_FIXNUM (Err));
+    STACK_PUSH (LONG_TO_FIXNUM (Err));
   else
-      STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM (ERR_BAD_ERROR_CODE));
+    STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM (ERR_BAD_ERROR_CODE));
   /* Procedure: Handler   */
   STACK_PUSH (Handler);
   STACK_PUSH (STACK_FRAME_HEADER + 2);