/* -*-C-*-
-$Id: bchmmg.c,v 9.100 2002/07/02 19:03:15 cph Exp $
+$Id: bchmmg.c,v 9.101 2002/07/02 20:48:43 cph Exp $
Copyright (c) 1987-2000, 2002 Massachusetts Institute of Technology
Will_Push (CONTINUATION_SIZE);
Store_Return (RC_NORMAL_GC_DONE);
- Store_Expression (LONG_TO_UNSIGNED_FIXNUM (MemTop - Free));
+ exp_register = (LONG_TO_UNSIGNED_FIXNUM (MemTop - Free));
Save_Cont ();
Pushed ();
/* -*-C-*-
-$Id: bchpur.c,v 9.71 2002/07/02 19:03:20 cph Exp $
+$Id: bchpur.c,v 9.72 2002/07/02 20:48:48 cph Exp $
Copyright (c) 1987-2000, 2002 Massachusetts Institute of Technology
Will_Push (CONTINUATION_SIZE);
Store_Return (RC_NORMAL_GC_DONE);
- Store_Expression (result);
+ exp_register = result;
Save_Cont ();
Pushed ();
/* -*-C-*-
-$Id: bkpt.c,v 9.31 2002/07/02 18:37:39 cph Exp $
+$Id: bkpt.c,v 9.32 2002/07/02 20:48:54 cph Exp $
Copyright (c) 1987-1999, 2002 Massachusetts Institute of Technology
SCHEME_OBJECT *Old_Stack = sp_register;
printf ("Pop Return Break: SP = 0x%lx\n", ((long) sp_register));
- (void) (Print_One_Continuation_Frame (Return));
+ (void) (Print_One_Continuation_Frame (ret_register));
sp_register = Old_Stack;
return;
}
/* -*-C-*-
-$Id: bkpt.h,v 9.33 2002/07/02 18:15:02 cph Exp $
+$Id: bkpt.h,v 9.34 2002/07/02 20:48:59 cph Exp $
Copyright (c) 1987-1999, 2002 Massachusetts Institute of Technology
#define Eval_Ucode_Hook() \
{ \
- (local_circle [local_slotno++]) = (Fetch_Expression ()); \
+ (local_circle [local_slotno++]) = exp_register; \
if (local_slotno >= debug_maxslots) \
local_slotno = 0; \
if (local_nslots < debug_maxslots) \
/* -*-C-*-
-$Id: boot.c,v 9.106 2002/07/02 18:37:45 cph Exp $
+$Id: boot.c,v 9.107 2002/07/02 20:49:05 cph Exp $
Copyright (c) 1988-2002 Massachusetts Institute of Technology
/* Setup registers */
INITIALIZE_INTERRUPTS ();
SET_INTERRUPT_MASK (0);
- Env = THE_GLOBAL_ENV;
+ env_register = THE_GLOBAL_ENV;
Trapping = false;
Return_Hook_Address = NULL;
/* Give the interpreter something to chew on, and ... */
Will_Push (CONTINUATION_SIZE);
Store_Return (RC_END_OF_COMPUTATION);
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Save_Cont ();
Pushed ();
- Store_Expression (expr);
+ exp_register = expr;
/* Go to it! */
if ((sp_register <= Stack_Guard) || (Free > MemTop))
SCHEME_OBJECT
DEFUN_VOID (Re_Enter_Interpreter)
{
- Interpret (true);
- return Val;
+ Interpret (1);
+ return (val_register);
}
\f
/* Garbage collection debugging utilities. */
/* -*-C-*-
-$Id: c.c,v 1.12 1999/01/02 06:11:34 cph Exp $
+$Id: c.c,v 1.13 2002/07/02 20:52:10 cph Exp $
-Copyright (c) 1992-1999 Massachusetts Institute of Technology
+Copyright (c) 1992-1999, 2002 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
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.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
*/
#include "liarc.h"
DEFUN (unspecified_code, (entry, dispatch),
SCHEME_OBJECT * entry AND unsigned long dispatch)
{
- Store_Expression ((SCHEME_OBJECT) entry);
+ exp_register = ((SCHEME_OBJECT) entry);
C_return_value = (ERR_EXECUTE_MANIFEST_VECTOR);
return (&dummy_entry);
}
{
if (entry != &dummy_entry)
{
- Store_Expression ((SCHEME_OBJECT) entry);
+ exp_register = ((SCHEME_OBJECT) entry);
C_return_value = (ERR_EXECUTE_MANIFEST_VECTOR);
}
return;
/* -*-C-*-
-$Id: cmpint.c,v 1.96 2002/07/02 18:37:52 cph Exp $
+$Id: cmpint.c,v 1.97 2002/07/02 20:49:11 cph Exp $
Copyright (c) 1989-2002 Massachusetts Institute of Technology
instruction * compiled_entry_address;
compiled_entry_address =
- ((instruction *) (OBJECT_ADDRESS (Fetch_Expression ())));
+ ((instruction *) (OBJECT_ADDRESS (exp_register)));
if ((COMPILED_ENTRY_FORMAT_WORD (compiled_entry_address)) !=
FORMAT_WORD_EXPR)
{
/* It self evaluates. */
- Val = (Fetch_Expression ());
+ val_register = exp_register;
ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ()));
}
ENTER_SCHEME (compiled_entry_address);
{ \
if (((long) (ADDR_TO_SCHEME_ADDR (Free))) \
>= ((long) (Regs[REGBLOCK_MEMTOP]))) \
- return (compiler_interrupt_common (0, Val)); \
+ return (compiler_interrupt_common (0, val_register)); \
else \
RETURN_TO_SCHEME (OBJECT_ADDRESS (STACK_POP ())); \
} while (0)
SCHEME_OBJECT primitive
AND long ignore_2 AND long ignore_3 AND long ignore_4)
{
- PRIMITIVE_APPLY (Val, primitive);
+ PRIMITIVE_APPLY (val_register, primitive);
POP_PRIMITIVE_FRAME (PRIMITIVE_ARITY (primitive));
INVOKE_RETURN_ADDRESS ();
}
SCHEME_OBJECT primitive
AND long ignore_2 AND long ignore_3 AND long ignore_4)
{
- PRIMITIVE_APPLY (Val, primitive);
+ PRIMITIVE_APPLY (val_register, primitive);
POP_PRIMITIVE_FRAME (((long) Regs[REGBLOCK_LEXPR_ACTUALS]));
INVOKE_RETURN_ADDRESS ();
}
STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM (count + 1));
STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM (total_count));
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Store_Return (RC_COMP_LINK_CACHES_RESTART);
Save_Cont ();
unsigned long offset;
#ifdef AUTOCLOBBER_BUG
- block_address[OBJECT_DATUM (* block_address)] = Regs[REGBLOCK_ENV];
+ block_address[OBJECT_DATUM (* block_address)] = env_register;
#endif
offset = (constant_address - block_address);
(void) STACK_POP (); /* Loop count, for debugger */
block = (STACK_POP ());
environment = (compiled_block_environment (block));
- Store_Env (environment);
+ env_register = environment;
offset = (OBJECT_DATUM (STACK_POP ()));
last_header_offset = (OBJECT_DATUM (STACK_POP ()));
sections = (OBJECT_DATUM (STACK_POP ()));
STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM (nargs));
STACK_PUSH (compiled_block_environment (block));
STACK_PUSH (compiler_var_error (cache, block, CACHE_REFERENCES_OPERATOR));
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Store_Return (RC_COMP_OP_REF_TRAP_RESTART);
Save_Cont ();
RETURN_TO_C (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
+ (start of continuation, procedure, etc.). The exp_register
saved with the continuation is a piece of state that will be
- returned to Val and Env (both) upon return.
+ returned to val_register and env_register (both) upon return.
*/
#define MAYBE_REQUEST_INTERRUPTS() \
STACK_PUSH (ENTRY_TO_OBJECT (entry_point));
}
STACK_PUSH (state);
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Store_Return (RC_COMP_INTERRUPT_RESTART);
Save_Cont ();
RETURN_TO_C (PRIM_INTERRUPT);
return (compiler_interrupt_common (entry_point_raw, SHARP_F));
}
-/* Val has live data, and there is no entry address on the stack */
+/* val_register has live data, and there is no entry address on the stack */
SCHEME_UTILITY utility_result
DEFNX (comutil_interrupt_continuation,
long ignore_3 AND
long ignore_4)
{
- return (compiler_interrupt_common (return_address_raw, Val));
+ return (compiler_interrupt_common (return_address_raw, val_register));
}
-/* Env has live data; no entry point on the stack */
+/* env_register has live data; no entry point on the stack */
SCHEME_UTILITY utility_result
DEFNX (comutil_interrupt_ic_procedure,
long ignore_3 AND
long ignore_4)
{
- return (compiler_interrupt_common (entry_point_raw, (Fetch_Env ())));
+ return (compiler_interrupt_common (entry_point_raw, env_register));
}
SCHEME_UTILITY utility_result
long ignore_3 AND
long ignore_4)
{
- return (compiler_interrupt_common (0, Val));
+ return (compiler_interrupt_common (0, val_register));
}
C_TO_SCHEME long
DEFUN_VOID (comp_interrupt_restart)
{
SCHEME_OBJECT state = (STACK_POP ());
- Store_Env (state);
- Val = state;
+ env_register = state;
+ val_register = state;
ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ()));
}
\f
SCHEME_OBJECT cache
= (MAKE_POINTER_OBJECT
(CACHE_TYPE, (SCHEME_ADDR_TO_ADDR (cache_addr_raw))));
- long code = (compiler_assignment_trap (cache, value, (&Val)));
+ long code = (compiler_assignment_trap (cache, value, (&val_register)));
if (code == PRIM_DONE)
RETURN_TO_SCHEME (return_address);
else
STACK_PUSH (compiled_block_environment (block));
STACK_PUSH
(compiler_var_error (cache, block, CACHE_REFERENCES_ASSIGNMENT));
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Store_Return (RC_COMP_ASSIGNMENT_TRAP_RESTART);
Save_Cont ();
RETURN_TO_C (code);
SCHEME_OBJECT name = (STACK_POP ());
SCHEME_OBJECT environment = (STACK_POP ());
SCHEME_OBJECT value = (STACK_POP ());
- long code = (assign_variable (environment, name, value, (&Val)));
+ long code = (assign_variable (environment, name, value, (&val_register)));
if (code == PRIM_DONE)
ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ()));
else
STACK_PUSH (value);
STACK_PUSH (environment);
STACK_PUSH (name);
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Store_Return (RC_COMP_ASSIGNMENT_TRAP_RESTART);
Save_Cont ();
return (code);
STACK_PUSH (compiled_block_environment (block));
STACK_PUSH
(compiler_var_error (cache, block, CACHE_REFERENCES_OPERATOR));
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Store_Return (RC_COMP_CACHE_REF_APPLY_RESTART);
Save_Cont ();
RETURN_TO_C (code);
{
STACK_PUSH (environment);
STACK_PUSH (name);
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Store_Return (RC_COMP_CACHE_REF_APPLY_RESTART);
Save_Cont ();
return (code);
SCHEME_OBJECT cache \
= (MAKE_POINTER_OBJECT \
(CACHE_TYPE, (SCHEME_ADDR_TO_ADDR (cache_addr_raw)))); \
- long code = (c_trap (cache, (&Val))); \
+ long code = (c_trap (cache, (&val_register))); \
if (code == PRIM_DONE) \
RETURN_TO_SCHEME (return_address); \
else \
STACK_PUSH \
(compiler_var_error \
(cache, block, CACHE_REFERENCES_LOOKUP)); \
- Store_Expression (SHARP_F); \
+ exp_register = SHARP_F; \
Store_Return (ret_code); \
Save_Cont (); \
RETURN_TO_C (code); \
C_TO_SCHEME long \
DEFUN_VOID (restart) \
{ \
- SCHEME_OBJECT name = (Fetch_Expression ()); \
+ SCHEME_OBJECT name = exp_register; \
SCHEME_OBJECT environment = (STACK_POP ()); \
- long code = (c_lookup (environment, name, (&Val))); \
+ long code = (c_lookup (environment, name, (&val_register))); \
if (code == PRIM_DONE) \
ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ())); \
else \
{ \
STACK_PUSH (environment); \
STACK_PUSH (name); \
- Store_Expression (SHARP_F); \
+ exp_register = SHARP_F; \
Store_Return (ret_code); \
Save_Cont (); \
return (code); \
= ((instruction *) (SCHEME_ADDR_TO_ADDR (ret_add_raw))); \
long code; \
\
- code = (c_proc (environment, variable, (&Val))); \
+ code = (c_proc (environment, variable, (&val_register))); \
if (code == PRIM_DONE) \
{ \
RETURN_TO_SCHEME (ret_add); \
STACK_PUSH (ENTRY_TO_OBJECT (ret_add)); \
STACK_PUSH (variable); \
STACK_PUSH (environment); \
- Store_Expression (SHARP_F); \
+ exp_register = SHARP_F; \
Store_Return (ret_code); \
Save_Cont (); \
RETURN_TO_C (code); \
\
environment = (STACK_POP ()); \
variable = (STACK_POP ()); \
- code = (c_proc (environment, variable, (&Val))); \
+ code = (c_proc (environment, variable, (&val_register))); \
if (code == PRIM_DONE) \
{ \
- Regs[REGBLOCK_ENV] = environment; \
+ env_register = environment; \
ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ())); \
} \
else \
{ \
STACK_PUSH (variable); \
STACK_PUSH (environment); \
- Store_Expression (SHARP_F); \
+ exp_register = SHARP_F; \
Store_Return (ret_code); \
Save_Cont (); \
return (code); \
STACK_PUSH (value); \
STACK_PUSH (variable); \
STACK_PUSH (environment); \
- Store_Expression (SHARP_F); \
+ exp_register = SHARP_F; \
Store_Return (ret_code); \
Save_Cont (); \
RETURN_TO_C (code); \
SCHEME_OBJECT environment, variable, value; \
long code; \
\
- environment = (Fetch_Expression ()); \
+ environment = exp_register; \
variable = (STACK_POP ()); \
value = (STACK_POP ()); \
code = (c_proc (environment, variable, value)); \
if (code == PRIM_DONE) \
{ \
- Regs[REGBLOCK_ENV] = environment; \
+ env_register = environment; \
ENTER_SCHEME (OBJECT_ADDRESS (STACK_POP ())); \
} \
else \
STACK_PUSH (value); \
STACK_PUSH (variable); \
STACK_PUSH (environment); \
- Store_Expression (SHARP_F); \
+ exp_register = SHARP_F; \
Store_Return (ret_code); \
Save_Cont (); \
return (code); \
compiler_assign_variable (SCHEME_OBJECT environment, SCHEME_OBJECT symbol,
SCHEME_OBJECT value)
{
- return (assign_variable (environment, symbol, value, (&Val)));
+ return (assign_variable (environment, symbol, value, (&val_register)));
}
CMPLR_ASSIGNMENT(comutil_assignment,
{
long result = (define_variable (environment, symbol, value));
if (result == PRIM_DONE)
- Val = symbol;
+ val_register = symbol;
return (result);
}
SCHEME_OBJECT environment AND SCHEME_OBJECT variable
AND long nactuals AND long ignore_4)
{
- long code = (lookup_variable (environment, variable, (&Val)));
+ long code = (lookup_variable (environment, variable, (&val_register)));
if (code == PRIM_DONE)
- return (comutil_apply (Val, nactuals, 0, 0));
+ return (comutil_apply (val_register, nactuals, 0, 0));
{
STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM (nactuals));
STACK_PUSH (variable);
STACK_PUSH (environment);
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Store_Return (RC_COMP_LOOKUP_APPLY_RESTART);
Save_Cont ();
RETURN_TO_C (code);
{
STACK_PUSH (variable);
STACK_PUSH (environment);
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Store_Return (RC_COMP_LOOKUP_APPLY_RESTART);
Save_Cont ();
return (code);
STACK_PUSH (ENTRY_TO_OBJECT (ret_add));
STACK_PUSH (primitive);
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Store_Return (RC_COMP_ERROR_RESTART);
Save_Cont ();
RETURN_TO_C (ERR_COMPILED_CODE_ERROR);
state = (MAKE_POINTER_OBJECT
(TC_STACK_ENVIRONMENT, (SCHEME_ADDR_TO_ADDR (state_raw))));
else
- state = Val;
+ state = val_register;
stack_ptr = (MAKE_POINTER_OBJECT (TC_STACK_ENVIRONMENT, sp_register));
STACK_PUSH (state); /* state to preserve */
/* -*-C-*-
-$Id: cmpint.h,v 10.8 2002/07/02 18:37:58 cph Exp $
+$Id: cmpint.h,v 10.9 2002/07/02 20:49:17 cph Exp $
Copyright (c) 1987-1990, 1999, 2000, 2002 Massachusetts Institute of Technology
long segment_size; \
\
Restore_Cont(); \
- segment_size = OBJECT_DATUM (Fetch_Expression()); \
+ segment_size = OBJECT_DATUM (exp_register); \
last_return_code = (STACK_LOC (segment_size)); \
/* Undo the subproblem rotation. */ \
Compiler_End_Subproblem(); \
#define compiled_code_restart() \
{ \
- long segment_size = OBJECT_DATUM (Fetch_Expression()); \
+ long segment_size = OBJECT_DATUM (exp_register); \
last_return_code = (STACK_LOC (segment_size)); \
/* Undo the subproblem rotation. */ \
Compiler_End_Subproblem(); \
long segment_size = \
(STACK_LOCATIVE_DIFFERENCE \
(last_return_code, (STACK_LOC (0)))); \
- Store_Expression (LONG_TO_UNSIGNED_FIXNUM (segment_size)); \
+ exp_register = (LONG_TO_UNSIGNED_FIXNUM (segment_size)); \
Store_Return (RC_REENTER_COMPILED_CODE); \
Save_Cont (); \
}); \
{ \
long segment_size = \
(STACK_LOCATIVE_DIFFERENCE (last_return_code, (STACK_LOC (0)))); \
- Store_Expression (LONG_TO_UNSIGNED_FIXNUM (segment_size)); \
+ exp_register = (LONG_TO_UNSIGNED_FIXNUM (segment_size)); \
Store_Return (RC_REENTER_COMPILED_CODE); \
Save_Cont (); \
/* Rotate history to a new subproblem. */ \
Restore_Cont(); \
segment_size = \
(STACK_LOCATIVE_DIFFERENCE (last_return_code, (STACK_LOC (0)))); \
- Store_Expression (LONG_TO_UNSIGNED_FIXNUM (segment_size)); \
+ exp_register = (LONG_TO_UNSIGNED_FIXNUM (segment_size)); \
/* The Store_Return is a NOP, the Save_Cont is done by the code \
that follows. */ \
- /* Store_Return (OBJECT_DATUM (Fetch_Return ())); */ \
+ /* Store_Return (OBJECT_DATUM (ret_register)); */ \
/* Save_Cont (); */ \
Compiler_New_Subproblem (); \
}
/* -*-C-*-
-$Id: hppa.h,v 1.51 1999/01/02 06:06:43 cph Exp $
+$Id: hppa.h,v 1.52 2002/07/02 20:51:54 cph Exp $
-Copyright (c) 1989-1999 Massachusetts Institute of Technology
+Copyright (c) 1989-1999, 2002 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
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.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
*/
/*
buffer[len - 2] = ((unsigned long) clos_entry);
buffer[len - 1] = real_entry_point;
- Val = SHARP_F;
+ val_register = SHARP_F;
* value = ((unsigned long) buffer);
return (TRUE);
}
cache_flush_region (((PTR) buffer), (len - 1), (D_CACHE | I_CACHE));
buffer[len - 1] = (((unsigned long) (OBJECT_ADDRESS (ep))) + 4);
- Val = state;
+ val_register = state;
* value = ((unsigned long) buffer);
return (TRUE);
}
buffer[len - 1] = ((((unsigned long) instrs) + 8)
+ offset);
- Val = state;
+ val_register = state;
* value = ((unsigned long) &buffer[clobber]);
return (TRUE);
}
/* -*-C-*-
-$Id: debug.c,v 9.54 2002/07/02 18:38:03 cph Exp $
+$Id: debug.c,v 9.55 2002/07/02 20:49:22 cph Exp $
Copyright (c) 1987-2002 Massachusetts Institute of Technology
DEFUN (Print_Return, (String), char * String)
{
outf_console ("%s: ", String);
- print_return_name (console_output, Fetch_Return ());
+ print_return_name (console_output, ret_register);
outf_console ("\n");
}
\f
/* -*-C-*-
-$Id: dmpwrld.c,v 9.40 2000/12/05 21:23:44 cph Exp $
+$Id: dmpwrld.c,v 9.41 2002/07/02 20:49:27 cph Exp $
-Copyright (c) 1987-2000 Massachusetts Institute of Technology
+Copyright (c) 1987-2000, 2002 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
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.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
*/
/* This file contains a primitive to dump an executable version of Scheme.
saved_dumped_p = scheme_dumped_p;
scheme_dumped_p = true;
- Val = SHARP_T;
+ val_register = SHARP_T;
POP_PRIMITIVE_FRAME (1);
/* Dump! */
/* Restore State */
- Val = SHARP_F;
+ val_register = SHARP_F;
scheme_dumped_p = saved_dumped_p;
/* IO: Restoring cached input for this job. */
/* -*-C-*-
-$Id: fasload.c,v 9.93 2002/07/02 19:03:26 cph Exp $
+$Id: fasload.c,v 9.94 2002/07/02 20:49:32 cph Exp $
Copyright (c) 1987-2002 Massachusetts Institute of Technology
Current_State_Point = SHARP_F;
/* Setup initial program */
Store_Return (RC_END_OF_COMPUTATION);
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Save_Cont ();
- Store_Expression (MEMORY_REF (result, 0));
- Store_Env (THE_GLOBAL_ENV);
+ exp_register = (MEMORY_REF (result, 0));
+ env_register = THE_GLOBAL_ENV;
/* Clear various interpreter state parameters. */
Trapping = false;
Return_Hook_Address = 0;
/* -*-C-*-
-$Id: fhooks.c,v 9.34 1999/01/02 06:11:34 cph Exp $
+$Id: fhooks.c,v 9.35 2002/07/02 20:49:37 cph Exp $
-Copyright (c) 1988, 1989, 1990, 1999 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990, 1999, 2002 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
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.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
*/
/* This file contains hooks and handles for the new fluid bindings
POP_PRIMITIVE_FRAME (1);
Will_Push (CONTINUATION_SIZE + STACK_ENV_EXTRA_SLOTS + 1);
/* Save previous fluid bindings for later restore */
- Store_Expression (Fluid_Bindings);
+ exp_register = Fluid_Bindings;
Store_Return (RC_RESTORE_FLUIDS);
Save_Cont ();
/* Invoke the thunk. */
/* -*-C-*-
-$Id: futures.h,v 9.29 1999/01/02 06:11:34 cph Exp $
+$Id: futures.h,v 9.30 2002/07/02 20:49:42 cph Exp $
-Copyright (c) 1987, 1988, 1989, 1990, 1999 Massachusetts Institute of Technology
+Copyright (c) 1987-1990, 1999, 2002 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
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.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
*/
/* This file contains macros useful for dealing with futures */
} \
else \
{ \
- Val = Value; \
+ val_register = Value; \
PRIMITIVE_ABORT (PRIM_TOUCH); \
} \
} \
/* -*-C-*-
-$Id: history.h,v 9.30 2002/07/02 19:03:32 cph Exp $
+$Id: history.h,v 9.31 2002/07/02 20:49:47 cph Exp $
Copyright (c) 1987-1990, 1999, 2002 Massachusetts Institute of Technology
: (MAKE_POINTER_OBJECT \
(TC_CONTROL_POINT, Prev_Restore_History_Stacklet))); \
STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM (Prev_Restore_History_Offset)); \
- Store_Expression \
- (MAKE_POINTER_OBJECT (UNMARKED_HISTORY_TYPE, history_register)); \
+ exp_register \
+ = (MAKE_POINTER_OBJECT (UNMARKED_HISTORY_TYPE, history_register)); \
Store_Return (Return_Code); \
Save_Cont (); \
history_register \
/* -*-C-*-
-$Id: hooks.c,v 9.62 2002/07/02 19:03:38 cph Exp $
+$Id: hooks.c,v 9.63 2002/07/02 20:49:53 cph Exp $
Copyright (c) 1988-2002 Massachusetts Institute of Technology
STACK_RESET ();
Will_Push (CONTINUATION_SIZE);
Store_Return (RC_JOIN_STACKLETS);
- Store_Expression (control_point);
+ exp_register = control_point;
Save_Cont ();
Pushed ();
}
CLEAR_INTERRUPT (INT_Stack_Overflow);
Will_Push (CONTINUATION_SIZE);
- Store_Expression (control_point);
+ exp_register = control_point;
Store_Return (RC_JOIN_STACKLETS);
Save_Cont ();
Pushed ();
fast SCHEME_OBJECT expression = (ARG_REF (1));
fast SCHEME_OBJECT environment = (ARG_REF (2));
POP_PRIMITIVE_FRAME (2);
- Store_Env (environment);
- Store_Expression (expression);
+ env_register = environment;
+ exp_register = expression;
}
PRIMITIVE_ABORT (PRIM_DO_EXPRESSION);
/*NOTREACHED*/
POP_PRIMITIVE_FRAME (1);
Will_Push (CONTINUATION_SIZE + STACK_ENV_EXTRA_SLOTS + 1);
Store_Return (RC_SNAP_NEED_THUNK);
- Store_Expression (thunk);
+ exp_register = thunk;
Save_Cont ();
STACK_PUSH (MEMORY_REF (thunk, THUNK_VALUE));
STACK_PUSH (STACK_FRAME_HEADER);
POP_PRIMITIVE_FRAME (1);
Will_Push (CONTINUATION_SIZE);
Store_Return (RC_SNAP_NEED_THUNK);
- Store_Expression (thunk);
+ exp_register = thunk;
Save_Cont ();
Pushed ();
- Store_Env (FAST_MEMORY_REF (thunk, THUNK_ENVIRONMENT));
- Store_Expression (FAST_MEMORY_REF (thunk, THUNK_PROCEDURE));
+ env_register = (FAST_MEMORY_REF (thunk, THUNK_ENVIRONMENT));
+ exp_register = (FAST_MEMORY_REF (thunk, THUNK_PROCEDURE));
PRIMITIVE_ABORT (PRIM_DO_EXPRESSION);
/*NOTREACHED*/
PRIMITIVE_RETURN (UNSPECIFIC);
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 */
- Store_Expression (old_point);
+ exp_register = old_point;
Store_Return (RC_RESTORE_TO_STATE_POINT);
Save_Cont ();
/* Push a stack frame which will call the body after we have moved
STACK_PUSH (during_thunk);
STACK_PUSH (STACK_FRAME_HEADER);
/* Push the continuation to go with the stack frame */
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Store_Return (RC_INTERNAL_APPLY);
Save_Cont ();
Pushed ();
{
SCHEME_OBJECT thunk = (STACK_POP ());
STACK_PUSH (STACK_FRAME_HEADER + (nargs - 2));
- Store_Env (THE_NULL_ENV);
- Store_Expression (SHARP_F);
+ env_register = THE_NULL_ENV;
+ exp_register = SHARP_F;
Store_Return (RC_INTERNAL_APPLY);
Save_Cont ();
Will_Push (STACK_ENV_EXTRA_SLOTS + 1);
PRIMITIVE_HEADER (1);
PRIMITIVE_CANONICALIZE_CONTEXT ();
CHECK_ARG (1, HUNK3_P);
- Val = (*history_register);
+ val_register = (*history_register);
#ifndef DISABLE_HISTORY
history_register = (OBJECT_ADDRESS (ARG_REF (1)));
#else
/* -*-C-*-
-$Id: intercom.c,v 9.31 1999/01/02 06:11:34 cph Exp $
+$Id: intercom.c,v 9.32 2002/07/02 20:49:58 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-1999, 2002 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
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.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
*/
/* Single-processor simulation of locking, propagating, and
POP_PRIMITIVE_FRAME (3);
Will_Push (CONTINUATION_SIZE + STACK_ENV_EXTRA_SLOTS + 1);
Store_Return (RC_FINISH_GLOBAL_INT);
- Store_Expression (LONG_TO_UNSIGNED_FIXNUM (Which_Level));
+ exp_register = (LONG_TO_UNSIGNED_FIXNUM (Which_Level));
Save_Cont ();
STACK_PUSH (test);
STACK_PUSH (STACK_FRAME_HEADER);
STACK_PUSH (SHARP_F);
STACK_PUSH (primitive);
STACK_PUSH (STACK_FRAME_HEADER + 1);
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Store_Return (RC_INTERNAL_APPLY);
Save_Cont ();
/* Invoke the thunk. */
/* -*-C-*-
-$Id: interp.c,v 9.93 2002/07/02 18:15:13 cph Exp $
+$Id: interp.c,v 9.94 2002/07/02 20:50:03 cph Exp $
Copyright (c) 1988-2002 Massachusetts Institute of Technology
Store_Return(Return_Code); \
Save_Cont(); \
Store_Return(RC_RESTORE_VALUE); \
- (Registers[REGBLOCK_EXPR]) = temp; \
+ exp_register = temp; \
Save_Cont(); \
}
#define Prepare_Eval_Repeat() \
{ \
Will_Push(CONTINUATION_SIZE+1); \
- STACK_PUSH (Registers[REGBLOCK_ENV]); \
+ STACK_PUSH (env_register); \
Store_Return(RC_EVAL_ERROR); \
Save_Cont(); \
Pushed(); \
\f
#define Reduces_To(Expr) \
{ \
- (Registers[REGBLOCK_EXPR]) = Expr; \
- New_Reduction \
- ((Registers[REGBLOCK_EXPR]), (Registers[REGBLOCK_ENV])); \
+ exp_register = Expr; \
+ New_Reduction (exp_register, env_register); \
goto Do_Expression; \
}
-#define Reduces_To_Nth(N) \
- Reduces_To(FAST_MEMORY_REF ((Registers[REGBLOCK_EXPR]), (N)))
+#define Reduces_To_Nth(N) (Reduces_To (FAST_MEMORY_REF (exp_register, (N))))
#define Do_Nth_Then(Return_Code, N, Extra) \
{ \
Store_Return (Return_Code); \
Save_Cont (); \
- (Registers[REGBLOCK_EXPR]) \
- = (FAST_MEMORY_REF ((Registers[REGBLOCK_EXPR]), (N))); \
- New_Subproblem \
- ((Registers[REGBLOCK_EXPR]), (Registers[REGBLOCK_ENV])); \
+ exp_register = (FAST_MEMORY_REF (exp_register, (N))); \
+ New_Subproblem (exp_register, env_register); \
Extra; \
goto Do_Expression; \
}
{ \
Store_Return (Return_Code); \
Save_Cont (); \
- (Registers[REGBLOCK_EXPR]) \
- = (FAST_MEMORY_REF ((Registers[REGBLOCK_EXPR]), (N))); \
- Reuse_Subproblem \
- ((Registers[REGBLOCK_EXPR]), (Registers[REGBLOCK_ENV])); \
+ exp_register = (FAST_MEMORY_REF (exp_register, (N))); \
+ Reuse_Subproblem (exp_register, env_register); \
goto Do_Expression; \
}
\f
#define Pop_Return_Val_Check() \
{ \
- SCHEME_OBJECT Orig_Val = Val; \
+` SCHEME_OBJECT Orig_Val = val_register; \
\
- while (OBJECT_TYPE (Val) == TC_FUTURE) \
+ while (OBJECT_TYPE (val_register) == TC_FUTURE) \
{ \
- if (Future_Has_Value(Val)) \
+ if (Future_Has_Value(val_register)) \
{ \
- if (Future_Is_Keep_Slot(Val)) \
+ if (Future_Is_Keep_Slot(val_register)) \
{ \
- Log_Touch_Of_Future(Val); \
+ Log_Touch_Of_Future(val_register); \
} \
- Val = Future_Value(Val); \
+ val_register = Future_Value(val_register); \
} \
else \
{ \
Save_Cont(); \
Will_Push(CONTINUATION_SIZE + (STACK_ENV_EXTRA_SLOTS + 2)); \
Store_Return(RC_RESTORE_VALUE); \
- (Registers[REGBLOCK_EXPR]) = Orig_Val; \
+ exp_register = Orig_Val; \
Save_Cont(); \
- STACK_PUSH (Val); \
+ STACK_PUSH (val_register); \
STACK_PUSH (Get_Fixed_Obj_Slot(System_Scheduler)); \
STACK_PUSH (STACK_FRAME_HEADER + 1); \
Pushed(); \
}
\f
/* This saves stuff unnecessarily in most cases.
- For example, when Which_Way is PRIM_APPLY, Val, Env, Expr,
- and Return_Code are undefined.
- */
+ For example, when Which_Way is PRIM_APPLY, val_register,
+ env_register, exp_register, and ret_register are undefined. */
#define LOG_FUTURES() \
{ \
{ \
Save_Cont(); \
Will_Push(CONTINUATION_SIZE + 2); \
- STACK_PUSH (Val); \
- STACK_PUSH (Registers[REGBLOCK_ENV]); \
+ STACK_PUSH (val_register); \
+ STACK_PUSH (env_register); \
Store_Return (RC_REPEAT_DISPATCH); \
- (Registers[REGBLOCK_EXPR]) \
- = (LONG_TO_FIXNUM (CODE_MAP (Which_Way))); \
+ exp_register = (LONG_TO_FIXNUM (CODE_MAP (Which_Way))); \
Save_Cont(); \
Pushed(); \
Call_Future_Logging(); \
/* Primitives jump back here for errors, requests to evaluate an
* expression, apply a function, or handle an interrupt request. On
* errors or interrupts they leave their arguments on the stack, the
- * primitive itself in Expression. The code should do a primitive
+ * primitive itself in exp_register. The code should do a primitive
* backout in these cases, but not in others (apply, eval, etc.), since
* the primitive itself will have left the state of the interpreter ready
* for operation.
goto Apply_Non_Trapping;
case PRIM_DO_EXPRESSION:
- Val = (Registers[REGBLOCK_EXPR]);
+ val_register = exp_register;
PROCEED_AFTER_PRIMITIVE();
case CODE_MAP(PRIM_DO_EXPRESSION):
- Reduces_To(Val);
+ Reduces_To(val_register);
case PRIM_NO_TRAP_EVAL:
- Val = (Registers[REGBLOCK_EXPR]);
+ val_register = exp_register;
PROCEED_AFTER_PRIMITIVE();
case CODE_MAP(PRIM_NO_TRAP_EVAL):
- New_Reduction(Val, (Registers[REGBLOCK_ENV]));
+ New_Reduction(val_register, env_register);
goto Eval_Non_Trapping;
case 0: /* first time */
{
SCHEME_OBJECT temp;
- temp = Val;
+ temp = val_register;
BACK_OUT_AFTER_PRIMITIVE();
- Val = temp;
+ val_register = temp;
LOG_FUTURES();
}
/* fall through */
case CODE_MAP(PRIM_TOUCH):
- TOUCH_SETUP(Val);
+ TOUCH_SETUP(val_register);
goto Internal_Apply;
case PRIM_INTERRUPT:
if (0 && Eval_Debug)
{
- Print_Expression ((Registers[REGBLOCK_EXPR]), "Eval, expression");
+ Print_Expression (exp_register, "Eval, expression");
outf_console ("\n");
}
- /* The expression register has an Scode item in it which
- * should be evaluated and the result left in Val.
+ /* exp_register has an Scode item in it that
+ * should be evaluated and the result left in val_register.
*
* A "break" after the code for any operation indicates that
* all processing for this operation has been completed, and
* the current Scode item is the value returned when the
* new expression is evaluated. Therefore no new
* continuation is created and processing continues at
- * Do_Expression with the new expression in the expression
- * register.
+ * Do_Expression with the new expression in exp_register.
*
* Finally, an operation can terminate with a Do_Nth_Then
* macro. This indicates that another expression must be
* performed before the value of this S-Code item available.
* Thus a new continuation is created and placed on the
* stack (using Save_Cont), the new expression is placed in
- * the Expression register, and processing continues at
- * Do_Expression.
+ * the exp_register, and processing continues at Do_Expression.
*/
/* Handling of Eval Trapping.
{
Stop_Trapping ();
Will_Push (4);
- STACK_PUSH (Registers[REGBLOCK_ENV]);
- STACK_PUSH (Registers[REGBLOCK_EXPR]);
+ STACK_PUSH (env_register);
+ STACK_PUSH (exp_register);
STACK_PUSH (Fetch_Eval_Trapper ());
STACK_PUSH (STACK_FRAME_HEADER + 2);
Pushed ();
Eval_Non_Trapping:
Eval_Ucode_Hook();
- switch (OBJECT_TYPE (Registers[REGBLOCK_EXPR]))
+ switch (OBJECT_TYPE (exp_register))
{
default:
#if 0
case TC_VECTOR:
case TC_VECTOR_16B:
case TC_VECTOR_1B:
- Val = (Registers[REGBLOCK_EXPR]);
+ val_register = exp_register;
break;
case TC_ACCESS:
case TC_ASSIGNMENT:
Will_Push(CONTINUATION_SIZE + 1);
- STACK_PUSH (Registers[REGBLOCK_ENV]);
+ STACK_PUSH (env_register);
Do_Nth_Then(RC_EXECUTE_ASSIGNMENT_FINISH, ASSIGN_VALUE, Pushed());
case TC_BROKEN_HEART:
case TC_COMBINATION:
{
- long Array_Length;
-
- Array_Length = (VECTOR_LENGTH (Registers[REGBLOCK_EXPR]) - 1);
+ long Array_Length = ((VECTOR_LENGTH (exp_register)) - 1);
#ifdef USE_STACKLETS
/* Finger */
Eval_GC_Check
STACK_PUSH (STACK_FRAME_HEADER); /* Frame size */
Do_Nth_Then(RC_COMB_APPLY_FUNCTION, COMB_FN_SLOT, {});
}
- STACK_PUSH (Registers[REGBLOCK_ENV]);
+ STACK_PUSH (env_register);
Do_Nth_Then(RC_COMB_SAVE_VALUE, Array_Length+1, {});
}
case TC_COMBINATION_1:
Will_Eventually_Push(CONTINUATION_SIZE + STACK_ENV_FIRST_ARG + 1);
- STACK_PUSH (Registers[REGBLOCK_ENV]);
+ STACK_PUSH (env_register);
Do_Nth_Then(RC_COMB_1_PROCEDURE, COMB_1_ARG_1, {});
case TC_COMBINATION_2:
Will_Eventually_Push(CONTINUATION_SIZE + STACK_ENV_FIRST_ARG + 2);
- STACK_PUSH (Registers[REGBLOCK_ENV]);
+ STACK_PUSH (env_register);
Do_Nth_Then(RC_COMB_2_FIRST_OPERAND, COMB_2_ARG_2, {});
case TC_COMMENT:
case TC_CONDITIONAL:
Will_Push(CONTINUATION_SIZE + 1);
- STACK_PUSH (Registers[REGBLOCK_ENV]);
+ STACK_PUSH (env_register);
Do_Nth_Then(RC_CONDITIONAL_DECIDE, COND_PREDICATE, Pushed());
case TC_COMPILED_ENTRY:
{
- SCHEME_OBJECT compiled_expression;
-
- compiled_expression = (Registers[REGBLOCK_EXPR]);
+ SCHEME_OBJECT compiled_expression = exp_register;
execute_compiled_setup();
- (Registers[REGBLOCK_EXPR]) = compiled_expression;
+ exp_register = compiled_expression;
Which_Way = enter_compiled_expression();
goto return_from_compiled_code;
}
case TC_DEFINITION:
Will_Push(CONTINUATION_SIZE + 1);
- STACK_PUSH (Registers[REGBLOCK_ENV]);
+ STACK_PUSH (env_register);
Do_Nth_Then(RC_EXECUTE_DEFINITION_FINISH, DEFINE_VALUE, Pushed());
case TC_DELAY:
/* Deliberately omitted: Eval_GC_Check(2); */
- Val = MAKE_POINTER_OBJECT (TC_DELAYED, Free);
- Free[THUNK_ENVIRONMENT] = (Registers[REGBLOCK_ENV]);
- Free[THUNK_PROCEDURE] =
- FAST_MEMORY_REF ((Registers[REGBLOCK_EXPR]), DELAY_OBJECT);
+ val_register = MAKE_POINTER_OBJECT (TC_DELAYED, Free);
+ Free[THUNK_ENVIRONMENT] = env_register;
+ Free[THUNK_PROCEDURE] = (FAST_MEMORY_REF (exp_register, DELAY_OBJECT));
Free += 2;
break;
case TC_DISJUNCTION:
Will_Push(CONTINUATION_SIZE + 1);
- STACK_PUSH (Registers[REGBLOCK_ENV]);
+ STACK_PUSH (env_register);
Do_Nth_Then(RC_DISJUNCTION_DECIDE, OR_PREDICATE, Pushed());
case TC_EXTENDED_LAMBDA: /* Close the procedure */
/* Deliberately omitted: Eval_GC_Check(2); */
- Val = MAKE_POINTER_OBJECT (TC_EXTENDED_PROCEDURE, Free);
- Free[PROCEDURE_LAMBDA_EXPR] = (Registers[REGBLOCK_EXPR]);
- Free[PROCEDURE_ENVIRONMENT] = (Registers[REGBLOCK_ENV]);
+ val_register = MAKE_POINTER_OBJECT (TC_EXTENDED_PROCEDURE, Free);
+ Free[PROCEDURE_LAMBDA_EXPR] = exp_register;
+ Free[PROCEDURE_ENVIRONMENT] = env_register;
Free += 2;
break;
#ifdef COMPILE_FUTURES
case TC_FUTURE:
- if (Future_Has_Value(Registers[REGBLOCK_EXPR]))
+ if (Future_Has_Value (exp_register))
{
- SCHEME_OBJECT Future = (Registers[REGBLOCK_EXPR]);
+ SCHEME_OBJECT Future = exp_register;
if (Future_Is_Keep_Slot(Future)) Log_Touch_Of_Future(Future);
Reduces_To_Nth(FUTURE_VALUE);
}
Prepare_Eval_Repeat();
Will_Push(STACK_ENV_EXTRA_SLOTS+2);
- STACK_PUSH (Registers[REGBLOCK_EXPR]); /* Arg: FUTURE object */
+ STACK_PUSH (exp_register); /* Arg: FUTURE object */
STACK_PUSH (Get_Fixed_Obj_Slot(System_Scheduler));
STACK_PUSH (STACK_FRAME_HEADER+1);
Pushed();
case TC_LAMBDA: /* Close the procedure */
case TC_LEXPR:
/* Deliberately omitted: Eval_GC_Check(2); */
- Val = MAKE_POINTER_OBJECT (TC_PROCEDURE, Free);
- Free[PROCEDURE_LAMBDA_EXPR] = (Registers[REGBLOCK_EXPR]);
- Free[PROCEDURE_ENVIRONMENT] = (Registers[REGBLOCK_ENV]);
+ val_register = MAKE_POINTER_OBJECT (TC_PROCEDURE, Free);
+ Free[PROCEDURE_LAMBDA_EXPR] = exp_register;
+ Free[PROCEDURE_ENVIRONMENT] = env_register;
Free += 2;
break;
case TC_PCOMB0:
Will_Eventually_Push(CONTINUATION_SIZE + STACK_ENV_FIRST_ARG);
Finished_Eventual_Pushing(CONTINUATION_SIZE + STACK_ENV_FIRST_ARG);
- (Registers[REGBLOCK_EXPR])
- = (OBJECT_NEW_TYPE (TC_PRIMITIVE, (Registers[REGBLOCK_EXPR])));
+ exp_register = (OBJECT_NEW_TYPE (TC_PRIMITIVE, exp_register));
goto Primitive_Internal_Apply;
case TC_PCOMB1:
case TC_PCOMB2:
Will_Eventually_Push(CONTINUATION_SIZE + STACK_ENV_FIRST_ARG + 2);
- STACK_PUSH (Registers[REGBLOCK_ENV]);
+ STACK_PUSH (env_register);
Do_Nth_Then(RC_PCOMB2_DO_1, PCOMB2_ARG_2_SLOT, {});
case TC_PCOMB3:
Will_Eventually_Push(CONTINUATION_SIZE + STACK_ENV_FIRST_ARG + 3);
- STACK_PUSH (Registers[REGBLOCK_ENV]);
+ STACK_PUSH (env_register);
Do_Nth_Then(RC_PCOMB3_DO_2, PCOMB3_ARG_3_SLOT, {});
case TC_SCODE_QUOTE:
- Val = FAST_MEMORY_REF ((Registers[REGBLOCK_EXPR]), SCODE_QUOTE_OBJECT);
+ val_register = FAST_MEMORY_REF (exp_register, SCODE_QUOTE_OBJECT);
break;
case TC_SEQUENCE_2:
Will_Push(CONTINUATION_SIZE + 1);
- STACK_PUSH (Registers[REGBLOCK_ENV]);
+ STACK_PUSH (env_register);
Do_Nth_Then(RC_SEQ_2_DO_2, SEQUENCE_1, Pushed());
case TC_SEQUENCE_3:
Will_Push(CONTINUATION_SIZE + 1);
- STACK_PUSH (Registers[REGBLOCK_ENV]);
+ STACK_PUSH (env_register);
Do_Nth_Then(RC_SEQ_3_DO_2, SEQUENCE_1, Pushed());
case TC_THE_ENVIRONMENT:
- Val = (Registers[REGBLOCK_ENV]);
+ val_register = env_register;
break;
case TC_VARIABLE:
long temp;
Set_Time_Zone(Zone_Lookup);
- temp
- = (lookup_variable ((Registers[REGBLOCK_ENV]),
- (Registers[REGBLOCK_EXPR]),
- (&Val)));
+ temp = (lookup_variable (env_register, exp_register, (&val_register)));
if (temp == PRIM_DONE)
goto Pop_Return;
{
Will_Push(3);
Stop_Trapping();
- STACK_PUSH (Val);
+ STACK_PUSH (val_register);
STACK_PUSH (Fetch_Return_Trapper());
STACK_PUSH (STACK_FRAME_HEADER+1);
Pushed();
Pop_Return_Ucode_Hook();
Restore_Cont();
if (Consistency_Check &&
- (OBJECT_TYPE (Registers[REGBLOCK_RETURN]) != TC_RETURN_CODE))
+ (OBJECT_TYPE (ret_register) != TC_RETURN_CODE))
{
- STACK_PUSH (Val); /* For possible stack trace */
+ STACK_PUSH (val_register); /* For possible stack trace */
Save_Cont();
Microcode_Termination (TERM_BAD_STACK);
}
if (0 && Eval_Debug)
{
Print_Return ("Pop_Return, return code");
- Print_Expression (Val, "Pop_Return, value");
+ Print_Expression (val_register, "Pop_Return, value");
outf_console ("\n");
};
* common occurrence.
*/
- switch (OBJECT_DATUM (Registers[REGBLOCK_RETURN]))
+ switch (OBJECT_DATUM (ret_register))
{
case RC_COMB_1_PROCEDURE:
- (Registers[REGBLOCK_ENV]) = (STACK_POP ());
- STACK_PUSH (Val); /* Arg. 1 */
- STACK_PUSH (SHARP_F); /* Operator */
+ env_register = (STACK_POP ());
+ STACK_PUSH (val_register); /* Arg. 1 */
+ STACK_PUSH (SHARP_F); /* Operator */
STACK_PUSH (STACK_FRAME_HEADER + 1);
Finished_Eventual_Pushing(CONTINUATION_SIZE);
Do_Another_Then(RC_COMB_APPLY_FUNCTION, COMB_1_FN);
case RC_COMB_2_FIRST_OPERAND:
- (Registers[REGBLOCK_ENV]) = (STACK_POP ());
- STACK_PUSH (Val);
- STACK_PUSH (Registers[REGBLOCK_ENV]);
+ env_register = (STACK_POP ());
+ STACK_PUSH (val_register);
+ STACK_PUSH (env_register);
Do_Another_Then(RC_COMB_2_PROCEDURE, COMB_2_ARG_1);
case RC_COMB_2_PROCEDURE:
- (Registers[REGBLOCK_ENV]) = (STACK_POP ());
- STACK_PUSH (Val); /* Arg 1, just calculated */
- STACK_PUSH (SHARP_F); /* Function */
+ env_register = (STACK_POP ());
+ STACK_PUSH (val_register); /* Arg 1, just calculated */
+ STACK_PUSH (SHARP_F); /* Function */
STACK_PUSH (STACK_FRAME_HEADER + 2);
Finished_Eventual_Pushing(CONTINUATION_SIZE);
Do_Another_Then(RC_COMB_APPLY_FUNCTION, COMB_2_FN);
case RC_COMB_SAVE_VALUE:
{ long Arg_Number;
- (Registers[REGBLOCK_ENV]) = (STACK_POP ());
+ env_register = (STACK_POP ());
Arg_Number = OBJECT_DATUM (STACK_REF(STACK_COMB_FINGER))-1;
- STACK_REF(STACK_COMB_FIRST_ARG+Arg_Number) = Val;
+ STACK_REF(STACK_COMB_FIRST_ARG+Arg_Number) = val_register;
STACK_REF(STACK_COMB_FINGER) =
MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, Arg_Number);
/* DO NOT count on the type code being NMVector here, since
the stack parser may create them with #F here! */
if (Arg_Number > 0)
{
- STACK_PUSH (Registers[REGBLOCK_ENV]);
+ STACK_PUSH (env_register);
Do_Another_Then(RC_COMB_SAVE_VALUE,
(COMB_ARG_1_SLOT - 1) + Arg_Number);
}
/* Frame Size */
- STACK_PUSH (FAST_MEMORY_REF ((Registers[REGBLOCK_EXPR]), 0));
+ STACK_PUSH (FAST_MEMORY_REF (exp_register, 0));
Do_Another_Then(RC_COMB_APPLY_FUNCTION, COMB_FN_SLOT);
}
case RC_CONDITIONAL_DECIDE:
Pop_Return_Val_Check();
End_Subproblem();
- (Registers[REGBLOCK_ENV]) = (STACK_POP ());
- Reduces_To_Nth ((Val == SHARP_F) ? COND_ALTERNATIVE : COND_CONSEQUENT);
+ env_register = (STACK_POP ());
+ Reduces_To_Nth
+ ((val_register == SHARP_F) ? COND_ALTERNATIVE : COND_CONSEQUENT);
case RC_DISJUNCTION_DECIDE:
/* Return predicate if it isn't #F; else do ALTERNATIVE */
Pop_Return_Val_Check();
End_Subproblem();
- (Registers[REGBLOCK_ENV]) = (STACK_POP ());
- if (Val != SHARP_F) goto Pop_Return;
+ env_register = (STACK_POP ());
+ if (val_register != SHARP_F) goto Pop_Return;
Reduces_To_Nth(OR_ALTERNATIVE);
case RC_END_OF_COMPUTATION:
case RC_EVAL_ERROR:
/* Should be called RC_REDO_EVALUATION. */
- (Registers[REGBLOCK_ENV]) = (STACK_POP ());
- Reduces_To(Registers[REGBLOCK_EXPR]);
+ env_register = (STACK_POP ());
+ Reduces_To (exp_register);
case RC_EXECUTE_ACCESS_FINISH:
{
SCHEME_OBJECT value;
Pop_Return_Val_Check();
- value = Val;
+ value = val_register;
- if (ENVIRONMENT_P (Val))
+ if (ENVIRONMENT_P (val_register))
{
Result
= (lookup_variable (value,
- (FAST_MEMORY_REF ((Registers[REGBLOCK_EXPR]),
+ (FAST_MEMORY_REF (exp_register,
ACCESS_NAME)),
- (&Val)));
+ (&val_register)));
if (Result == PRIM_DONE)
{
End_Subproblem();
}
if (Result != PRIM_INTERRUPT)
{
- Val = value;
+ val_register = value;
Pop_Return_Error(Result);
}
Prepare_Pop_Return_Interrupt(RC_EXECUTE_ACCESS_FINISH, value);
Interrupt(PENDING_INTERRUPTS());
}
- Val = value;
+ val_register = value;
Pop_Return_Error(ERR_BAD_FRAME);
}
DECLARE_LOCK (set_serializer);
#endif
- value = Val;
+ value = val_register;
Set_Time_Zone(Zone_Lookup);
- (Registers[REGBLOCK_ENV]) = (STACK_POP ());
+ env_register = (STACK_POP ());
temp
= (assign_variable
- ((Registers[REGBLOCK_ENV]),
- (MEMORY_REF ((Registers[REGBLOCK_EXPR]), ASSIGN_NAME)),
+ (env_register,
+ (MEMORY_REF (exp_register, ASSIGN_NAME)),
value,
- (&Val)));
+ (&val_register)));
if (temp == PRIM_DONE)
{
End_Subproblem();
}
Set_Time_Zone(Zone_Working);
- STACK_PUSH (Registers[REGBLOCK_ENV]);
+ STACK_PUSH (env_register);
if (temp != PRIM_INTERRUPT)
{
- Val = value;
+ val_register = value;
Pop_Return_Error(temp);
}
case RC_EXECUTE_DEFINITION_FINISH:
{
- SCHEME_OBJECT name
- = (FAST_MEMORY_REF ((Registers[REGBLOCK_EXPR]), DEFINE_NAME));
- SCHEME_OBJECT value = Val;
+ SCHEME_OBJECT name = (FAST_MEMORY_REF (exp_register, DEFINE_NAME));
+ SCHEME_OBJECT value = val_register;
long result;
- (Registers[REGBLOCK_ENV]) = (STACK_POP ());
- result = (define_variable ((Registers[REGBLOCK_ENV]), name, value));
+ env_register = (STACK_POP ());
+ result = (define_variable (env_register, name, value));
if (result == PRIM_DONE)
{
End_Subproblem();
- Val = name;
+ val_register = name;
break;
}
- STACK_PUSH (Registers[REGBLOCK_ENV]);
+ STACK_PUSH (env_register);
if (result == PRIM_INTERRUPT)
{
Prepare_Pop_Return_Interrupt(RC_EXECUTE_DEFINITION_FINISH,
value);
Interrupt(PENDING_INTERRUPTS());
}
- Val = value;
+ val_register = value;
Pop_Return_Error(result);
}
case RC_EXECUTE_IN_PACKAGE_CONTINUE:
Pop_Return_Val_Check();
- if (ENVIRONMENT_P (Val))
+ if (ENVIRONMENT_P (val_register))
{
End_Subproblem();
- (Registers[REGBLOCK_ENV]) = Val;
+ env_register = val_register;
Reduces_To_Nth(IN_PACKAGE_EXPRESSION);
}
Pop_Return_Error(ERR_BAD_FRAME);
#ifdef COMPILE_FUTURES
case RC_FINISH_GLOBAL_INT:
- Val = Global_Int_Part_2((Registers[REGBLOCK_EXPR]), Val);
+ val_register = Global_Int_Part_2(exp_register, val_register);
break;
#endif
*/
#define Prepare_Apply_Interrupt() \
- { \
- (Registers[REGBLOCK_EXPR]) = SHARP_F; \
- Prepare_Pop_Return_Interrupt \
- (RC_INTERNAL_APPLY_VAL, (STACK_REF (STACK_ENV_FUNCTION))); \
- }
+{ \
+ exp_register = SHARP_F; \
+ Prepare_Pop_Return_Interrupt \
+ (RC_INTERNAL_APPLY_VAL, (STACK_REF (STACK_ENV_FUNCTION))); \
+}
#define Apply_Error(N) \
- { \
- (Registers[REGBLOCK_EXPR]) = SHARP_F; \
- Store_Return (RC_INTERNAL_APPLY_VAL); \
- Val = (STACK_REF (STACK_ENV_FUNCTION)); \
- Pop_Return_Error (N); \
- }
+{ \
+ exp_register = SHARP_F; \
+ Store_Return (RC_INTERNAL_APPLY_VAL); \
+ val_register = (STACK_REF (STACK_ENV_FUNCTION)); \
+ Pop_Return_Error (N); \
+}
case RC_INTERNAL_APPLY_VAL:
Internal_Apply_Val:
- STACK_REF (STACK_ENV_FUNCTION) = Val;
+ STACK_REF (STACK_ENV_FUNCTION) = val_register;
case RC_INTERNAL_APPLY:
Internal_Apply:
while(--nargs >= 0)
*scan++ = (STACK_POP ());
Free = scan;
- (Registers[REGBLOCK_ENV]) = temp;
+ env_register = temp;
Reduces_To(FAST_MEMORY_REF (Function, LAMBDA_SCODE));
}
}
{
Apply_Error(ERR_WRONG_NUMBER_OF_ARGUMENTS);
}
- Val = (STACK_REF (STACK_ENV_FIRST_ARG));
+ val_register = (STACK_REF (STACK_ENV_FIRST_ARG));
Our_Throw(0, Function);
Apply_Stacklet_Backout();
Our_Throw_Part_2();
}
sp_register = (STACK_LOC (STACK_ENV_FIRST_ARG));
- (Registers[REGBLOCK_EXPR]) = Function;
- APPLY_PRIMITIVE_FROM_INTERPRETER (Val, Function);
+ exp_register = Function;
+ APPLY_PRIMITIVE_FROM_INTERPRETER (val_register, Function);
POP_PRIMITIVE_FRAME (nargs);
if (Must_Report_References())
{
- (Registers[REGBLOCK_EXPR]) = Val;
+ exp_register = val_register;
Store_Return(RC_RESTORE_VALUE);
Save_Cont();
Call_Future_Logging();
}
Free = scan;
- (Registers[REGBLOCK_ENV]) = temp;
+ env_register = temp;
Reduces_To(Get_Body_Elambda(lambda));
}
*/
execute_compiled_backout ();
- Val
- = (OBJECT_NEW_TYPE
- (TC_COMPILED_ENTRY, (Registers[REGBLOCK_EXPR])));
+ val_register
+ = (OBJECT_NEW_TYPE (TC_COMPILED_ENTRY, exp_register));
Pop_Return_Error (Which_Way);
}
in a system without compiler support.
*/
- (Registers[REGBLOCK_EXPR]) = SHARP_F;
+ exp_register = SHARP_F;
Store_Return (RC_REENTER_COMPILED_CODE);
Pop_Return_Error (Which_Way);
}
} /* End of RC_INTERNAL_APPLY case */
case RC_MOVE_TO_ADJACENT_POINT:
- /* Expression contains the space in which we are moving */
+ /* exp_register contains the space in which we are moving */
{
long From_Count;
SCHEME_OBJECT Thunk, New_Location;
Save_Cont ();
}
}
- if ((Registers[REGBLOCK_EXPR]) != SHARP_F)
+ if (exp_register != SHARP_F)
{
- MEMORY_SET ((Registers[REGBLOCK_EXPR]),
- STATE_SPACE_NEAREST_POINT,
- New_Location);
+ MEMORY_SET (exp_register, STATE_SPACE_NEAREST_POINT, New_Location);
}
else
{
case RC_INVOKE_STACK_THREAD:
/* Used for WITH_THREADED_STACK primitive */
Will_Push(3);
- STACK_PUSH (Val); /* Value calculated by thunk */
- STACK_PUSH (Registers[REGBLOCK_EXPR]);
+ STACK_PUSH (val_register); /* Value calculated by thunk */
+ STACK_PUSH (exp_register);
STACK_PUSH (STACK_FRAME_HEADER+1);
Pushed();
goto Internal_Apply;
case RC_JOIN_STACKLETS:
- Our_Throw(1, (Registers[REGBLOCK_EXPR]));
+ Our_Throw (1, exp_register);
Join_Stacklet_Backout();
Our_Throw_Part_2();
break;
case RC_NORMAL_GC_DONE:
- Val = (Registers[REGBLOCK_EXPR]);
+ val_register = exp_register;
if (GC_Space_Needed < 0)
{
/* Paranoia */
case RC_PCOMB1_APPLY:
End_Subproblem();
- STACK_PUSH (Val); /* Argument value */
+ STACK_PUSH (val_register); /* Argument value */
Finished_Eventual_Pushing(CONTINUATION_SIZE + STACK_ENV_FIRST_ARG);
- (Registers[REGBLOCK_EXPR])
- = (FAST_MEMORY_REF ((Registers[REGBLOCK_EXPR]), PCOMB1_FN_SLOT));
+ exp_register = (FAST_MEMORY_REF (exp_register, PCOMB1_FN_SLOT));
Primitive_Internal_Apply:
if (Microcode_Does_Stepping &&
We may have a non-contiguous frame. -- Jinx
*/
Will_Push(3);
- STACK_PUSH (Registers[REGBLOCK_EXPR]);
+ STACK_PUSH (exp_register);
STACK_PUSH (Fetch_Apply_Trapper());
STACK_PUSH (STACK_FRAME_HEADER + 1 +
- PRIMITIVE_N_PARAMETERS(Registers[REGBLOCK_EXPR]));
+ PRIMITIVE_N_PARAMETERS(exp_register));
Pushed();
Stop_Trapping();
goto Apply_Non_Trapping;
*/
{
- SCHEME_OBJECT primitive = (Registers[REGBLOCK_EXPR]);
- APPLY_PRIMITIVE_FROM_INTERPRETER (Val, primitive);
+ SCHEME_OBJECT primitive = exp_register;
+ APPLY_PRIMITIVE_FROM_INTERPRETER (val_register, primitive);
POP_PRIMITIVE_FRAME (PRIMITIVE_ARITY (primitive));
if (Must_Report_References ())
{
- (Registers[REGBLOCK_EXPR]) = Val;
+ exp_register = val_register;
Store_Return (RC_RESTORE_VALUE);
Save_Cont ();
Call_Future_Logging ();
case RC_PCOMB2_APPLY:
End_Subproblem();
- STACK_PUSH (Val); /* Value of arg. 1 */
+ STACK_PUSH (val_register); /* Value of arg. 1 */
Finished_Eventual_Pushing(CONTINUATION_SIZE + STACK_ENV_FIRST_ARG);
- (Registers[REGBLOCK_EXPR])
- = (FAST_MEMORY_REF ((Registers[REGBLOCK_EXPR]), PCOMB2_FN_SLOT));
+ exp_register = (FAST_MEMORY_REF (exp_register, PCOMB2_FN_SLOT));
goto Primitive_Internal_Apply;
case RC_PCOMB2_DO_1:
- (Registers[REGBLOCK_ENV]) = (STACK_POP ());
- STACK_PUSH (Val); /* Save value of arg. 2 */
+ env_register = (STACK_POP ());
+ STACK_PUSH (val_register); /* Save value of arg. 2 */
Do_Another_Then(RC_PCOMB2_APPLY, PCOMB2_ARG_1_SLOT);
case RC_PCOMB3_APPLY:
End_Subproblem();
- STACK_PUSH (Val); /* Save value of arg. 1 */
+ STACK_PUSH (val_register); /* Save value of arg. 1 */
Finished_Eventual_Pushing(CONTINUATION_SIZE + STACK_ENV_FIRST_ARG);
- (Registers[REGBLOCK_EXPR])
- = (FAST_MEMORY_REF ((Registers[REGBLOCK_EXPR]), PCOMB3_FN_SLOT));
+ exp_register = (FAST_MEMORY_REF (exp_register, PCOMB3_FN_SLOT));
goto Primitive_Internal_Apply;
case RC_PCOMB3_DO_1:
{
SCHEME_OBJECT Temp;
- Temp = (STACK_POP ()); /* Value of arg. 3 */
- (Registers[REGBLOCK_ENV]) = (STACK_POP ());
- STACK_PUSH (Temp); /* Save arg. 3 again */
- STACK_PUSH (Val); /* Save arg. 2 */
+ Temp = (STACK_POP ()); /* Value of arg. 3 */
+ env_register = (STACK_POP ());
+ STACK_PUSH (Temp); /* Save arg. 3 again */
+ STACK_PUSH (val_register); /* Save arg. 2 */
Do_Another_Then(RC_PCOMB3_APPLY, PCOMB3_ARG_1_SLOT);
}
case RC_PCOMB3_DO_2:
- (Registers[REGBLOCK_ENV]) = (STACK_REF (0));
- STACK_PUSH (Val); /* Save value of arg. 3 */
+ env_register = (STACK_REF (0));
+ STACK_PUSH (val_register); /* Save value of arg. 3 */
Do_Another_Then(RC_PCOMB3_DO_1, PCOMB3_ARG_2_SLOT);
case RC_POP_RETURN_ERROR:
case RC_RESTORE_VALUE:
- Val = (Registers[REGBLOCK_EXPR]);
+ val_register = exp_register;
break;
case RC_PRIMITIVE_CONTINUE:
- Val = (continue_primitive ());
+ val_register = (continue_primitive ());
break;
case RC_REPEAT_DISPATCH:
- Which_Way = (FIXNUM_TO_LONG (Registers[REGBLOCK_EXPR]));
- (Registers[REGBLOCK_ENV]) = (STACK_POP ());
- Val = (STACK_POP ());
+ Which_Way = (FIXNUM_TO_LONG (exp_register));
+ env_register = (STACK_POP ());
+ val_register = (STACK_POP ());
Restore_Cont();
goto Repeat_Dispatch;
/* The following two return codes are both used to restore
a saved history object. The difference is that the first
does not copy the history object while the second does.
- In both cases, the Expression register contains the history
+ In both cases, the exp_register contains the history
object and the next item to be popped off the stack contains
the offset back to the previous restore history return code.
Prev_Restore_History_Offset = OBJECT_DATUM (STACK_POP ());
Stacklet = (STACK_POP ());
- history_register = OBJECT_ADDRESS (Registers[REGBLOCK_EXPR]);
+ history_register = OBJECT_ADDRESS (exp_register);
if (Prev_Restore_History_Offset == 0)
{
Prev_Restore_History_Stacklet = NULL;
{
SCHEME_OBJECT Stacklet;
- if (! Restore_History(Registers[REGBLOCK_EXPR]))
+ if (! Restore_History(exp_register))
{
Save_Cont();
Will_Push(CONTINUATION_SIZE);
- (Registers[REGBLOCK_EXPR]) = Val;
+ exp_register = val_register;
Store_Return(RC_RESTORE_VALUE);
Save_Cont();
Pushed();
}
case RC_RESTORE_FLUIDS:
- Fluid_Bindings = (Registers[REGBLOCK_EXPR]);
+ Fluid_Bindings = exp_register;
break;
case RC_RESTORE_INT_MASK:
- SET_INTERRUPT_MASK (UNSIGNED_FIXNUM_TO_LONG (Registers[REGBLOCK_EXPR]));
+ SET_INTERRUPT_MASK (UNSIGNED_FIXNUM_TO_LONG (exp_register));
if (GC_Check (0))
Request_GC (0);
if ((PENDING_INTERRUPTS ()) != 0)
{
Store_Return (RC_RESTORE_VALUE);
- (Registers[REGBLOCK_EXPR]) = Val;
+ exp_register = val_register;
Save_Cont ();
Interrupt (PENDING_INTERRUPTS ());
}
case RC_STACK_MARKER:
/* Frame consists of the return code followed by two objects.
- The first object has already been popped into the Expression
- register, so just pop the second argument. */
+ The first object has already been popped into exp_register,
+ so just pop the second argument. */
sp_register = (STACK_LOCATIVE_OFFSET (sp_register, 1));
break;
case RC_RESTORE_TO_STATE_POINT:
{
- SCHEME_OBJECT Where_To_Go = (Registers[REGBLOCK_EXPR]);
+ SCHEME_OBJECT Where_To_Go = exp_register;
Will_Push(CONTINUATION_SIZE);
- /* Restore the contents of Val after moving to point */
- (Registers[REGBLOCK_EXPR]) = Val;
+ /* Restore the contents of val_register after moving to point */
+ exp_register = val_register;
Store_Return(RC_RESTORE_VALUE);
Save_Cont();
Pushed();
case RC_SEQ_2_DO_2:
End_Subproblem();
- (Registers[REGBLOCK_ENV]) = (STACK_POP ());
+ env_register = (STACK_POP ());
Reduces_To_Nth(SEQUENCE_2);
case RC_SEQ_3_DO_2:
- (Registers[REGBLOCK_ENV]) = (STACK_REF (0));
+ env_register = (STACK_REF (0));
Do_Another_Then(RC_SEQ_3_DO_3, SEQUENCE_2);
case RC_SEQ_3_DO_3:
End_Subproblem();
- (Registers[REGBLOCK_ENV]) = (STACK_POP ());
+ env_register = (STACK_POP ());
Reduces_To_Nth(SEQUENCE_3);
case RC_SNAP_NEED_THUNK:
/* Don't snap thunk twice; evaluation of the thunk's body might
have snapped it already. */
- if ((MEMORY_REF ((Registers[REGBLOCK_EXPR]), THUNK_SNAPPED)) == SHARP_T)
- Val = (MEMORY_REF ((Registers[REGBLOCK_EXPR]), THUNK_VALUE));
+ if ((MEMORY_REF (exp_register, THUNK_SNAPPED)) == SHARP_T)
+ val_register = (MEMORY_REF (exp_register, THUNK_VALUE));
else
{
- MEMORY_SET ((Registers[REGBLOCK_EXPR]), THUNK_SNAPPED, SHARP_T);
- MEMORY_SET ((Registers[REGBLOCK_EXPR]), THUNK_VALUE, Val);
+ MEMORY_SET (exp_register, THUNK_SNAPPED, SHARP_T);
+ MEMORY_SET (exp_register, THUNK_VALUE, val_register);
}
break;
/* -*-C-*-
-$Id: interp.h,v 9.45 2002/07/02 19:03:44 cph Exp $
+$Id: interp.h,v 9.46 2002/07/02 20:50:08 cph Exp $
Copyright (c) 1987-1999, 2002 Massachusetts Institute of Technology
\f
#define Regs Registers
-#define Env (Registers[REGBLOCK_ENV])
-#define Val (Registers[REGBLOCK_VAL])
-#define Expression (Registers[REGBLOCK_EXPR])
-#define Return (Registers[REGBLOCK_RETURN])
+#define env_register (Registers[REGBLOCK_ENV])
+#define val_register (Registers[REGBLOCK_VAL])
+#define exp_register (Registers[REGBLOCK_EXPR])
+#define ret_register (Registers[REGBLOCK_RETURN])
-/* Fetch from register */
-
-#define Fetch_Expression() (Registers[REGBLOCK_EXPR])
-#define Fetch_Env() (Registers[REGBLOCK_ENV])
-#define Fetch_Return() (Registers[REGBLOCK_RETURN])
-
-/* Store into register */
-
-#define Store_Expression(P) (Registers[REGBLOCK_EXPR]) = (P)
-#define Store_Env(P) (Registers[REGBLOCK_ENV]) = (P)
-#define Store_Return(P) \
- (Registers[REGBLOCK_RETURN]) = (MAKE_OBJECT (TC_RETURN_CODE, (P)))
+#define Store_Return(P) ret_register = (MAKE_OBJECT (TC_RETURN_CODE, (P)))
/* Note: Save_Cont must match the definitions in sdata.h */
#define Save_Cont() \
{ \
- STACK_PUSH (Registers[REGBLOCK_EXPR]); \
- STACK_PUSH (Registers[REGBLOCK_RETURN]); \
+ STACK_PUSH (exp_register); \
+ STACK_PUSH (ret_register); \
}
#define Restore_Cont() \
{ \
- Registers[REGBLOCK_RETURN] = (STACK_POP ()); \
- Registers[REGBLOCK_EXPR] = (STACK_POP ()); \
+ ret_register = (STACK_POP ()); \
+ exp_register = (STACK_POP ()); \
}
#define Stop_Trapping() Trapping = 0
/* -*-C-*-
-$Id: liarc.h,v 1.17 2002/07/02 18:38:34 cph Exp $
+$Id: liarc.h,v 1.18 2002/07/02 20:50:13 cph Exp $
Copyright (c) 1992-2002 Massachusetts Institute of Technology
\f
#ifdef USE_GLOBAL_VARIABLES
-#define Rvl Val
+#define Rvl val_register
#define Rhp Free
#define Rrb Regs
#define Rsp sp_register
#define Rrb Regs
#define DECLARE_VARIABLES() \
-REGISTER SCHEME_OBJECT Rvl = Val; \
+REGISTER SCHEME_OBJECT Rvl = val_register; \
REGISTER SCHEME_OBJECT * Rhp = Free; \
REGISTER SCHEME_OBJECT * Rsp = sp_register
{ \
sp_register = Rsp; \
Free = Rhp; \
- Val = Rvl; \
+ val_register = Rvl; \
} while (0)
#define CACHE_VARIABLES() do \
{ \
- Rvl = Val; \
+ Rvl = val_register; \
Rhp = Free; \
Rsp = sp_register; \
} while (0)
SCHEME_OBJECT * destination; \
\
UNCACHE_VARIABLES (); \
- PRIMITIVE_APPLY (Val, primitive); \
+ PRIMITIVE_APPLY (val_register, primitive); \
POP_PRIMITIVE_FRAME (primitive_nargs); \
destination = (OBJECT_ADDRESS (STACK_POP ())); \
CACHE_VARIABLES (); \
/* -*-C-*-
-$Id: memmag.c,v 9.68 2002/07/02 19:03:49 cph Exp $
+$Id: memmag.c,v 9.69 2002/07/02 20:50:18 cph Exp $
Copyright (c) 1987-2000, 2002 Massachusetts Institute of Technology
Will_Push (CONTINUATION_SIZE);
Store_Return (RC_NORMAL_GC_DONE);
- Store_Expression (LONG_TO_UNSIGNED_FIXNUM (MemTop - Free));
+ exp_register = (LONG_TO_UNSIGNED_FIXNUM (MemTop - Free));
Save_Cont ();
Pushed ();
/* -*-C-*-
-$Id: nttrap.c,v 1.21 2002/07/02 19:03:55 cph Exp $
+$Id: nttrap.c,v 1.22 2002/07/02 20:50:23 cph Exp $
Copyright (c) 1992-2002 Massachusetts Institute of Technology
STACK_PUSH (trap_code);
STACK_PUSH (trap_name);
Store_Return (RC_HARDWARE_TRAP);
- Store_Expression (long_to_integer (code));
+ exp_register = (long_to_integer (code));
Save_Cont ();
Pushed ();
if (stack_recovered_p
/* -*-C-*-
-$Id: os2xcpt.c,v 1.11 2002/07/02 19:04:01 cph Exp $
+$Id: os2xcpt.c,v 1.12 2002/07/02 20:50:28 cph Exp $
Copyright (c) 1994-2002 Massachusetts Institute of Technology
INITIALIZE_STACK ();
Will_Push (CONTINUATION_SIZE);
Store_Return (RC_END_OF_COMPUTATION);
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Save_Cont ();
Pushed ();
}
STACK_PUSH (long_to_integer (report -> ExceptionNum));
STACK_PUSH (trap_name);
Store_Return (RC_HARDWARE_TRAP);
- Store_Expression (UNSPECIFIC);
+ exp_register = UNSPECIFIC;
Save_Cont ();
Pushed ();
/* -*-C-*-
-$Id: prims.h,v 9.48 2001/03/08 17:03:32 cph Exp $
+$Id: prims.h,v 9.49 2002/07/02 20:50:33 cph Exp $
-Copyright (c) 1987-2001 Massachusetts Institute of Technology
+Copyright (c) 1987-2002 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
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.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
*/
/* This file contains some macros for defining primitives,
/* Primitives should have this as their first statement. */
#ifdef ENABLE_PRIMITIVE_PROFILING
-#define PRIMITIVE_HEADER(n_args) record_primitive_entry (Fetch_Expression ())
+#define PRIMITIVE_HEADER(n_args) record_primitive_entry (exp_register)
#else
#define PRIMITIVE_HEADER(n_args) {}
#endif
/* -*-C-*-
-$Id: prmcon.c,v 1.3 1999/01/02 06:11:34 cph Exp $
+$Id: prmcon.c,v 1.4 2002/07/02 20:50:38 cph Exp $
-Copyright (c) 1990-1999 Massachusetts Institute of Technology
+Copyright (c) 1990-1999, 2002 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
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.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
*/
#define SCM_PRMCON_C
STACK_PUSH (reentry_record[i]);
}
STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM (reentry_record_length));
- Store_Expression (LONG_TO_UNSIGNED_FIXNUM ((long) continuation));
+ exp_register = (LONG_TO_UNSIGNED_FIXNUM ((long) continuation));
Store_Return (RC_PRIMITIVE_CONTINUE);
Save_Cont ();
Pushed ();
int continuation, record_length;
SCHEME_OBJECT primitive, *buffer, result;
- continuation = ((int) (UNSIGNED_FIXNUM_TO_LONG (Fetch_Expression ())));
+ continuation = ((int) (UNSIGNED_FIXNUM_TO_LONG (exp_register)));
if (continuation > CONT_MAX_INDEX)
{
- Store_Expression (LONG_TO_UNSIGNED_FIXNUM ((long) continuation));
+ exp_register = (LONG_TO_UNSIGNED_FIXNUM ((long) continuation));
Store_Return (RC_PRIMITIVE_CONTINUE);
Save_Cont ();
immediate_error (ERR_UNKNOWN_PRIMITIVE_CONTINUATION);
{
Request_GC (record_length);
STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM ((long) record_length));
- Store_Expression (LONG_TO_UNSIGNED_FIXNUM ((long) continuation));
+ exp_register = (LONG_TO_UNSIGNED_FIXNUM ((long) continuation));
Store_Return (RC_PRIMITIVE_CONTINUE);
Save_Cont ();
immediate_interrupt ();
}
Regs[REGBLOCK_LEXPR_ACTUALS] = ((SCHEME_OBJECT) nargs);
}
- Store_Expression (primitive);
+ exp_register = primitive;
Regs[REGBLOCK_PRIMITIVE] = primitive;
result = (*(continuation_procedures[continuation]))(buffer);
Regs[REGBLOCK_PRIMITIVE] = SHARP_F;
/* -*-C-*-
-$Id: purify.c,v 9.62 2002/07/02 19:04:07 cph Exp $
+$Id: purify.c,v 9.63 2002/07/02 20:50:43 cph Exp $
Copyright (c) 1988-1999, 2001, 2002 Massachusetts Institute of Technology
Will_Push (CONTINUATION_SIZE);
Store_Return (RC_NORMAL_GC_DONE);
- Store_Expression (result);
+ exp_register = result;
Save_Cont ();
Pushed ();
/* -*-C-*-
-$Id: returns.h,v 9.42 1999/01/02 06:06:43 cph Exp $
+$Id: returns.h,v 9.43 2002/07/02 20:50:48 cph Exp $
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-1999, 2002 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
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.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
*/
-/* Return codes. These are placed in Return when an
+/* Return codes. These are placed in ret_register when an
interpreter operation needs to operate in several phases. */
\f
#define RC_END_OF_COMPUTATION 0x00
/* -*-C-*-
-$Id: stack.h,v 9.41 2002/07/02 19:04:13 cph Exp $
+$Id: stack.h,v 9.42 2002/07/02 20:50:53 cph Exp $
Copyright (c) 1987-1999, 2002 Massachusetts Institute of Technology
\f
#define Apply_Stacklet_Backout() \
Will_Push((2 * CONTINUATION_SIZE) + (STACK_ENV_EXTRA_SLOTS + 2)); \
- Store_Expression(SHARP_F); \
+ exp_register = SHARP_F; \
Store_Return(RC_END_OF_COMPUTATION); \
Save_Cont(); \
- STACK_PUSH (Val); \
+ STACK_PUSH (val_register); \
STACK_PUSH (Previous_Stacklet); \
STACK_PUSH (STACK_FRAME_HEADER + 1); \
Store_Return(RC_INTERNAL_APPLY); \
{ \
SCHEME_OBJECT Old_Expression; \
\
- Old_Expression = Fetch_Expression(); \
- Store_Expression(Previous_Stacklet); \
+ Old_Expression = exp_register; \
+ exp_register = Previous_Stacklet; \
Store_Return(RC_JOIN_STACKLETS); \
Save_Cont(); \
- Store_Expression(Old_Expression); \
+ exp_register = Old_Expression; \
}
\f
/* Our_Throw is used in chaining from one stacklet to another. In
/* -*-C-*-
-$Id: step.c,v 9.35 2002/07/02 18:39:09 cph Exp $
+$Id: step.c,v 9.36 2002/07/02 20:50:58 cph Exp $
Copyright (c) 1987-1999, 2002 Massachusetts Institute of Technology
PRIMITIVE_CANONICALIZE_CONTEXT ();
POP_PRIMITIVE_FRAME (3);
Install_Traps (hooks);
- Store_Expression (expression);
- Store_Env (environment);
+ exp_register = expression;
+ env_register = environment;
}
PRIMITIVE_ABORT (PRIM_NO_TRAP_EVAL);
/*NOTREACHED*/
POP_PRIMITIVE_FRAME (2);
Install_Traps (hooks);
- Val = (value);
+ val_register = value;
PRIMITIVE_ABORT (PRIM_NO_TRAP_POP_RETURN);
PRIMITIVE_RETURN (UNSPECIFIC);
}
/* -*-C-*-
-$Id: term.c,v 1.15 2000/12/05 21:23:48 cph Exp $
+$Id: term.c,v 1.16 2002/07/02 20:51:04 cph Exp $
-Copyright (c) 1990-2000 Massachusetts Institute of Technology
+Copyright (c) 1990-2000, 2002 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
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.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
*/
#include "scheme.h"
+ STACK_ENV_EXTRA_SLOTS
+ ((code == TERM_NO_ERROR_HANDLER) ? 5 : 4));
Store_Return (RC_HALT);
- Store_Expression (LONG_TO_UNSIGNED_FIXNUM (code));
+ exp_register = (LONG_TO_UNSIGNED_FIXNUM (code));
Save_Cont ();
if (code == TERM_NO_ERROR_HANDLER)
STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM (death_blow));
- STACK_PUSH (Val); /* Arg 3 */
- STACK_PUSH (Fetch_Env ()); /* Arg 2 */
- STACK_PUSH (Fetch_Expression ()); /* Arg 1 */
- STACK_PUSH (Handler); /* The handler function */
+ STACK_PUSH (val_register); /* Arg 3 */
+ STACK_PUSH (env_register); /* Arg 2 */
+ STACK_PUSH (exp_register); /* Arg 1 */
+ STACK_PUSH (Handler); /* The handler function */
STACK_PUSH (STACK_FRAME_HEADER
+ ((code == TERM_NO_ERROR_HANDLER) ? 4 : 3));
Pushed ();
DEFUN_VOID (termination_end_of_computation)
{
termination_prefix (TERM_END_OF_COMPUTATION);
- Print_Expression (Val, "Final result");
+ Print_Expression (val_register, "Final result");
outf_console("\n");
termination_suffix (TERM_END_OF_COMPUTATION, 0, 0);
}
/* -*-C-*-
-$Id: utils.c,v 9.81 2002/07/02 19:04:19 cph Exp $
+$Id: utils.c,v 9.82 2002/07/02 20:51:09 cph Exp $
Copyright (c) 1987-2002 Massachusetts Institute of Technology
{
Will_Push (CONTINUATION_SIZE);
Store_Return (RC_RESTORE_INT_MASK);
- Store_Expression (LONG_TO_FIXNUM (FETCH_INTERRUPT_MASK ()));
+ exp_register = (LONG_TO_FIXNUM (FETCH_INTERRUPT_MASK ()));
Save_Cont ();
Pushed ();
return;
compiler_apply_procedure (nargs);
STACK_PUSH (primitive);
STACK_PUSH (STACK_FRAME_HEADER + nargs);
- Store_Env (THE_NULL_ENV);
- Val = SHARP_F;
+ env_register = THE_NULL_ENV;
+ val_register = SHARP_F;
Store_Return (RC_INTERNAL_APPLY);
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
(Regs [REGBLOCK_PRIMITIVE]) = SHARP_F;
return;
}
if (Consistency_Check)
{
err_print(Err, error_output);
- Print_Expression(Fetch_Expression(), "Expression was");
+ Print_Expression(exp_register, "Expression was");
outf_error ("\nEnvironment 0x%lx (#%lo).\n",
- ((long) (Fetch_Env ())), ((long) (Fetch_Env ())));
+ ((long) exp_register), ((long) env_register));
Print_Return("Return code");
outf_error ("\n");
}
Will_Push (CONTINUATION_SIZE + (From_Pop_Return ? 0 : 1));
if (From_Pop_Return)
- Store_Expression (Val);
+ exp_register = val_register;
else
- STACK_PUSH (Fetch_Env ());
+ STACK_PUSH (env_register);
Store_Return ((From_Pop_Return) ?
RC_POP_RETURN_ERROR :
RC_EVAL_ERROR);
SCHEME_OBJECT Saved_Expression;
long Saved_Return_Code;
- Saved_Expression = Fetch_Expression();
- Saved_Return_Code = Fetch_Return();
+ Saved_Expression = exp_register;
+ Saved_Return_Code = ret_register;
Will_Push(HISTORY_SIZE);
Save_History(RC_RESTORE_DONT_COPY_HISTORY);
Pushed();
Prev_Restore_History_Stacklet = NULL;
Prev_Restore_History_Offset = ((Get_End_Of_Stacklet() - sp_register) +
CONTINUATION_RETURN_CODE);
- Store_Expression(Saved_Expression);
+ exp_register = Saved_Expression;
Store_Return(Saved_Return_Code);
return;
}
&New_Stacklet[1 + (OBJECT_DATUM (New_Stacklet[STACKLET_LENGTH]))];
SET_STACK_GUARD (& (New_Stacklet[STACKLET_HEADER_SIZE]));
}
- Old_Expression = Fetch_Expression();
- Old_Return = Fetch_Return();
- Store_Expression(MAKE_POINTER_OBJECT (TC_CONTROL_POINT, Old_Stacklet));
+ Old_Expression = exp_register;
+ Old_Return = ret_register;
+ exp_register = (MAKE_POINTER_OBJECT (TC_CONTROL_POINT, Old_Stacklet));
Store_Return(RC_JOIN_STACKLETS);
/*
Will_Push omitted because size calculation includes enough room.
*/
Save_Cont();
- Store_Expression(Old_Expression);
+ exp_register = Old_Expression;
Store_Return(Old_Return);
return;
}
STACK_PUSH (Target);
STACK_PUSH (LONG_TO_UNSIGNED_FIXNUM((From_Depth - Merge_Depth)));
STACK_PUSH (Current_Location);
- Store_Expression(State_Space);
+ exp_register = State_Space;
Store_Return(RC_MOVE_TO_ADJACENT_POINT);
Save_Cont();
Pushed();
long i;
Store_Return (RC_END_OF_COMPUTATION);
- Store_Expression (primitive);
+ exp_register = primitive;
Save_Cont ();
for (i = nargs; --i >= 0; )
STACK_PUSH (STACK_FRAME_HEADER + nargs);
Store_Return (RC_INTERNAL_APPLY);
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Save_Cont ();
}
Pushed ();
/* -*-C-*-
-$Id: uxtrap.c,v 1.33 2002/07/02 19:04:25 cph Exp $
+$Id: uxtrap.c,v 1.34 2002/07/02 20:51:14 cph Exp $
Copyright (c) 1990-2002 Massachusetts Institute of Technology
INITIALIZE_STACK ();
Will_Push (CONTINUATION_SIZE);
Store_Return (RC_END_OF_COMPUTATION);
- Store_Expression (SHARP_F);
+ exp_register = SHARP_F;
Save_Cont ();
Pushed ();
}
STACK_PUSH (signal_code);
STACK_PUSH (signal_name);
Store_Return (RC_HARDWARE_TRAP);
- Store_Expression (long_to_integer (signo));
+ exp_register = (long_to_integer (signo));
Save_Cont ();
Pushed ();
if (stack_recovered_p
projects / mit-scheme.git / commitdiff