From f9480080266f094f1d42d0eb30639f1076aa2ec5 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Tue, 7 Sep 1993 21:45:53 +0000 Subject: [PATCH] Check interrupts on return from primitives for the i386 back end. i386 compiled code now checks for interrupts on the calling side of the return address, not the receiving side. --- v7/src/microcode/cmpint.c | 30 +++++++++++++++++++++++++++--- v8/src/microcode/cmpint.c | 30 +++++++++++++++++++++++++++--- 2 files changed, 54 insertions(+), 6 deletions(-) diff --git a/v7/src/microcode/cmpint.c b/v7/src/microcode/cmpint.c index 272267380..4f3a52bbd 100644 --- a/v7/src/microcode/cmpint.c +++ b/v7/src/microcode/cmpint.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: cmpint.c,v 1.66 1993/09/01 22:10:59 gjr Exp $ +$Id: cmpint.c,v 1.67 1993/09/07 21:45:53 gjr Exp $ Copyright (c) 1989-1993 Massachusetts Institute of Technology @@ -75,6 +75,7 @@ MIT in each case. */ /* Macro imports */ #include +#include #include "oscond.h" /* Identify the operating system */ #include "ansidecl.h" /* Macros to support ANSI declarations */ #include "dstack.h" /* Dynamic-stack support */ @@ -701,6 +702,26 @@ DEFUN (comutil_apply_in_interpreter, { RETURN_TO_C (PRIM_APPLY); } + +#if (COMPILER_PROCESSOR_TYPE != COMPILER_I386_TYPE) + +# define RETURN_FROM_PRIMITIVE() \ + RETURN_TO_SCHEME (OBJECT_ADDRESS (STACK_POP ())) + +#else /* i386 */ + +static utility_result + EXFUN (compiler_interrupt_common, (SCHEME_ADDR, SCHEME_OBJECT)); + +# define RETURN_FROM_PRIMITIVE() do \ +{ \ + if (((long) Free) >= ((long) (Registers[REGBLOCK_MEMTOP]))) \ + return (compiler_interrupt_common (0, Val)); \ + else \ + RETURN_TO_SCHEME (OBJECT_ADDRESS (STACK_POP ())); \ +} while (0) + +#endif /* i386 */ /* comutil_primitive_apply is used to invoked a C primitive. @@ -721,7 +742,7 @@ DEFUN (comutil_primitive_apply, { PRIMITIVE_APPLY (Val, primitive); POP_PRIMITIVE_FRAME (PRIMITIVE_ARITY (primitive)); - RETURN_TO_SCHEME (OBJECT_ADDRESS (STACK_POP ())); + RETURN_FROM_PRIMITIVE (); } /* @@ -740,7 +761,7 @@ DEFUN (comutil_primitive_lexpr_apply, { PRIMITIVE_APPLY (Val, primitive); POP_PRIMITIVE_FRAME (((long) Regs[REGBLOCK_LEXPR_ACTUALS])); - RETURN_TO_SCHEME (OBJECT_ADDRESS (STACK_POP ())); + RETURN_FROM_PRIMITIVE (); } /* @@ -1240,6 +1261,9 @@ DEFUN (comutil_operator_primitive_trap, return (comutil_primitive_apply ((tramp_data[0]), 0, 0, 0)); } +extern SCHEME_OBJECT EXFUN (compiler_var_error, + (SCHEME_OBJECT, SCHEME_OBJECT)); + /* The linker either couldn't find a binding or the binding was unassigned, unbound, or a deep-bound (parallel processor) fluid. This must report the correct name of the missing variable and the diff --git a/v8/src/microcode/cmpint.c b/v8/src/microcode/cmpint.c index 272267380..4f3a52bbd 100644 --- a/v8/src/microcode/cmpint.c +++ b/v8/src/microcode/cmpint.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: cmpint.c,v 1.66 1993/09/01 22:10:59 gjr Exp $ +$Id: cmpint.c,v 1.67 1993/09/07 21:45:53 gjr Exp $ Copyright (c) 1989-1993 Massachusetts Institute of Technology @@ -75,6 +75,7 @@ MIT in each case. */ /* Macro imports */ #include +#include #include "oscond.h" /* Identify the operating system */ #include "ansidecl.h" /* Macros to support ANSI declarations */ #include "dstack.h" /* Dynamic-stack support */ @@ -701,6 +702,26 @@ DEFUN (comutil_apply_in_interpreter, { RETURN_TO_C (PRIM_APPLY); } + +#if (COMPILER_PROCESSOR_TYPE != COMPILER_I386_TYPE) + +# define RETURN_FROM_PRIMITIVE() \ + RETURN_TO_SCHEME (OBJECT_ADDRESS (STACK_POP ())) + +#else /* i386 */ + +static utility_result + EXFUN (compiler_interrupt_common, (SCHEME_ADDR, SCHEME_OBJECT)); + +# define RETURN_FROM_PRIMITIVE() do \ +{ \ + if (((long) Free) >= ((long) (Registers[REGBLOCK_MEMTOP]))) \ + return (compiler_interrupt_common (0, Val)); \ + else \ + RETURN_TO_SCHEME (OBJECT_ADDRESS (STACK_POP ())); \ +} while (0) + +#endif /* i386 */ /* comutil_primitive_apply is used to invoked a C primitive. @@ -721,7 +742,7 @@ DEFUN (comutil_primitive_apply, { PRIMITIVE_APPLY (Val, primitive); POP_PRIMITIVE_FRAME (PRIMITIVE_ARITY (primitive)); - RETURN_TO_SCHEME (OBJECT_ADDRESS (STACK_POP ())); + RETURN_FROM_PRIMITIVE (); } /* @@ -740,7 +761,7 @@ DEFUN (comutil_primitive_lexpr_apply, { PRIMITIVE_APPLY (Val, primitive); POP_PRIMITIVE_FRAME (((long) Regs[REGBLOCK_LEXPR_ACTUALS])); - RETURN_TO_SCHEME (OBJECT_ADDRESS (STACK_POP ())); + RETURN_FROM_PRIMITIVE (); } /* @@ -1240,6 +1261,9 @@ DEFUN (comutil_operator_primitive_trap, return (comutil_primitive_apply ((tramp_data[0]), 0, 0, 0)); } +extern SCHEME_OBJECT EXFUN (compiler_var_error, + (SCHEME_OBJECT, SCHEME_OBJECT)); + /* The linker either couldn't find a binding or the binding was unassigned, unbound, or a deep-bound (parallel processor) fluid. This must report the correct name of the missing variable and the -- 2.25.1