From 6ff903f5f8bf3a1904bf6f4c3ac2d7d80e33a558 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Mon, 9 Aug 2010 16:47:03 +0000 Subject: [PATCH] Eliminate all traces of the archaic microcode state space support. --- src/microcode/boot.c | 1 - src/microcode/extern.h | 4 - src/microcode/fasload.c | 1 - src/microcode/fixobj.h | 12 +-- src/microcode/hooks.c | 147 ------------------------------ src/microcode/interp.c | 74 --------------- src/microcode/memmag.c | 2 - src/microcode/ntutl/makefile | 7 +- src/microcode/os2utl/makefile.cmn | 7 +- src/microcode/returns.h | 8 +- src/microcode/storage.c | 3 - src/microcode/utabmd.c | 1 - src/microcode/utils.c | 123 ------------------------- src/microcode/winder.h | 49 ---------- src/runtime/conpar.scm | 1 - src/runtime/framex.scm | 1 - 16 files changed, 16 insertions(+), 425 deletions(-) delete mode 100644 src/microcode/winder.h diff --git a/src/microcode/boot.c b/src/microcode/boot.c index a46aa4556..525996504 100644 --- a/src/microcode/boot.c +++ b/src/microcode/boot.c @@ -145,7 +145,6 @@ start_scheme (void) outf_console ("\n"); outf_flush_console (); } - current_state_point = SHARP_F; initialize_fixed_objects_vector (); if (option_fasl_file != 0) diff --git a/src/microcode/extern.h b/src/microcode/extern.h index 3fef79c09..9876b6ddc 100644 --- a/src/microcode/extern.h +++ b/src/microcode/extern.h @@ -149,8 +149,6 @@ extern SCHEME_OBJECT * stack_end; extern SCHEME_OBJECT * constant_alloc_next; extern SCHEME_OBJECT * constant_start; extern SCHEME_OBJECT * constant_end; - -extern SCHEME_OBJECT current_state_point; /* Address of the most recent return code in the stack. This is only meaningful while in compiled code. */ @@ -344,8 +342,6 @@ extern SCHEME_OBJECT * control_point_start (SCHEME_OBJECT); 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); diff --git a/src/microcode/fasload.c b/src/microcode/fasload.c index 3915f1f1b..faa21b6f6 100644 --- a/src/microcode/fasload.c +++ b/src/microcode/fasload.c @@ -202,7 +202,6 @@ can, however, be any file which can be loaded with BINARY-FASLOAD.") compiler_initialize (true); #endif fixed_objects = SHARP_F; - current_state_point = SHARP_F; /* Setup initial program */ SET_RC (RC_END_OF_COMPUTATION); diff --git a/src/microcode/fixobj.h b/src/microcode/fixobj.h index ea16df24c..7889f7248 100644 --- a/src/microcode/fixobj.h +++ b/src/microcode/fixobj.h @@ -46,8 +46,8 @@ USA. #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 */ @@ -63,7 +63,7 @@ USA. /* #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. */ @@ -143,8 +143,8 @@ USA. /* 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, \ @@ -160,7 +160,7 @@ USA. /* 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?", \ diff --git a/src/microcode/hooks.c b/src/microcode/hooks.c index 982182e2e..b0d0f3664 100644 --- a/src/microcode/hooks.c +++ b/src/microcode/hooks.c @@ -28,7 +28,6 @@ USA. #include "scheme.h" #include "prims.h" -#include "winder.h" #include "history.h" static SCHEME_OBJECT allocate_control_point (unsigned long, bool); @@ -363,152 +362,6 @@ memoized yet.") } } -/* 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\ - 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); - } -} - -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); - } -} - /* Interrupts */ DEFINE_PRIMITIVE ("GET-INTERRUPT-ENABLES", Prim_get_interrupt_enables, 0, 0, diff --git a/src/microcode/interp.c b/src/microcode/interp.c index 14058a871..9cffb914f 100644 --- a/src/microcode/interp.c +++ b/src/microcode/interp.c @@ -28,7 +28,6 @@ USA. #include "scheme.h" #include "trap.h" #include "lookup.h" -#include "winder.h" #include "history.h" extern void * obstack_chunk_alloc (size_t); @@ -1142,66 +1141,6 @@ Interpret (int pop_return_p) } } - 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); @@ -1355,19 +1294,6 @@ Interpret (int pop_return_p) 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 (); diff --git a/src/microcode/memmag.c b/src/microcode/memmag.c index ea8b921c4..657f759ec 100644 --- a/src/microcode/memmag.c +++ b/src/microcode/memmag.c @@ -294,7 +294,6 @@ std_gc_pt1 (void) 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); @@ -316,7 +315,6 @@ std_gc_pt2 (void) fixed_objects = (*saved_to++); history_register = (OBJECT_ADDRESS (*saved_to++)); - current_state_point = (*saved_to++); saved_to = 0; CC_TRANSPORT_END (); diff --git a/src/microcode/ntutl/makefile b/src/microcode/ntutl/makefile index 7b7d45a12..8f30b1be6 100644 --- a/src/microcode/ntutl/makefile +++ b/src/microcode/ntutl/makefile @@ -421,7 +421,6 @@ TRAP_H = trap.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) \ @@ -463,10 +462,10 @@ fasload.obj: fasload.c $(SCHEME_H) $(PRIMS_H) $(OSSCHEME_H) $(OSFILE_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) @@ -496,7 +495,7 @@ term.obj: term.c $(SCHEME_H) $(OSTOP_H) $(OSIO_H) $(OSFS_H) $(OSFILE_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) diff --git a/src/microcode/os2utl/makefile.cmn b/src/microcode/os2utl/makefile.cmn index a84b50953..904183d8b 100644 --- a/src/microcode/os2utl/makefile.cmn +++ b/src/microcode/os2utl/makefile.cmn @@ -357,7 +357,6 @@ TRAP_H = trap.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) \ @@ -401,11 +400,11 @@ fasload.$(OBJ): fasload.c $(SCHEME_H) $(PRIMS_H) $(OSSCHEME_H) $(OSFILE_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) \ @@ -435,7 +434,7 @@ term.$(OBJ): term.c $(SCHEME_H) $(OSTOP_H) $(OSIO_H) $(OSFS_H) $(OSFILE_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) diff --git a/src/microcode/returns.h b/src/microcode/returns.h index 8c59d5a08..e1641133f 100644 --- a/src/microcode/returns.h +++ b/src/microcode/returns.h @@ -66,8 +66,8 @@ USA. #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 */ @@ -146,8 +146,8 @@ USA. /* 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, \ diff --git a/src/microcode/storage.c b/src/microcode/storage.c index 39909b96c..f72b5e1e4 100644 --- a/src/microcode/storage.c +++ b/src/microcode/storage.c @@ -58,9 +58,6 @@ SCHEME_OBJECT * constant_alloc_next; 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; diff --git a/src/microcode/utabmd.c b/src/microcode/utabmd.c index a2c712a07..4d29a3ec4 100644 --- a/src/microcode/utabmd.c +++ b/src/microcode/utabmd.c @@ -155,7 +155,6 @@ initialize_fixed_objects_vector (void) 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); diff --git a/src/microcode/utils.c b/src/microcode/utils.c index 7c8a64d8a..5eac8950b 100644 --- a/src/microcode/utils.c +++ b/src/microcode/utils.c @@ -27,7 +27,6 @@ USA. #include "scheme.h" #include "prims.h" -#include "winder.h" #include "history.h" #include "syscall.h" @@ -921,128 +920,6 @@ record_primitive_entry (SCHEME_OBJECT primitive) #endif /* ENABLE_PRIMITIVE_PROFILING */ -/* 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*/ -} - #ifdef __WIN32__ #include diff --git a/src/microcode/winder.h b/src/microcode/winder.h deleted file mode 100644 index 1a6312a5e..000000000 --- a/src/microcode/winder.h +++ /dev/null @@ -1,49 +0,0 @@ -/* -*-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 diff --git a/src/runtime/conpar.scm b/src/runtime/conpar.scm index 27e61c2a0..6a9844d4a 100644 --- a/src/runtime/conpar.scm +++ b/src/runtime/conpar.scm @@ -825,7 +825,6 @@ USA. (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))) diff --git a/src/runtime/framex.scm b/src/runtime/framex.scm index 943486943..fc58b50e4 100644 --- a/src/runtime/framex.scm +++ b/src/runtime/framex.scm @@ -274,7 +274,6 @@ USA. (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))) -- 2.25.1