/* -*-C-*-
$Id: stack.h,v 9.38 1999/01/02 06:11:34 cph Exp $
Copyright (c) 1987-1999 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
the Free Software Foundation; either version 2 of the License, or (at
your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
/* This file contains macros for manipulating stacks and stacklets. */
#ifndef STACK_RESET
# define STACK_RESET() do {} while (0)
#endif /* STACK_RESET */
#ifdef USE_STACKLETS
/*
Stack is made up of linked small parts, each in the heap
*/
#define INITIALIZE_STACK() do \
{ \
if (GC_Check(Default_Stacklet_Size)) \
Microcode_Termination(TERM_STACK_ALLOCATION_FAILED); \
SET_STACK_GUARD (Free + STACKLET_HEADER_SIZE); \
*Free = \
(MAKE_OBJECT (TC_MANIFEST_VECTOR, (Default_Stacklet_Size - 1))); \
Free += Default_Stacklet_Size; \
Stack_Pointer = Free; \
Free_Stacklets = NULL; \
Prev_Restore_History_Stacklet = NULL; \
Prev_Restore_History_Offset = 0; \
} while (0)
/* This is a lie, but OK in the context in which it is used. */
#define STACK_OVERFLOWED_P() FALSE
#define Internal_Will_Push(N) \
{ \
if ((Stack_Pointer - (N)) < Stack_Guard) \
{ \
Export_Registers(); \
Allocate_New_Stacklet((N)); \
Import_Registers(); \
} \
}
/* No space required independent of the heap for the stacklets */
#define STACK_ALLOCATION_SIZE(Stack_Blocks) 0
#define Current_Stacklet (Stack_Guard - STACKLET_HEADER_SIZE)
/* Make the unused portion of the old stacklet invisible to garbage
* collection. This also allows the stack pointer to be reconstructed.
*/
#define Internal_Terminate_Old_Stacklet() \
{ \
Current_Stacklet[STACKLET_REUSE_FLAG] = SHARP_T; \
Current_Stacklet[STACKLET_UNUSED_LENGTH] = \
MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, (Stack_Pointer - Stack_Guard)); \
}
#ifdef ENABLE_DEBUGGING_TOOLS
#define Terminate_Old_Stacklet() \
{ \
if (Stack_Pointer < Stack_Guard) \
{ \
outf_fatal ("\nStack_Pointer: 0x%lx, Guard: 0x%lx\n", \
((long) Stack_Pointer), ((long) Stack_Guard)); \
Microcode_Termination(TERM_EXIT); \
} \
Internal_Terminate_Old_Stacklet(); \
}
#else /* not ENABLE_DEBUGGING_TOOLS */
#define Terminate_Old_Stacklet() Internal_Terminate_Old_Stacklet()
#endif /* ENABLE_DEBUGGING_TOOLS */
/* Used by garbage collector to detect the end of constant space */
#define CONSTANT_AREA_START() Constant_Space
#define Get_Current_Stacklet() \
(MAKE_POINTER_OBJECT (TC_CONTROL_POINT, Current_Stacklet))
#define Previous_Stack_Pointer(Where) \
(MEMORY_LOC \
(Where, \
(STACKLET_HEADER_SIZE + \
(OBJECT_DATUM (MEMORY_REF (Where, STACKLET_UNUSED_LENGTH))))))
#define Set_Current_Stacklet(Where) \
{ \
SCHEME_OBJECT Our_Where; \
\
Our_Where = (Where); \
SET_STACK_GUARD (MEMORY_LOC (Our_Where, STACKLET_HEADER_SIZE)); \
Stack_Pointer = Previous_Stack_Pointer(Our_Where); \
}
#define STACKLET_SLACK (STACKLET_HEADER_SIZE + CONTINUATION_SIZE)
#define Default_Stacklet_Size (Stack_Size + STACKLET_SLACK)
#define New_Stacklet_Size(N) \
(STACKLET_SLACK + Stack_Size * (((N) + Stack_Size - 1) / Stack_Size))
#define Get_End_Of_Stacklet() \
(&(Current_Stacklet[1 + OBJECT_DATUM (Current_Stacklet[STACKLET_LENGTH])]))
#define Apply_Stacklet_Backout() \
Will_Push((2 * CONTINUATION_SIZE) + (STACK_ENV_EXTRA_SLOTS + 2)); \
Store_Expression(SHARP_F); \
Store_Return(RC_END_OF_COMPUTATION); \
Save_Cont(); \
STACK_PUSH (Val); \
STACK_PUSH (Previous_Stacklet); \
STACK_PUSH (STACK_FRAME_HEADER + 1); \
Store_Return(RC_INTERNAL_APPLY); \
Save_Cont(); \
Pushed()
#define Join_Stacklet_Backout() Apply_Stacklet_Backout()
/* This depends on the fact that Within_Control_Point is going to
* push an apply frame immediately after Return_To_Previous_Stacklet
* "returns". This apply will cause the GC, then the 2nd argument to
* Within_Control_Point will be invoked, and finally the control point
* will be entered.
*/
#define Within_Stacklet_Backout() \
{ \
SCHEME_OBJECT Old_Expression; \
\
Old_Expression = Fetch_Expression(); \
Store_Expression(Previous_Stacklet); \
Store_Return(RC_JOIN_STACKLETS); \
Save_Cont(); \
Store_Expression(Old_Expression); \
}
/* Our_Throw is used in chaining from one stacklet to another. In
* order to improve efficiency, the entire stack is copied neither on
* catch or throw, but is instead copied one stacklet at a time as
* needed. The need to copy a stacklet is signified by the object in
* the STACKLET_REUSE_FLAG of a stacklet. If this object is #F, the
* stacklet is copied when it is "returned into", and the word is set
* to #F in the stacklet into which the copied one will return. When a
* stacklet is returned from, it is no longer needed for anything so it
* can be deallocated. A free list of deallocate stacklets is kept in
* order to improve the efficiencty of their use.
*/
#define Our_Throw(From_Pop_Return, Stacklet) \
{ \
SCHEME_OBJECT Previous_Stacklet; \
SCHEME_OBJECT *Stacklet_Top; \
\
Previous_Stacklet = (Stacklet); \
Stacklet_Top = Current_Stacklet; \
Stacklet_Top[STACKLET_FREE_LIST_LINK] = \
((SCHEME_OBJECT) Free_Stacklets); \
Free_Stacklets = Stacklet_Top; \
if (!(From_Pop_Return)) \
{ \
Prev_Restore_History_Stacklet = NULL; \
Prev_Restore_History_Offset = 0; \
} \
if ((MEMORY_REF (Previous_Stacklet, STACKLET_REUSE_FLAG)) == SHARP_F) \
{ \
/* We need to copy the stacklet into which we are \
returning. \
*/ \
\
if (GC_Check(VECTOR_LENGTH (Previous_Stacklet) + 1)) \
{ \
/* We don't have enough space to copy the stacklet. */ \
\
Free_Stacklets = \
((SCHEME_OBJECT *) Free_Stacklets[STACKLET_FREE_LIST_LINK]); \
Stack_Pointer = Get_End_Of_Stacklet(); \
Prev_Restore_History_Stacklet = NULL; \
Prev_Restore_History_Offset = 0
/* Backout code inserted here by macro user */
#define Our_Throw_Part_2() \
Request_GC(VECTOR_LENGTH (Previous_Stacklet) + 1); \
} \
else \
{ \
/* There is space available to copy the stacklet. */ \
\
long Unused_Length; \
fast Used_Length; \
fast SCHEME_OBJECT *Old_Stacklet_Top, *temp; \
SCHEME_OBJECT *First_Continuation; \
\
Old_Stacklet_Top = OBJECT_ADDRESS (Previous_Stacklet); \
First_Continuation = \
MEMORY_LOC (Previous_Stacklet, \
((1 + VECTOR_LENGTH (Previous_Stacklet)) - \
CONTINUATION_SIZE)); \
if (Old_Stacklet_Top == Prev_Restore_History_Stacklet) \
Prev_Restore_History_Stacklet = NULL; \
if (First_Continuation[CONTINUATION_RETURN_CODE] == \
MAKE_OBJECT (TC_RETURN_CODE, RC_JOIN_STACKLETS)) \
{ \
SCHEME_OBJECT Older_Stacklet; \
\
Older_Stacklet = First_Continuation[CONTINUATION_EXPRESSION]; \
MEMORY_SET (Older_Stacklet, STACKLET_REUSE_FLAG, SHARP_F); \
} \
temp = Free; \
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]) + \
STACKLET_HEADER_SIZE; \
temp += Unused_Length; \
Stack_Pointer = temp; \
Used_Length = \
(OBJECT_DATUM (Old_Stacklet_Top[STACKLET_LENGTH]) - \
Unused_Length) + 1; \
Old_Stacklet_Top += Unused_Length; \
while (--Used_Length >= 0) \
*temp++ = *Old_Stacklet_Top++; \
Free = temp; \
} \
} \
else \
{ \
/* No need to copy the stacklet we are going into */ \
\
if (OBJECT_ADDRESS (Previous_Stacklet)== \
Prev_Restore_History_Stacklet) \
Prev_Restore_History_Stacklet = NULL; \
Set_Current_Stacklet(Previous_Stacklet); \
} \
}
#else /* not USE_STACKLETS */
/*
Full size stack in a statically allocated area
*/
#define Stack_Check(P) do \
{ \
if ((P) <= Stack_Guard) \
{ \
extern void EXFUN (stack_death, (CONST char *)); \
if (STACK_OVERFLOWED_P ()) \
stack_death ("Stack_Check"); \
REQUEST_INTERRUPT (INT_Stack_Overflow); \
} \
} while (0)
#define Internal_Will_Push(N) Stack_Check(Stack_Pointer - (N))
#define Terminate_Old_Stacklet()
#define Get_Current_Stacklet() SHARP_F
#define Set_Current_Stacklet(Where) {}
#define Previous_Stack_Pointer(Where) \
(MEMORY_LOC \
(Where, \
(STACKLET_HEADER_SIZE + \
(OBJECT_DATUM (MEMORY_REF (Where, STACKLET_UNUSED_LENGTH))))))
/* Never allocate more space */
#define New_Stacklet_Size(N) 0
#define Get_End_Of_Stacklet() Stack_Top
/* Not needed in this version */
#define Join_Stacklet_Backout()
#define Apply_Stacklet_Backout()
#define Within_Stacklet_Backout()
/* This piece of code KNOWS which way the stack grows.
The assumption is that successive pushes modify decreasing addresses.
*/
/* Clear the stack and replace it with a copy of the contents of the
control point. Also disables the history collection mechanism,
since the saved history would be incorrect on the new stack. */
#define Our_Throw(From_Pop_Return, P) do \
{ \
SCHEME_OBJECT Control_Point; \
fast SCHEME_OBJECT *To_Where, *From_Where; \
fast long len, valid, invalid; \
\
Control_Point = (P); \
if ((Consistency_Check) \
&& (OBJECT_TYPE (Control_Point) != TC_CONTROL_POINT)) \
Microcode_Termination (TERM_BAD_STACK); \
len = VECTOR_LENGTH (Control_Point); \
invalid = ((OBJECT_DATUM (MEMORY_REF (Control_Point, \
STACKLET_UNUSED_LENGTH))) + \
STACKLET_HEADER_SIZE); \
valid = ((len + 1) - invalid); \
CLEAR_INTERRUPT(INT_Stack_Overflow); \
To_Where = (Stack_Top - valid); \
From_Where = MEMORY_LOC (Control_Point, invalid); \
Stack_Check (To_Where); \
Stack_Pointer = To_Where; \
while (--valid >= 0) \
*To_Where++ = *From_Where++; \
if (Consistency_Check) \
{ \
if ((To_Where != Stack_Top) || \
(From_Where != \
MEMORY_LOC (Control_Point, (1 + len)))) \
Microcode_Termination (TERM_BAD_STACK); \
} \
STACK_RESET (); \
if (!(From_Pop_Return)) \
{ \
Prev_Restore_History_Stacklet = NULL; \
Prev_Restore_History_Offset = 0; \
if ((!Valid_Fixed_Obj_Vector ()) || \
(Get_Fixed_Obj_Slot (Dummy_History) == SHARP_F)) \
History = Make_Dummy_History (); \
else \
History = OBJECT_ADDRESS (Get_Fixed_Obj_Slot (Dummy_History)); \
} \
else if (Prev_Restore_History_Stacklet == \
OBJECT_ADDRESS (Control_Point)) \
Prev_Restore_History_Stacklet = NULL; \
} while (0)
#define Our_Throw_Part_2()
#endif /* USE_STACKLETS */
syntax highlighted by Code2HTML, v. 0.9.1