outf_console ("\n");
outf_flush_console ();
}
- current_state_point = SHARP_F;
initialize_fixed_objects_vector ();
if (option_fasl_file != 0)
extern SCHEME_OBJECT * constant_alloc_next;
extern SCHEME_OBJECT * constant_start;
extern SCHEME_OBJECT * constant_end;
-
-extern SCHEME_OBJECT current_state_point;
\f
/* Address of the most recent return code in the stack. This is
only meaningful while in compiled code. */
extern SCHEME_OBJECT * control_point_end (SCHEME_OBJECT);
extern void unpack_control_point (SCHEME_OBJECT);
-extern SCHEME_OBJECT Find_State_Space (SCHEME_OBJECT);
-
/* Debugging utilities */
extern void Back_Trace (outf_channel);
compiler_initialize (true);
#endif
fixed_objects = SHARP_F;
- current_state_point = SHARP_F;
/* Setup initial program */
SET_RC (RC_END_OF_COMPUTATION);
#define STEPPER_STATE 0x0E
#define FIXED_OBJECTS_SLOTS 0x0F /* Names of these slots. */
#define FIXOBJ_FILES_TO_DELETE 0x10 /* Temporary files to delete. */
-#define State_Space_Tag 0x11 /* Tag for state spaces. */
-#define State_Point_Tag 0x12 /* Tag for state points. */
+/* #define UNUSED 0x11 */
+/* #define UNUSED 0x12 */
#define DUMMY_HISTORY 0x13 /* Empty history structure. */
#define Bignum_One 0x14 /* Cache for bignum one. */
/* #define UNUSED 0x15 */
/* #define UNUSED 0x1F */
#define CC_ERROR_PROCEDURE 0x20 /* Error handler for compiled code. */
/* #define UNUSED 0x21 */
-#define State_Space_Root 0x22 /* Root of state space. */
+/* #define UNUSED 0x22 */
#define Primitive_Profiling_Table 0x23 /* Table of profile counts for
primitives. */
/* 0x0E */ "stepper-state", \
/* 0x0F */ "microcode-fixed-objects-slots", \
/* 0x10 */ "files-to-delete", \
- /* 0x11 */ "state-space-tag", \
- /* 0x12 */ "state-point-tag", \
+ /* 0x11 */ 0, \
+ /* 0x12 */ 0, \
/* 0x13 */ "dummy-history", \
/* 0x14 */ "bignum-one", \
/* 0x15 */ 0, \
/* 0x1F */ 0, \
/* 0x20 */ "compiler-error-procedure", \
/* 0x21 */ 0, \
- /* 0x22 */ "state-space-root", \
+ /* 0x22 */ 0, \
/* 0x23 */ "primitive-profiling-table", \
/* 0x24 */ "generic-trampoline-zero?", \
/* 0x25 */ "generic-trampoline-positive?", \
#include "scheme.h"
#include "prims.h"
-#include "winder.h"
#include "history.h"
static SCHEME_OBJECT allocate_control_point (unsigned long, bool);
}
}
\f
-/* State Space Implementation */
-
-DEFINE_PRIMITIVE ("EXECUTE-AT-NEW-STATE-POINT",
- Prim_execute_at_new_point, 4, 4,
- "(OLD-STATE-POINT BEFORE-THUNK DURING-THUNK AFTER-THUNK)\n\
-Invoke DURING-THUNK in a new state point defined by the transition\n\
-<BEFORE-THUNK, AFTER-THUNK> from OLD-STATE-POINT.\n\
-If OLD-STATE-POINT is #F, the current state point in the global state\n\
-space is used as the starting point.")
-{
- PRIMITIVE_HEADER (4);
-
- canonicalize_primitive_context ();
- {
- SCHEME_OBJECT old_point;
- if ((ARG_REF (1)) == SHARP_F)
- old_point = current_state_point;
- else
- {
- CHECK_ARG (1, STATE_SPACE_P);
- old_point = (MEMORY_REF ((ARG_REF (1)), STATE_SPACE_NEAREST_POINT));
- }
- {
- SCHEME_OBJECT new_point =
- (allocate_marked_vector (TC_VECTOR, STATE_POINT_LENGTH, true));
- SCHEME_OBJECT during_thunk = (ARG_REF (3));
- MEMORY_SET (new_point, STATE_POINT_TAG,
- (VECTOR_REF (fixed_objects, State_Point_Tag)));
- MEMORY_SET (new_point, STATE_POINT_BEFORE_THUNK, (ARG_REF (2)));
- MEMORY_SET (new_point, STATE_POINT_AFTER_THUNK, (ARG_REF (4)));
- MEMORY_SET (new_point, STATE_POINT_NEARER_POINT, old_point);
- MEMORY_SET
- (new_point,
- STATE_POINT_DISTANCE_TO_ROOT,
- (1 + (MEMORY_REF (old_point, STATE_POINT_DISTANCE_TO_ROOT))));
-
- POP_PRIMITIVE_FRAME (4);
- Will_Push((2 * CONTINUATION_SIZE) + (STACK_ENV_EXTRA_SLOTS + 1));
- /* Push a continuation to go back to the current state after the
- body is evaluated */
- SET_EXP (old_point);
- SET_RC (RC_RESTORE_TO_STATE_POINT);
- SAVE_CONT ();
- /* Push a stack frame which will call the body after we have moved
- into the new state point */
- STACK_PUSH (during_thunk);
- PUSH_APPLY_FRAME_HEADER (0);
- /* Push the continuation to go with the stack frame */
- SET_EXP (SHARP_F);
- SET_RC (RC_INTERNAL_APPLY);
- SAVE_CONT ();
- Pushed ();
- Translate_To_Point (new_point);
- /*NOTREACHED*/
- PRIMITIVE_RETURN (UNSPECIFIC);
- }
- }
-}
-
-DEFINE_PRIMITIVE ("TRANSLATE-TO-STATE-POINT", Prim_translate_to_point, 1, 1,
- "(STATE-POINT)\nRestore the dynamic state to STATE-POINT.")
-{
- PRIMITIVE_HEADER (1);
- canonicalize_primitive_context ();
- CHECK_ARG (1, STATE_POINT_P);
- {
- SCHEME_OBJECT state_point = (ARG_REF (1));
- POP_PRIMITIVE_FRAME (1);
- Translate_To_Point (state_point);
- /*NOTREACHED*/
- PRIMITIVE_RETURN (UNSPECIFIC);
- }
-}
-\f
-DEFINE_PRIMITIVE ("MAKE-STATE-SPACE", Prim_make_state_space, 1, 1,
- "(MUTABLE?)\n\
-Return a newly-allocated state-space.\n\
-Argument MUTABLE?, if not #F, means return a mutable state-space.\n\
-Otherwise, -the- immutable state-space is saved internally.")
-{
- PRIMITIVE_HEADER (1);
- {
- SCHEME_OBJECT new_point =
- (allocate_marked_vector (TC_VECTOR, STATE_POINT_LENGTH, true));
- MEMORY_SET (new_point, STATE_POINT_TAG,
- (VECTOR_REF (fixed_objects, State_Point_Tag)));
- MEMORY_SET (new_point, STATE_POINT_BEFORE_THUNK, SHARP_F);
- MEMORY_SET (new_point, STATE_POINT_AFTER_THUNK, SHARP_F);
- MEMORY_SET
- (new_point, STATE_POINT_DISTANCE_TO_ROOT, (LONG_TO_UNSIGNED_FIXNUM (0)));
- if ((ARG_REF (1)) == SHARP_F)
- {
- MEMORY_SET (new_point, STATE_POINT_NEARER_POINT, SHARP_F);
- current_state_point = new_point;
- PRIMITIVE_RETURN (SHARP_F);
- }
- else
- {
- SCHEME_OBJECT new_space =
- (allocate_marked_vector (TC_VECTOR, STATE_SPACE_LENGTH, true));
- MEMORY_SET (new_space, STATE_SPACE_TAG,
- (VECTOR_REF (fixed_objects, State_Space_Tag)));
- MEMORY_SET (new_space, STATE_SPACE_NEAREST_POINT, new_point);
- MEMORY_SET (new_point, STATE_POINT_NEARER_POINT, new_space);
- PRIMITIVE_RETURN (new_space);
- }
- }
-}
-
-DEFINE_PRIMITIVE ("CURRENT-DYNAMIC-STATE", Prim_current_dynamic_state, 1, 1,
- "(STATE-SPACE)\n\
-Return the current state point in STATE-SPACE. If STATE-SPACE is #F,\n\
-return the current state point in the global state space.")
-{
- PRIMITIVE_HEADER (1);
-
- if ((ARG_REF (1)) == SHARP_F)
- PRIMITIVE_RETURN (current_state_point);
- CHECK_ARG (1, STATE_SPACE_P);
- PRIMITIVE_RETURN (MEMORY_REF ((ARG_REF (1)), STATE_SPACE_NEAREST_POINT));
-}
-
-DEFINE_PRIMITIVE ("SET-CURRENT-DYNAMIC-STATE!", Prim_set_dynamic_state, 1, 1,
- "(STATE-POINT)\n\
-Set the current dynamic state point to STATE-POINT.")
-{
- PRIMITIVE_HEADER (1);
- CHECK_ARG (1, STATE_POINT_P);
- {
- SCHEME_OBJECT state_point = (ARG_REF (1));
- SCHEME_OBJECT state_space = (Find_State_Space (state_point));
- SCHEME_OBJECT result;
- if (state_space == SHARP_F)
- {
- result = current_state_point;
- current_state_point = state_point;
- }
- else
- {
- result = (MEMORY_REF (state_space, STATE_SPACE_NEAREST_POINT));
- MEMORY_SET (state_space, STATE_SPACE_NEAREST_POINT, state_point);
- }
- PRIMITIVE_RETURN (result);
- }
-}
-\f
/* Interrupts */
DEFINE_PRIMITIVE ("GET-INTERRUPT-ENABLES", Prim_get_interrupt_enables, 0, 0,
#include "scheme.h"
#include "trap.h"
#include "lookup.h"
-#include "winder.h"
#include "history.h"
extern void * obstack_chunk_alloc (size_t);
}
}
- case RC_MOVE_TO_ADJACENT_POINT:
- /* GET_EXP contains the space in which we are moving */
- {
- long From_Count;
- SCHEME_OBJECT Thunk;
- SCHEME_OBJECT New_Location;
-
- From_Count
- = (UNSIGNED_FIXNUM_TO_LONG (STACK_REF (TRANSLATE_FROM_DISTANCE)));
- if (From_Count != 0)
- {
- SCHEME_OBJECT Current = STACK_REF (TRANSLATE_FROM_POINT);
- STACK_REF (TRANSLATE_FROM_DISTANCE)
- = (LONG_TO_UNSIGNED_FIXNUM (From_Count - 1));
- Thunk = (MEMORY_REF (Current, STATE_POINT_AFTER_THUNK));
- New_Location
- = (MEMORY_REF (Current, STATE_POINT_NEARER_POINT));
- (STACK_REF (TRANSLATE_FROM_POINT)) = New_Location;
- if ((From_Count == 1)
- && ((STACK_REF (TRANSLATE_TO_DISTANCE))
- == (LONG_TO_UNSIGNED_FIXNUM (0))))
- stack_pointer = (STACK_LOC (4));
- else
- SAVE_CONT ();
- }
- else
- {
- long To_Count;
- SCHEME_OBJECT To_Location;
- long i;
-
- To_Count
- = ((UNSIGNED_FIXNUM_TO_LONG (STACK_REF (TRANSLATE_TO_DISTANCE)))
- - 1);
- To_Location = (STACK_REF (TRANSLATE_TO_POINT));
- for (i = 0; (i < To_Count); i += 1)
- To_Location
- = (MEMORY_REF (To_Location, STATE_POINT_NEARER_POINT));
- Thunk = (MEMORY_REF (To_Location, STATE_POINT_BEFORE_THUNK));
- New_Location = To_Location;
- (STACK_REF (TRANSLATE_TO_DISTANCE))
- = (LONG_TO_UNSIGNED_FIXNUM (To_Count));
- if (To_Count == 0)
- stack_pointer = (STACK_LOC (4));
- else
- SAVE_CONT ();
- }
- if (GET_EXP != SHARP_F)
- {
- MEMORY_SET (GET_EXP, STATE_SPACE_NEAREST_POINT, New_Location);
- }
- else
- current_state_point = New_Location;
- Will_Push (2);
- STACK_PUSH (Thunk);
- PUSH_APPLY_FRAME_HEADER (0);
- Pushed ();
- goto internal_apply;
- }
-
case RC_INVOKE_STACK_THREAD:
/* Used for WITH_THREADED_STACK primitive. */
Will_Push (3);
stack_pointer = (STACK_LOCATIVE_OFFSET (stack_pointer, 1));
break;
- case RC_RESTORE_TO_STATE_POINT:
- {
- SCHEME_OBJECT Where_To_Go = GET_EXP;
- Will_Push (CONTINUATION_SIZE);
- /* Restore the contents of GET_VAL after moving to point */
- SET_EXP (GET_VAL);
- SET_RC (RC_RESTORE_VALUE);
- SAVE_CONT ();
- Pushed ();
- Translate_To_Point (Where_To_Go);
- break; /* We never get here.... */
- }
-
case RC_SEQ_2_DO_2:
END_SUBPROBLEM ();
POP_ENV ();
add_to_tospace (fixed_objects);
add_to_tospace
(MAKE_POINTER_OBJECT (UNMARKED_HISTORY_TYPE, history_register));
- add_to_tospace (current_state_point);
current_gc_table = (std_gc_table ());
gc_scan_oldspace (stack_pointer, stack_end);
fixed_objects = (*saved_to++);
history_register = (OBJECT_ADDRESS (*saved_to++));
- current_state_point = (*saved_to++);
saved_to = 0;
CC_TRANSPORT_END ();
TYPES_H = types.h
USRDEF_H = usrdef.h $(SCHEME_H) $(PRIMS_H)
UXSOCK_H = uxsock.h $(OSIO_H)
-WINDER_H = winder.h
ZONES_H = zones.h
PSBMAP_H = psbmap.h $(CONFIG_H) $(TYPES_H) $(OBJECT_H) $(BIGNUM_H) \
fixnum.obj: fixnum.c $(SCHEME_H) $(PRIMS_H) $(MUL_C)
flonum.obj: flonum.c $(SCHEME_H) $(PRIMS_H) $(ZONES_H)
generic.obj: generic.c $(SCHEME_H) $(PRIMS_H)
-hooks.obj: hooks.c $(SCHEME_H) $(PRIMS_H) $(WINDER_H) $(HISTORY_H)
+hooks.obj: hooks.c $(SCHEME_H) $(PRIMS_H) $(HISTORY_H)
hunk.obj: hunk.c $(SCHEME_H) $(PRIMS_H)
intern.obj: intern.c $(SCHEME_H) $(PRIMS_H) $(TRAP_H)
-interp.obj: interp.c $(SCHEME_H) $(LOCKS_H) $(TRAP_H) $(LOOKUP_H) $(WINDER_H) \
+interp.obj: interp.c $(SCHEME_H) $(LOCKS_H) $(TRAP_H) $(LOOKUP_H) \
$(HISTORY_H) $(CMPINT_H) $(ZONES_H) $(PRMCON_H)
intprm.obj: intprm.c $(SCHEME_H) $(PRIMS_H) $(ZONES_H)
list.obj: list.c $(SCHEME_H) $(PRIMS_H)
$(EDWIN_H)
tparam.obj: tparam.c ansidecl.h
transact.obj: transact.c ansidecl.h $(OUTF_H) $(DSTACK_H)
-utils.obj: utils.c $(SCHEME_H) $(PRIMS_H) $(WINDER_H) $(HISTORY_H) \
+utils.obj: utils.c $(SCHEME_H) $(PRIMS_H) $(HISTORY_H) \
$(CMPINT_H) $(SYSCALL_H)
vector.obj: vector.c $(SCHEME_H) $(PRIMS_H)
wind.obj: wind.c $(OBSTACK_H) $(DSTACK_H) $(OUTF_H)
TYPES_H = types.h
USRDEF_H = usrdef.h $(SCHEME_H) $(PRIMS_H)
UXSOCK_H = uxsock.h $(OSIO_H)
-WINDER_H = winder.h
ZONES_H = zones.h
PSBMAP_H = psbmap.h $(CONFIG_H) $(TYPES_H) $(OBJECT_H) $(BIGNUM_H) \
fixnum.$(OBJ): fixnum.c $(SCHEME_H) $(PRIMS_H) $(MUL_C)
flonum.$(OBJ): flonum.c $(SCHEME_H) $(PRIMS_H) $(ZONES_H)
generic.$(OBJ): generic.c $(SCHEME_H) $(PRIMS_H)
-hooks.$(OBJ): hooks.c $(SCHEME_H) $(PRIMS_H) $(WINDER_H) $(HISTORY_H)
+hooks.$(OBJ): hooks.c $(SCHEME_H) $(PRIMS_H) $(HISTORY_H)
hunk.$(OBJ): hunk.c $(SCHEME_H) $(PRIMS_H)
intern.$(OBJ): intern.c $(SCHEME_H) $(PRIMS_H) $(TRAP_H)
interp.$(OBJ): interp.c $(SCHEME_H) $(LOCKS_H) $(TRAP_H) $(LOOKUP_H) \
- $(WINDER_H) $(HISTORY_H) $(CMPINT_H) $(ZONES_H) $(PRMCON_H)
+ $(HISTORY_H) $(CMPINT_H) $(ZONES_H) $(PRMCON_H)
intprm.$(OBJ): intprm.c $(SCHEME_H) $(PRIMS_H) $(ZONES_H)
list.$(OBJ): list.c $(SCHEME_H) $(PRIMS_H)
lookprm.$(OBJ): lookprm.c $(SCHEME_H) $(PRIMS_H) $(LOCKS_H) $(TRAP_H) \
$(EDWIN_H)
tparam.$(OBJ): tparam.c ansidecl.h
transact.$(OBJ): transact.c $(CONFIG_H) $(OUTF_H) $(DSTACK_H)
-utils.$(OBJ): utils.c $(SCHEME_H) $(PRIMS_H) $(WINDER_H) $(HISTORY_H) \
+utils.$(OBJ): utils.c $(SCHEME_H) $(PRIMS_H) $(HISTORY_H) \
$(CMPINT_H) $(SYSCALL_H)
vector.$(OBJ): vector.c $(SCHEME_H) $(PRIMS_H)
wind.$(OBJ): wind.c $(OBSTACK_H) $(DSTACK_H) $(OUTF_H)
#define RC_POP_FROM_COMPILED_CODE 0x29
#define RC_RETURN_TRAP_POINT 0x2A
/* unused 0x2B */
-#define RC_RESTORE_TO_STATE_POINT 0x2C
-#define RC_MOVE_TO_ADJACENT_POINT 0x2D
+/* unused 0x2C */
+/* unused 0x2D */
#define RC_RESTORE_VALUE 0x2E
#define RC_RESTORE_DONT_COPY_HISTORY 0x2F
/* unused 0x30 through 0x3F */
/* 0x29 */ "pop-from-compiled-code", \
/* 0x2a */ "return-trap-point", \
/* 0x2b */ 0, \
-/* 0x2c */ "restore-to-state-point", \
-/* 0x2d */ "move-to-adjacent-point", \
+/* 0x2c */ 0, \
+/* 0x2d */ 0, \
/* 0x2e */ "restore-value", \
/* 0x2f */ "restore-dont-copy-history", \
/* 0x30 */ 0, \
SCHEME_OBJECT * constant_start;
SCHEME_OBJECT * constant_end;
-/* dynamic state point */
-SCHEME_OBJECT current_state_point;
-
/* Address of the most recent return code in the stack.
This is only meaningful while in compiled code. */
SCHEME_OBJECT * last_return_code;
STORE_NAME_VECTOR (IDENTIFICATION_VECTOR, identity_names, N_IDENTITY_NAMES);
STORE_FIXOBJ (DUMMY_HISTORY, (initialize_history ()));
- STORE_FIXOBJ (State_Space_Tag, SHARP_T);
STORE_FIXOBJ (Bignum_One, (long_to_bignum (1)));
STORE_FIXOBJ (FIXOBJ_EDWIN_AUTO_SAVE, EMPTY_LIST);
STORE_FIXOBJ (FIXOBJ_FILES_TO_DELETE, EMPTY_LIST);
#include "scheme.h"
#include "prims.h"
-#include "winder.h"
#include "history.h"
#include "syscall.h"
#endif /* ENABLE_PRIMITIVE_PROFILING */
\f
-/* Dynamic Winder support code */
-
-SCHEME_OBJECT
-Find_State_Space (SCHEME_OBJECT State_Point)
-{
- long How_Far =
- (UNSIGNED_FIXNUM_TO_LONG
- (MEMORY_REF (State_Point, STATE_POINT_DISTANCE_TO_ROOT)));
- long i;
- SCHEME_OBJECT Point = State_Point;
-
- for (i=0; i <= How_Far; i++)
- {
-#ifdef ENABLE_DEBUGGING_TOOLS
- if (Point == SHARP_F)
- {
- outf_fatal("\nState_Point %#lx wrong: count was %ld, #F at %ld\n",
- ((long) State_Point), ((long) How_Far), ((long) i));
- Microcode_Termination(TERM_EXIT);
- /*NOTREACHED*/
- }
-#endif /* ENABLE_DEBUGGING_TOOLS */
- Point = MEMORY_REF (Point, STATE_POINT_NEARER_POINT);
- }
- return (Point);
-}
-
-/* Assumptions:
-
- (1) On a single processor, things should work with multiple state
- spaces. The microcode variable current_state_point tracks
- the location in the "boot" space (i.e. the one whose space is
- #F) and the state spaces themselves (roots of the space
- trees) track the other spaces.
- (2) On multi-processors, multiple spaces DO NOT work. Only the
- initial space (#F) is tracked by the microcode (it is
- swapped on every task switch), but no association with trees
- is kept. This will work since the initial tree has no space
- at the root, indicating that the microcode variable rather
- than the state space contains the current state space
- location.
-
- NOTE: This procedure is invoked both by primitives and the interpreter
- itself. As such, it is using the pun that PRIMITIVE_ABORT is just a
- (non-local) return to the interpreter. This should be cleaned up.
- NOTE: Any primitive that invokes this procedure must do a
- canonicalize_primitive_context() first! */
-
-void
-Translate_To_Point (SCHEME_OBJECT Target)
-{
- SCHEME_OBJECT State_Space, Current_Location, *Path;
- SCHEME_OBJECT Path_Point, *Path_Ptr;
- long Distance, Merge_Depth, From_Depth, i;
-
- State_Space = Find_State_Space(Target);
- Path = Free;
- Distance =
- (UNSIGNED_FIXNUM_TO_LONG
- (MEMORY_REF (Target, STATE_POINT_DISTANCE_TO_ROOT)));
- if (State_Space == SHARP_F)
- Current_Location = current_state_point;
- else
- Current_Location = MEMORY_REF (State_Space, STATE_SPACE_NEAREST_POINT);
-
- if (Target == Current_Location)
- {
- PRIMITIVE_ABORT (PRIM_POP_RETURN);
- /*NOTREACHED*/
- }
-
- for (Path_Ptr = (&(Path[Distance])), Path_Point = Target, i = 0;
- i <= Distance;
- i++)
- {
- *Path_Ptr-- = Path_Point;
- Path_Point = MEMORY_REF (Path_Point, STATE_POINT_NEARER_POINT);
- }
-
- From_Depth =
- (UNSIGNED_FIXNUM_TO_LONG
- (MEMORY_REF (Current_Location, STATE_POINT_DISTANCE_TO_ROOT)));
-
- for (Path_Point = Current_Location, Merge_Depth = From_Depth;
- Merge_Depth > Distance;
- Merge_Depth--)
- Path_Point = MEMORY_REF (Path_Point, STATE_POINT_NEARER_POINT);
-
- for (Path_Ptr = (&(Path[Merge_Depth]));
- Merge_Depth >= 0;
- Merge_Depth--, Path_Ptr--)
- {
- if (*Path_Ptr == Path_Point)
- break;
- Path_Point = MEMORY_REF (Path_Point, STATE_POINT_NEARER_POINT);
- }
-
-#ifdef ENABLE_DEBUGGING_TOOLS
- if (Merge_Depth < 0)
- {
- outf_fatal ("\nMerge_Depth went negative: %ld\n", Merge_Depth);
- Microcode_Termination (TERM_EXIT);
- }
-#endif /* ENABLE_DEBUGGING_TOOLS */
-
- preserve_interrupt_mask ();
- Will_Push(CONTINUATION_SIZE + 4);
- STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM((Distance - Merge_Depth)));
- STACK_PUSH (Target);
- STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM((From_Depth - Merge_Depth)));
- STACK_PUSH (Current_Location);
- SET_EXP (State_Space);
- SET_RC(RC_MOVE_TO_ADJACENT_POINT);
- SAVE_CONT();
- Pushed();
-
- /* Disable lower than GC level */
- SET_INTERRUPT_MASK (GET_INT_MASK & ((INT_GC << 1) - 1));
- PRIMITIVE_ABORT (PRIM_POP_RETURN);
- /*NOTREACHED*/
-}
-\f
#ifdef __WIN32__
#include <windows.h>
+++ /dev/null
-/* -*-C-*-
-
-Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
- 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
- 2006, 2007, 2008, 2009, 2010 Massachusetts Institute of Technology
-
-This file is part of MIT/GNU Scheme.
-
-MIT/GNU Scheme 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.
-
-MIT/GNU Scheme 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 MIT/GNU Scheme; if not, write to the Free Software
-Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
-USA.
-
-*/
-
-/* Header file for dynamic winder. */
-
-#define STATE_SPACE_P(object) \
- ((VECTOR_P (object)) \
- && ((VECTOR_LENGTH (object)) == STATE_SPACE_LENGTH) \
- && ((MEMORY_REF ((object), STATE_SPACE_TAG)) \
- == (VECTOR_REF (fixed_objects, State_Space_Tag))))
-
-#define STATE_SPACE_TAG 1
-#define STATE_SPACE_NEAREST_POINT 2
-#define STATE_SPACE_LENGTH 2
-
-#define STATE_POINT_P(object) \
- ((VECTOR_P (object)) \
- && ((VECTOR_LENGTH (object)) == STATE_POINT_LENGTH) \
- && ((MEMORY_REF ((object), STATE_POINT_TAG)) \
- == (VECTOR_REF (fixed_objects, State_Point_Tag))))
-
-#define STATE_POINT_TAG 1
-#define STATE_POINT_BEFORE_THUNK 2
-#define STATE_POINT_AFTER_THUNK 3
-#define STATE_POINT_NEARER_POINT 4
-#define STATE_POINT_DISTANCE_TO_ROOT 5
-#define STATE_POINT_LENGTH 5
(standard-subproblem 'REPEAT-DISPATCH 4)
(standard-subproblem 'PRIMITIVE-COMBINATION-3-FIRST-OPERAND 4)
(standard-subproblem 'PRIMITIVE-COMBINATION-3-APPLY 4)
- (standard-subproblem 'MOVE-TO-ADJACENT-POINT 6)
(standard-subproblem 'COMBINATION-SAVE-VALUE length/combination-save-value)
(let ((length (length/application-frame 2 0)))
(microcode-return/name->type 'POP-RETURN-ERROR))
(record-method 'COMBINATION-APPLY method/null)
(record-method 'GC-CHECK method/null)
- (record-method 'MOVE-TO-ADJACENT-POINT method/null)
(record-method 'REENTER-COMPILED-CODE method/null)
(record-method 'REPEAT-DISPATCH method/environment-only)
(let ((method (method/standard &pair-car)))
projects / mit-scheme.git / commitdiff