/* -*-C-*-

$Id: interp.h,v 9.52 2007/01/05 21:19:25 cph Exp $

Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
    2006, 2007 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.

*/

/* Definitions used by the interpreter and some utilities. */

#define env_register (Registers[REGBLOCK_ENV])
#define val_register (Registers[REGBLOCK_VAL])
#define exp_register (Registers[REGBLOCK_EXPR])
#define ret_register (Registers[REGBLOCK_RETURN])

#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 (exp_register);						\
  STACK_PUSH (ret_register);						\
}

#define Restore_Cont()							\
{									\
  ret_register = (STACK_POP ());					\
  exp_register = (STACK_POP ());					\
}

#define Stop_Trapping() Trapping = 0

/* Saving history is required for C_call_scheme to work correctly
   because the recursive call to Interpret() can rotate the history.
   */

#define APPLY_PRIMITIVE_FROM_INTERPRETER(location, primitive)		\
{									\
  SCHEME_OBJECT * APFI_saved_history = history_register;		\
  PRIMITIVE_APPLY ((location), (primitive));				\
  history_register = APFI_saved_history;				\
}

/* Stack manipulation */

#ifdef ENABLE_DEBUGGING_TOOLS

#define Will_Push(N)							\
{									\
  SCHEME_OBJECT * Will_Push_Limit;					\
									\
  Internal_Will_Push ((N));						\
  Will_Push_Limit = (STACK_LOC (- (N)))

#define Pushed()							\
  if (sp_register < Will_Push_Limit)					\
    {									\
      Stack_Death ();							\
    }									\
}

#else

#define Will_Push Internal_Will_Push
#define Pushed()

#endif

/* N in Will_Eventually_Push is the maximum contiguous (single return
   code) amount that this operation may take.  On the average case it
   may use less.  M in Finished_Eventual_Pushing is the amount not yet
   pushed.  */

#define Will_Eventually_Push Internal_Will_Push
#define Finished_Eventual_Pushing(M)

/* Primitive stack operations:
   These operations hide the direction of stack growth.
   `Throw' in "stack.h", `Allocate_New_Stacklet' in "utils.c",
   `apply', `cwcc' and friends in "hooks.c", and possibly other stuff,
   depend on the direction in which the stack grows. */

#define STACK_LOCATIVE_DECREMENT(locative) (-- (locative))
#define STACK_LOCATIVE_INCREMENT(locative) ((locative) ++)
#define STACK_LOCATIVE_OFFSET(locative, offset) ((locative) + (offset))
#define STACK_LOCATIVE_REFERENCE(locative, offset) ((locative) [(offset)])
#define STACK_LOCATIVE_DIFFERENCE(x, y) ((x) - (y))

#define STACK_LOCATIVE_PUSH(locative) (* (STACK_LOCATIVE_DECREMENT (locative)))
#define STACK_LOCATIVE_POP(locative) (* (STACK_LOCATIVE_INCREMENT (locative)))

#define STACK_PUSH(object) (STACK_LOCATIVE_PUSH (sp_register)) = (object)
#define STACK_POP() (STACK_LOCATIVE_POP (sp_register))
#define STACK_LOC(offset) (STACK_LOCATIVE_OFFSET (sp_register, (offset)))
#define STACK_REF(offset) (STACK_LOCATIVE_REFERENCE (sp_register, (offset)))

/* Primitive utility macros */

#ifndef ENABLE_DEBUGGING_TOOLS

#define PRIMITIVE_APPLY PRIMITIVE_APPLY_INTERNAL

#else

#define PRIMITIVE_APPLY(loc, primitive)					\
  (loc) = (primitive_apply_internal (primitive))
extern SCHEME_OBJECT EXFUN (primitive_apply_internal, (SCHEME_OBJECT));

#endif

#define PRIMITIVE_APPLY_INTERNAL(loc, primitive)			\
{									\
  PTR PRIMITIVE_APPLY_INTERNAL_position = dstack_position;		\
  (Registers[REGBLOCK_PRIMITIVE]) = (primitive);			\
  (loc)									\
    = ((* (Primitive_Procedure_Table [PRIMITIVE_NUMBER (primitive)]))	\
       ());								\
  /* If the primitive failed to unwind the dynamic stack, lose. */	\
  if (PRIMITIVE_APPLY_INTERNAL_position != dstack_position)		\
    {									\
      outf_fatal ("\nPrimitive slipped the dynamic stack: %s\n",	\
		  (PRIMITIVE_NAME (primitive)));			\
      Microcode_Termination (TERM_EXIT);				\
    }									\
  (Registers[REGBLOCK_PRIMITIVE]) = SHARP_F;				\
}

#define POP_PRIMITIVE_FRAME(arity) sp_register = (STACK_LOC (arity))

typedef struct interpreter_state_s * interpreter_state_t;

struct interpreter_state_s
{
  interpreter_state_t previous_state;
  unsigned int nesting_level;
  PTR dstack_position;
  jmp_buf catch_env;
  int throw_argument;
};

#define interpreter_catch_dstack_position interpreter_state->dstack_position
#define interpreter_catch_env interpreter_state->catch_env
#define interpreter_throw_argument interpreter_state->throw_argument
#define NULL_INTERPRETER_STATE ((interpreter_state_t) NULL)

extern void EXFUN (abort_to_interpreter, (int argument));
extern int EXFUN (abort_to_interpreter_argument, (void));

extern interpreter_state_t interpreter_state;
extern void EXFUN (bind_interpreter_state, (interpreter_state_t));
extern void EXFUN (unbind_interpreter_state, (interpreter_state_t));
