From e6407bba2f4541415a1cbda0edf9b4bd180e83a1 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 8 Mar 2001 17:03:35 +0000 Subject: [PATCH] Add mechanism to allow signalling an error with an arbitrary Scheme object as an argument. --- v7/src/microcode/errors.h | 6 +++--- v7/src/microcode/prims.h | 3 ++- v7/src/microcode/utils.c | 42 ++++++++++++++++++++------------------- 3 files changed, 27 insertions(+), 24 deletions(-) diff --git a/v7/src/microcode/errors.h b/v7/src/microcode/errors.h index aaeec0374..56e29fe67 100644 --- 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 6433e7a52..16eb9dd8d 100644 --- 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 20395684f..ac5c5d178 100644 --- 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); -- 2.25.1