/* -*-C-*-
-$Id: cmpint.c,v 1.49 1992/09/11 02:04:05 cph Exp $
+$Id: cmpint.c,v 1.50 1992/09/26 02:54:55 cph Exp $
Copyright (c) 1989-92 Massachusetts Institute of Technology
*
*/
\f
-#ifdef HAS_COMPILER_SUPPORT
/*
* Procedures in this file belong to the following categories:
*
#include "prim.h" /* Primitive_Procedure_Table, etc. */
#define IN_CMPINT_C
#include "cmpgc.h" /* Compiled code object relocation */
+
+#ifdef HAS_COMPILER_SUPPORT
\f
#ifndef FLUSH_I_CACHE_REGION
# define FLUSH_I_CACHE_REGION(addr, nwords) NOP()
}
\f
/* INTERRUPT/GC from Scheme
- The next four procedures are called from compiled code at the start
- (respectively) of a closure, continuation, interpreter compatible
- procedure, or ordinary (not closed) procedure if an interrupt has
- been detected. They return to the interpreter if the interrupt is
- invalid after saving the state necessary to restart the compiled
- code.
-
- The code that handles RC_COMP_INTERRUPT_RESTART in interp.c will
- return control to comp_interrupt_restart (below). This assumes
- that the Scheme stack contains a compiled code entry address (start
- of continuation, procedure, etc.). The Expression register saved
- with the continuation is a piece of state that will be returned to
- Val and Env (both) upon return.
-*/
-#define GC_DESIRED_P() (Free >= MemTop)
+ These procedures are called from compiled code at the start
+ (respectively) of a procedure or continuation if an interrupt has
+ been detected. They must not be called unless there is an
+ interrupt to be serviced.
-#define TEST_GC_NEEDED() \
-{ \
- if (GC_DESIRED_P()) \
- { \
- Request_GC(Free-MemTop); \
- } \
-}
+ The code that handles RC_COMP_INTERRUPT_RESTART in "interp.c" will
+ return control to comp_interrupt_restart (below). This assumes
+ that the Scheme stack contains a compiled code entry address
+ (start of continuation, procedure, etc.). The Expression register
+ saved with the continuation is a piece of state that will be
+ returned to Val and Env (both) upon return.
-/* Called with no arguments, closure at top of (Scheme) stack.
- If the interrupt is disabled, the closure is re-invoked.
- */
-SCHEME_UTILITY struct utility_result
-DEFUN (comutil_interrupt_closure,
- (ignore_1, ignore_2, ignore_3, ignore_4),
- long ignore_1 AND long ignore_2 AND long ignore_3 AND long ignore_4)
-{
- TEST_GC_NEEDED ();
- Stack_Check (Stack_Pointer);
- if ((PENDING_INTERRUPTS()) == 0)
- {
- SCHEME_OBJECT entry_point;
+ */
- EXTRACT_CLOSURE_ENTRY_ADDRESS (entry_point,
- (OBJECT_ADDRESS (STACK_REF (0))));
- ADJUST_CLOSURE_AT_CALL (entry_point, (STACK_REF (0)));
- RETURN_TO_SCHEME (((instruction *) entry_point) +
- CLOSURE_SKIPPED_CHECK_OFFSET);
- }
- else
- {
- /* Return to interpreter to handle interrupt */
-
- STACK_PUSH (SHARP_F);
- Store_Expression (SHARP_F);
- Store_Return (RC_COMP_INTERRUPT_RESTART);
- Save_Cont ();
- RETURN_TO_C (PRIM_INTERRUPT);
- }
+#define MAYBE_REQUEST_INTERRUPTS() \
+{ \
+ if (Free >= MemTop) \
+ Request_GC (Free - MemTop); \
+ if (Stack_Pointer <= Stack_Guard) \
+ REQUEST_INTERRUPT (INT_Stack_Overflow); \
}
-\f
-/* State is the live data; no entry point on the stack.
- */
static struct utility_result
-DEFUN (compiler_interrupt_common,
- (entry_point, offset, state),
- instruction *entry_point AND
- long offset AND
+DEFUN (compiler_interrupt_common, (entry_point, state),
+ instruction * entry_point AND
SCHEME_OBJECT state)
{
- TEST_GC_NEEDED ();
- Stack_Check (Stack_Pointer);
- if ((PENDING_INTERRUPTS()) == 0)
- {
- Store_Env (state);
- Val = state;
- RETURN_TO_SCHEME (entry_point + offset);
- }
- else
- {
+ MAYBE_REQUEST_INTERRUPTS ();
+ if (entry_point != 0)
STACK_PUSH (ENTRY_TO_OBJECT (entry_point));
- STACK_PUSH (state);
- Store_Expression (SHARP_F);
- Store_Return (RC_COMP_INTERRUPT_RESTART);
- Save_Cont ();
- RETURN_TO_C (PRIM_INTERRUPT);
- }
+ STACK_PUSH (state);
+ Store_Expression (SHARP_F);
+ Store_Return (RC_COMP_INTERRUPT_RESTART);
+ Save_Cont ();
+ RETURN_TO_C (PRIM_INTERRUPT);
}
SCHEME_UTILITY struct utility_result
-DEFUN (comutil_interrupt_dlink,
- (entry_point, dlink, ignore_3, ignore_4),
- instruction * entry_point
- AND SCHEME_OBJECT * dlink
- AND long ignore_3 AND long ignore_4)
+DEFUN (comutil_interrupt_closure, (ignore_1, ignore_2, ignore_3, ignore_4),
+ long ignore_1 AND
+ long ignore_2 AND
+ long ignore_3 AND
+ long ignore_4)
+{
+ return (compiler_interrupt_common (0, SHARP_F));
+}
+
+SCHEME_UTILITY struct utility_result
+DEFUN (comutil_interrupt_dlink, (entry_point, dlink, ignore_3, ignore_4),
+ instruction * entry_point AND
+ SCHEME_OBJECT * dlink AND
+ long ignore_3 AND
+ long ignore_4)
{
return
- (compiler_interrupt_common(entry_point,
- ENTRY_SKIPPED_CHECK_OFFSET,
- MAKE_POINTER_OBJECT(TC_STACK_ENVIRONMENT,
- dlink)));
+ (compiler_interrupt_common
+ (entry_point, (MAKE_POINTER_OBJECT (TC_STACK_ENVIRONMENT, dlink))));
}
SCHEME_UTILITY struct utility_result
DEFUN (comutil_interrupt_procedure,
(entry_point, ignore_2, ignore_3, ignore_4),
- instruction * entry_point
- AND long ignore_2 AND long ignore_3 AND long ignore_4)
+ instruction * entry_point AND
+ long ignore_2 AND
+ long ignore_3 AND
+ long ignore_4)
{
- return (compiler_interrupt_common(entry_point,
- ENTRY_SKIPPED_CHECK_OFFSET,
- SHARP_F));
+ return (compiler_interrupt_common (entry_point, SHARP_F));
}
/* Val has live data, and there is no entry address on the stack */
SCHEME_UTILITY struct utility_result
DEFUN (comutil_interrupt_continuation,
(return_address, ignore_2, ignore_3, ignore_4),
- instruction * return_address
- AND long ignore_2 AND long ignore_3 AND long ignore_4)
+ instruction * return_address AND
+ long ignore_2 AND
+ long ignore_3 AND
+ long ignore_4)
{
- return (compiler_interrupt_common (return_address,
- ENTRY_SKIPPED_CHECK_OFFSET,
- Val));
+ return (compiler_interrupt_common (return_address, Val));
}
/* Env has live data; no entry point on the stack */
SCHEME_UTILITY struct utility_result
DEFUN (comutil_interrupt_ic_procedure,
(entry_point, ignore_2, ignore_3, ignore_4),
- instruction * entry_point
- AND long ignore_2 AND long ignore_3 AND long ignore_4)
+ instruction * entry_point AND
+ long ignore_2 AND
+ long ignore_3 AND
+ long ignore_4)
{
- return (compiler_interrupt_common (entry_point,
- ENTRY_SKIPPED_CHECK_OFFSET,
- (Fetch_Env())));
+ return (compiler_interrupt_common (entry_point, (Fetch_Env ())));
}
C_TO_SCHEME long
/* -*- C -*-
-$Id: alpha.h,v 1.2 1992/08/29 12:53:22 jinx Exp $
+$Id: alpha.h,v 1.3 1992/09/26 02:54:49 cph Exp $
Copyright (c) 1992 Digital Equipment Corporation (D.E.C.)
/* The length of code sequence 1, above */
#define ENTRY_PREFIX_LENGTH (2 INSTRUCTIONS)
-/* Skip over this many BYTES to bypass the GC check code (ordinary
- procedures and continuations differ from closures) */
-#define ENTRY_SKIPPED_CHECK_OFFSET (3 INSTRUCTIONS) /* Code Seq 2 */
-#define CLOSURE_SKIPPED_CHECK_OFFSET (6 INSTRUCTIONS) /* Code Seq 3 */
/* Compiled closures */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpintmd/hppa.h,v 1.33 1992/05/23 01:18:45 jinx Exp $
+$Id: hppa.h,v 1.34 1992/09/26 02:54:50 cph Exp $
Copyright (c) 1989-1992 Massachusetts Institute of Technology
\f
/* Interrupt/GC polling. */
-/* Skip over this many BYTES to bypass the GC check code (ordinary
-procedures and continuations differ from closures) */
-
-#define ENTRY_SKIPPED_CHECK_OFFSET 4
-#define CLOSURE_SKIPPED_CHECK_OFFSET 16
-
/* The length of the GC recovery code that precedes an entry.
On the HP-PA a "ble, ldi" instruction sequence.
*/
/* -*-C-*-
-$Id: i386.h,v 1.18 1992/09/18 02:03:13 jinx Exp $
+$Id: i386.h,v 1.19 1992/09/26 02:54:51 cph Exp $
Copyright (c) 1992 Massachusetts Institute of Technology
/* See the encodings above. */
-#define ENTRY_SKIPPED_CHECK_OFFSET 4
#define ENTRY_PREFIX_LENGTH 3
-#define CLOSURE_SKIPPED_CHECK_OFFSET 11
-
# define COMPILED_CLOSURE_ENTRY_SIZE \
((2 * (sizeof (format_word))) + 6)
/* -*-C-*-
-$Id: mc68k.h,v 1.31 1992/09/25 01:19:03 cph Exp $
+$Id: mc68k.h,v 1.32 1992/09/26 02:54:52 cph Exp $
Copyright (c) 1989-1992 Massachusetts Institute of Technology
#define PC_ZERO_BITS 1
-/* Skip over this many BYTES to bypass the GC check code (ordinary
-procedures and continuations differ from closures) */
-
-#define ENTRY_SKIPPED_CHECK_OFFSET 4
-#define CLOSURE_SKIPPED_CHECK_OFFSET 10
-
/* The length of the GC recovery code that precedes an entry.
On the 68K a "jsr n(a6)" instruction.
*/
/* -*-C-*-
-$Id: mips.h,v 1.15 1992/08/29 13:30:29 jinx Exp $
+$Id: mips.h,v 1.16 1992/09/26 02:54:53 cph Exp $
Copyright (c) 1989-1992 Massachusetts Institute of Technology
/* Interrupt/GC polling. */
-/* Skip over this many BYTES to bypass the GC check code (ordinary
-procedures and continuations differ from closures) */
-
-#define ENTRY_SKIPPED_CHECK_OFFSET 12
-#define CLOSURE_SKIPPED_CHECK_OFFSET 28
-
/* The length of the GC recovery code that precedes an entry.
On the MIPS a "addi, jalr, addi" instruction sequence.
*/
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpintmd/vax.h,v 1.5 1992/02/12 15:27:27 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/cmpintmd/vax.h,v 1.6 1992/09/26 02:54:54 cph Exp $
Copyright (c) 1991-1992 Massachusetts Institute of Technology
#define PC_ZERO_BITS 0
\f
-/* Skip over this many BYTES to bypass the GC check code (ordinary
-procedures and continuations differ from closures) */
-
-#define ENTRY_SKIPPED_CHECK_OFFSET 5
-#define CLOSURE_SKIPPED_CHECK_OFFSET 12
-
/* The length of the GC recovery code that precedes an entry.
On the Vax a "movl s^code,r0; jsb b^n(r10)" sequence.
*/
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/default.h,v 9.38 1992/02/10 13:52:06 jinx Exp $
+$Id: default.h,v 9.39 1992/09/26 02:54:57 cph Exp $
Copyright (c) 1988-1992 Massachusetts Institute of Technology
{ \
Stack_Top = Highest_Allocated_Address; \
Stack_Pointer = Stack_Top; \
- Set_Stack_Guard (Absolute_Stack_Base + STACK_GUARD_SIZE); \
+ SET_STACK_GUARD (Absolute_Stack_Base + STACK_GUARD_SIZE); \
} while (0)
#endif
/* -*-C-*-
-$Id: dossig.c,v 1.9 1992/09/25 21:42:38 jinx Exp $
+$Id: dossig.c,v 1.10 1992/09/26 02:54:57 cph Exp $
Copyright (c) 1992 Massachusetts Institute of Technology
handler = exception_handler;
if ((under_DPMI_p ())
&& (enable_DPMI_exceptions_p ())
- && ((DPMI_alloc_scheme_stack (&scheme_ds, &scheme_ss,
- (Regs[REGBLOCK_STACK_GUARD])))
+ && ((DPMI_alloc_scheme_stack (&scheme_ds, &scheme_ss, Stack_Guard))
== DOS_SUCCESS))
{
Scheme_Stack_Segment_Selector = scheme_ss;
/* -*-C-*-
-$Id: extern.h,v 9.48 1992/09/18 16:54:40 jinx Exp $
+$Id: extern.h,v 9.49 1992/09/26 02:54:58 cph Exp $
Copyright (c) 1987-1992 Massachusetts Institute of Technology
* MemTop, /* Top of heap space available */
* Ext_Stack_Pointer, /* Next available slot in control stack */
* Stack_Top, /* Top of control stack */
+ * Stack_Guard, /* Guard area at end of stack */
* Free_Stacklets, /* Free list of stacklets */
* Constant_Space, /* Bottom of constant+pure space */
* Free_Constant, /* Next free cell in constant+pure area */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gc.h,v 9.31 1992/07/29 19:54:53 cph Exp $
+$Id: gc.h,v 9.32 1992/09/26 02:54:59 cph Exp $
Copyright (c) 1987-92 Massachusetts Institute of Technology
\f
/* Overflow detection, various cases */
-#define GC_ENABLED_P() (INTERRUPT_ENABLED_P(INT_GC))
+#define GC_ENABLED_P() (INTERRUPT_ENABLED_P (INT_GC))
#define GC_Check(Amount) \
-(((Amount + Free) >= MemTop) && (GC_ENABLED_P()))
+ (((Amount + Free) >= MemTop) && (GC_ENABLED_P ()))
#define Space_Before_GC() \
-((GC_ENABLED_P()) ? \
- ((Free <= MemTop) ? (MemTop - Free) : 0) : \
- (Heap_Top - Free))
+ ((GC_ENABLED_P ()) \
+ ? ((Free <= MemTop) ? (MemTop - Free) : 0) \
+ : (Heap_Top - Free))
#define Request_GC(Amount) \
{ \
- REQUEST_INTERRUPT(INT_GC); \
+ REQUEST_INTERRUPT (INT_GC); \
GC_Space_Needed = Amount; \
}
-#define SET_MEMTOP(Addr) \
+#define SET_MEMTOP(addr) \
{ \
- MemTop = Addr; \
- COMPILER_SET_MEMTOP(); \
+ MemTop = (addr); \
+ COMPILER_SETUP_INTERRUPT (); \
}
-#define Set_Stack_Guard(Addr) \
+#define SET_STACK_GUARD(addr) \
{ \
- (Regs[REGBLOCK_STACK_GUARD]) = ((SCHEME_OBJECT) (Addr)); \
+ Stack_Guard = (addr); \
+ COMPILER_SETUP_INTERRUPT (); \
}
/* -*-C-*-
-$Id: interp.c,v 9.68 1992/09/14 20:34:40 cph Exp $
+$Id: interp.c,v 9.69 1992/09/26 02:55:00 cph Exp $
Copyright (c) 1988-92 Massachusetts Institute of Technology
{
interpreter_throw_argument = argument;
{
- long old_mask = IntEnb;
- set_IntEnb (0);
+ long old_mask = (FETCH_INTERRUPT_MASK ());
+ SET_INTERRUPT_MASK (0);
dstack_set_position (interpreter_catch_dstack_position);
- set_IntEnb (old_mask);
+ SET_INTERRUPT_MASK (old_mask);
}
obstack_free ((&scratch_obstack), 0);
obstack_init (&scratch_obstack);
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/interp.h,v 9.35 1992/07/29 19:54:54 cph Exp $
+$Id: interp.h,v 9.36 1992/09/26 02:55:01 cph Exp $
Copyright (c) 1987-92 Massachusetts Institute of Technology
#define Val Regs[REGBLOCK_VAL]
#define Expression Regs[REGBLOCK_EXPR]
#define Return Regs[REGBLOCK_RETURN]
-#define Stack_Guard ((SCHEME_OBJECT *) (Regs[REGBLOCK_STACK_GUARD]))
\f
/* Internal_Will_Push is in stack.h. */
/* -*-C-*-
-$Id: intrpt.h,v 1.10 1992/09/14 20:34:20 cph Exp $
+$Id: intrpt.h,v 1.11 1992/09/26 02:55:03 cph Exp $
Copyright (c) 1987-92 Massachusetts Institute of Technology
MIT in each case. */
/* Interrupt manipulation utilities. */
-\f
-/* The interrupt control registers. */
-
-/* interrupts requesting */
-#define IntCode ((long) (Registers[REGBLOCK_INT_CODE]))
-#define set_IntCode(code) \
- (Registers[REGBLOCK_INT_CODE]) = ((SCHEME_OBJECT) (code))
-
-/* interrupts enabled */
-#define IntEnb ((long) (Registers[REGBLOCK_INT_MASK]))
-#define set_IntEnb(mask) \
- (Registers[REGBLOCK_INT_MASK]) = ((SCHEME_OBJECT) (mask))
/* Interrupt bits -- scanned from LSB (1) to MSB (16) */
\f
/* Utility macros. */
-#define PENDING_INTERRUPTS() (IntEnb & IntCode)
+#define PENDING_INTERRUPTS() \
+ ((FETCH_INTERRUPT_MASK ()) & (FETCH_INTERRUPT_CODE ()))
-#define INTERRUPT_QUEUED_P(mask) ((IntCode & (mask)) != 0)
+#define INTERRUPT_QUEUED_P(mask) (((FETCH_INTERRUPT_CODE ()) & (mask)) != 0)
-#define INTERRUPT_ENABLED_P(mask) ((IntEnb & (mask)) != 0)
+#define INTERRUPT_ENABLED_P(mask) (((FETCH_INTERRUPT_MASK ()) & (mask)) != 0)
-#define INTERRUPT_PENDING_P(mask) (((PENDING_INTERRUPTS()) & (mask)) != 0)
+#define INTERRUPT_PENDING_P(mask) (((PENDING_INTERRUPTS ()) & (mask)) != 0)
#define COMPILER_SETUP_INTERRUPT() \
{ \
- (Regs [REGBLOCK_MEMTOP]) = \
+ (Registers[REGBLOCK_MEMTOP]) = \
((INTERRUPT_PENDING_P (INT_Mask)) \
? ((SCHEME_OBJECT) -1) \
- : ((SCHEME_OBJECT) MemTop)); \
+ : (INTERRUPT_ENABLED_P (INT_GC)) \
+ ? ((SCHEME_OBJECT) MemTop) \
+ : ((SCHEME_OBJECT) Heap_Top)); \
+ (Registers[REGBLOCK_STACK_GUARD]) = \
+ ((INTERRUPT_ENABLED_P (INT_Stack_Overflow)) \
+ ? ((SCHEME_OBJECT) Stack_Guard) \
+ : ((SCHEME_OBJECT) Absolute_Stack_Base)); \
}
-#define FETCH_INTERRUPT_MASK() (IntEnb)
+#define FETCH_INTERRUPT_MASK() ((long) (Registers[REGBLOCK_INT_MASK]))
#define SET_INTERRUPT_MASK(mask) \
{ \
- set_IntEnb (mask); \
+ (Registers[REGBLOCK_INT_MASK]) = ((SCHEME_OBJECT) (mask)); \
COMPILER_SETUP_INTERRUPT (); \
}
-#define FETCH_INTERRUPT_CODE() (IntCode)
+#define FETCH_INTERRUPT_CODE() ((long) (Registers[REGBLOCK_INT_CODE]))
-#define CLEAR_INTERRUPT(code) \
+#define REQUEST_INTERRUPT(code) \
{ \
- set_IntCode (IntCode &~ (code)); \
+ (Registers[REGBLOCK_INT_CODE]) = \
+ ((SCHEME_OBJECT) ((FETCH_INTERRUPT_CODE ()) | (code))); \
COMPILER_SETUP_INTERRUPT (); \
}
-#define REQUEST_INTERRUPT(code) \
+#define CLEAR_INTERRUPT(code) \
{ \
- set_IntCode (IntCode | (code)); \
+ (Registers[REGBLOCK_INT_CODE]) = \
+ ((SCHEME_OBJECT) ((FETCH_INTERRUPT_CODE ()) &~ (code))); \
COMPILER_SETUP_INTERRUPT (); \
}
#define INITIALIZE_INTERRUPTS() \
{ \
- set_IntEnb (0); \
- set_IntCode (0); \
+ (Registers[REGBLOCK_INT_MASK]) = ((SCHEME_OBJECT) 0); \
+ (Registers[REGBLOCK_INT_CODE]) = ((SCHEME_OBJECT) 0); \
SET_INTERRUPT_MASK (INT_Mask); \
CLEAR_INTERRUPT (INT_Mask); \
}
-
-/* Compatibility */
-
-#define COMPILER_SET_MEMTOP COMPILER_SETUP_INTERRUPT
/* -*-C-*-
-$Id: stack.h,v 9.32 1992/09/18 05:53:14 jinx Exp $
+$Id: stack.h,v 9.33 1992/09/26 02:55:03 cph Exp $
Copyright (c) 1987-1992 Massachusetts Institute of Technology
{ \
Microcode_Termination(TERM_STACK_ALLOCATION_FAILED); \
} \
- Set_Stack_Guard (Free + STACKLET_HEADER_SIZE); \
+ SET_STACK_GUARD (Free + STACKLET_HEADER_SIZE); \
*Free = \
(MAKE_OBJECT (TC_MANIFEST_VECTOR, (Default_Stacklet_Size - 1))); \
Free += Default_Stacklet_Size; \
SCHEME_OBJECT Our_Where; \
\
Our_Where = (Where); \
- Set_Stack_Guard (MEMORY_LOC (Our_Where, STACKLET_HEADER_SIZE)); \
+ SET_STACK_GUARD (MEMORY_LOC (Our_Where, STACKLET_HEADER_SIZE)); \
Stack_Pointer = Previous_Stack_Pointer(Our_Where); \
}
MEMORY_SET (Older_Stacklet, STACKLET_REUSE_FLAG, SHARP_F); \
} \
temp = Free; \
- Set_Stack_Guard (& (temp[STACKLET_HEADER_SIZE])); \
+ SET_STACK_GUARD (& (temp[STACKLET_HEADER_SIZE])); \
temp[STACKLET_LENGTH] = Old_Stacklet_Top[STACKLET_LENGTH]; \
Unused_Length = \
OBJECT_DATUM (Old_Stacklet_Top[STACKLET_UNUSED_LENGTH]) + \
/* -*-C-*-
-$Id: storage.c,v 9.51 1992/09/11 21:58:44 cph Exp $
+$Id: storage.c,v 9.52 1992/09/26 02:55:04 cph Exp $
Copyright (c) 1987-92 Massachusetts Institute of Technology
* Free, /* Next free word in storage */
* Ext_Stack_Pointer, /* Next available slot in control stack */
* Stack_Top, /* Top of control stack */
+ * Stack_Guard, /* Guard area at end of stack */
* Free_Stacklets, /* Free list of stacklets */
* Constant_Space, /* Bottom of constant+pure space */
* Free_Constant, /* Next free cell in constant+pure area */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utils.c,v 9.53 1992/07/29 19:54:56 cph Exp $
+$Id: utils.c,v 9.54 1992/09/26 02:55:05 cph Exp $
Copyright (c) 1987-92 Massachusetts Institute of Technology
}
}
Free[STACKLET_LENGTH] = MAKE_OBJECT (TC_MANIFEST_VECTOR, (size - 1));
- Set_Stack_Guard (& (Free[STACKLET_HEADER_SIZE]));
+ SET_STACK_GUARD (& (Free[STACKLET_HEADER_SIZE]));
Free += size;
Stack_Pointer = Free;
}
((SCHEME_OBJECT *) Free_Stacklets[STACKLET_FREE_LIST_LINK]);
Stack_Pointer =
&New_Stacklet[1 + (OBJECT_DATUM (New_Stacklet[STACKLET_LENGTH]))];
- Set_Stack_Guard (& (New_Stacklet[STACKLET_HEADER_SIZE]));
+ SET_STACK_GUARD (& (New_Stacklet[STACKLET_HEADER_SIZE]));
}
Old_Expression = Fetch_Expression();
Old_Return = Fetch_Return();
/* -*-C-*-
-$Id: version.h,v 11.120 1992/09/12 00:08:33 cph Exp $
+$Id: version.h,v 11.121 1992/09/26 02:55:06 cph Exp $
Copyright (c) 1988-92 Massachusetts Institute of Technology
#define VERSION 11
#endif
#ifndef SUBVERSION
-#define SUBVERSION 120
+#define SUBVERSION 121
#endif
/* -*-C-*-
-$Id: cmpint.c,v 1.49 1992/09/11 02:04:05 cph Exp $
+$Id: cmpint.c,v 1.50 1992/09/26 02:54:55 cph Exp $
Copyright (c) 1989-92 Massachusetts Institute of Technology
*
*/
\f
-#ifdef HAS_COMPILER_SUPPORT
/*
* Procedures in this file belong to the following categories:
*
#include "prim.h" /* Primitive_Procedure_Table, etc. */
#define IN_CMPINT_C
#include "cmpgc.h" /* Compiled code object relocation */
+
+#ifdef HAS_COMPILER_SUPPORT
\f
#ifndef FLUSH_I_CACHE_REGION
# define FLUSH_I_CACHE_REGION(addr, nwords) NOP()
}
\f
/* INTERRUPT/GC from Scheme
- The next four procedures are called from compiled code at the start
- (respectively) of a closure, continuation, interpreter compatible
- procedure, or ordinary (not closed) procedure if an interrupt has
- been detected. They return to the interpreter if the interrupt is
- invalid after saving the state necessary to restart the compiled
- code.
-
- The code that handles RC_COMP_INTERRUPT_RESTART in interp.c will
- return control to comp_interrupt_restart (below). This assumes
- that the Scheme stack contains a compiled code entry address (start
- of continuation, procedure, etc.). The Expression register saved
- with the continuation is a piece of state that will be returned to
- Val and Env (both) upon return.
-*/
-#define GC_DESIRED_P() (Free >= MemTop)
+ These procedures are called from compiled code at the start
+ (respectively) of a procedure or continuation if an interrupt has
+ been detected. They must not be called unless there is an
+ interrupt to be serviced.
-#define TEST_GC_NEEDED() \
-{ \
- if (GC_DESIRED_P()) \
- { \
- Request_GC(Free-MemTop); \
- } \
-}
+ The code that handles RC_COMP_INTERRUPT_RESTART in "interp.c" will
+ return control to comp_interrupt_restart (below). This assumes
+ that the Scheme stack contains a compiled code entry address
+ (start of continuation, procedure, etc.). The Expression register
+ saved with the continuation is a piece of state that will be
+ returned to Val and Env (both) upon return.
-/* Called with no arguments, closure at top of (Scheme) stack.
- If the interrupt is disabled, the closure is re-invoked.
- */
-SCHEME_UTILITY struct utility_result
-DEFUN (comutil_interrupt_closure,
- (ignore_1, ignore_2, ignore_3, ignore_4),
- long ignore_1 AND long ignore_2 AND long ignore_3 AND long ignore_4)
-{
- TEST_GC_NEEDED ();
- Stack_Check (Stack_Pointer);
- if ((PENDING_INTERRUPTS()) == 0)
- {
- SCHEME_OBJECT entry_point;
+ */
- EXTRACT_CLOSURE_ENTRY_ADDRESS (entry_point,
- (OBJECT_ADDRESS (STACK_REF (0))));
- ADJUST_CLOSURE_AT_CALL (entry_point, (STACK_REF (0)));
- RETURN_TO_SCHEME (((instruction *) entry_point) +
- CLOSURE_SKIPPED_CHECK_OFFSET);
- }
- else
- {
- /* Return to interpreter to handle interrupt */
-
- STACK_PUSH (SHARP_F);
- Store_Expression (SHARP_F);
- Store_Return (RC_COMP_INTERRUPT_RESTART);
- Save_Cont ();
- RETURN_TO_C (PRIM_INTERRUPT);
- }
+#define MAYBE_REQUEST_INTERRUPTS() \
+{ \
+ if (Free >= MemTop) \
+ Request_GC (Free - MemTop); \
+ if (Stack_Pointer <= Stack_Guard) \
+ REQUEST_INTERRUPT (INT_Stack_Overflow); \
}
-\f
-/* State is the live data; no entry point on the stack.
- */
static struct utility_result
-DEFUN (compiler_interrupt_common,
- (entry_point, offset, state),
- instruction *entry_point AND
- long offset AND
+DEFUN (compiler_interrupt_common, (entry_point, state),
+ instruction * entry_point AND
SCHEME_OBJECT state)
{
- TEST_GC_NEEDED ();
- Stack_Check (Stack_Pointer);
- if ((PENDING_INTERRUPTS()) == 0)
- {
- Store_Env (state);
- Val = state;
- RETURN_TO_SCHEME (entry_point + offset);
- }
- else
- {
+ MAYBE_REQUEST_INTERRUPTS ();
+ if (entry_point != 0)
STACK_PUSH (ENTRY_TO_OBJECT (entry_point));
- STACK_PUSH (state);
- Store_Expression (SHARP_F);
- Store_Return (RC_COMP_INTERRUPT_RESTART);
- Save_Cont ();
- RETURN_TO_C (PRIM_INTERRUPT);
- }
+ STACK_PUSH (state);
+ Store_Expression (SHARP_F);
+ Store_Return (RC_COMP_INTERRUPT_RESTART);
+ Save_Cont ();
+ RETURN_TO_C (PRIM_INTERRUPT);
}
SCHEME_UTILITY struct utility_result
-DEFUN (comutil_interrupt_dlink,
- (entry_point, dlink, ignore_3, ignore_4),
- instruction * entry_point
- AND SCHEME_OBJECT * dlink
- AND long ignore_3 AND long ignore_4)
+DEFUN (comutil_interrupt_closure, (ignore_1, ignore_2, ignore_3, ignore_4),
+ long ignore_1 AND
+ long ignore_2 AND
+ long ignore_3 AND
+ long ignore_4)
+{
+ return (compiler_interrupt_common (0, SHARP_F));
+}
+
+SCHEME_UTILITY struct utility_result
+DEFUN (comutil_interrupt_dlink, (entry_point, dlink, ignore_3, ignore_4),
+ instruction * entry_point AND
+ SCHEME_OBJECT * dlink AND
+ long ignore_3 AND
+ long ignore_4)
{
return
- (compiler_interrupt_common(entry_point,
- ENTRY_SKIPPED_CHECK_OFFSET,
- MAKE_POINTER_OBJECT(TC_STACK_ENVIRONMENT,
- dlink)));
+ (compiler_interrupt_common
+ (entry_point, (MAKE_POINTER_OBJECT (TC_STACK_ENVIRONMENT, dlink))));
}
SCHEME_UTILITY struct utility_result
DEFUN (comutil_interrupt_procedure,
(entry_point, ignore_2, ignore_3, ignore_4),
- instruction * entry_point
- AND long ignore_2 AND long ignore_3 AND long ignore_4)
+ instruction * entry_point AND
+ long ignore_2 AND
+ long ignore_3 AND
+ long ignore_4)
{
- return (compiler_interrupt_common(entry_point,
- ENTRY_SKIPPED_CHECK_OFFSET,
- SHARP_F));
+ return (compiler_interrupt_common (entry_point, SHARP_F));
}
/* Val has live data, and there is no entry address on the stack */
SCHEME_UTILITY struct utility_result
DEFUN (comutil_interrupt_continuation,
(return_address, ignore_2, ignore_3, ignore_4),
- instruction * return_address
- AND long ignore_2 AND long ignore_3 AND long ignore_4)
+ instruction * return_address AND
+ long ignore_2 AND
+ long ignore_3 AND
+ long ignore_4)
{
- return (compiler_interrupt_common (return_address,
- ENTRY_SKIPPED_CHECK_OFFSET,
- Val));
+ return (compiler_interrupt_common (return_address, Val));
}
/* Env has live data; no entry point on the stack */
SCHEME_UTILITY struct utility_result
DEFUN (comutil_interrupt_ic_procedure,
(entry_point, ignore_2, ignore_3, ignore_4),
- instruction * entry_point
- AND long ignore_2 AND long ignore_3 AND long ignore_4)
+ instruction * entry_point AND
+ long ignore_2 AND
+ long ignore_3 AND
+ long ignore_4)
{
- return (compiler_interrupt_common (entry_point,
- ENTRY_SKIPPED_CHECK_OFFSET,
- (Fetch_Env())));
+ return (compiler_interrupt_common (entry_point, (Fetch_Env ())));
}
C_TO_SCHEME long
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/cmpintmd/hppa.h,v 1.33 1992/05/23 01:18:45 jinx Exp $
+$Id: hppa.h,v 1.34 1992/09/26 02:54:50 cph Exp $
Copyright (c) 1989-1992 Massachusetts Institute of Technology
\f
/* Interrupt/GC polling. */
-/* Skip over this many BYTES to bypass the GC check code (ordinary
-procedures and continuations differ from closures) */
-
-#define ENTRY_SKIPPED_CHECK_OFFSET 4
-#define CLOSURE_SKIPPED_CHECK_OFFSET 16
-
/* The length of the GC recovery code that precedes an entry.
On the HP-PA a "ble, ldi" instruction sequence.
*/
/* -*-C-*-
-$Id: interp.c,v 9.68 1992/09/14 20:34:40 cph Exp $
+$Id: interp.c,v 9.69 1992/09/26 02:55:00 cph Exp $
Copyright (c) 1988-92 Massachusetts Institute of Technology
{
interpreter_throw_argument = argument;
{
- long old_mask = IntEnb;
- set_IntEnb (0);
+ long old_mask = (FETCH_INTERRUPT_MASK ());
+ SET_INTERRUPT_MASK (0);
dstack_set_position (interpreter_catch_dstack_position);
- set_IntEnb (old_mask);
+ SET_INTERRUPT_MASK (old_mask);
}
obstack_free ((&scratch_obstack), 0);
obstack_init (&scratch_obstack);
/* -*-C-*-
-$Id: version.h,v 11.120 1992/09/12 00:08:33 cph Exp $
+$Id: version.h,v 11.121 1992/09/26 02:55:06 cph Exp $
Copyright (c) 1988-92 Massachusetts Institute of Technology
#define VERSION 11
#endif
#ifndef SUBVERSION
-#define SUBVERSION 120
+#define SUBVERSION 121
#endif
projects / mit-scheme.git / commitdiff