home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / microcode / interp.h < prev    next >
C/C++ Source or Header  |  2000-12-05  |  7KB  |  240 lines
  1. /* -*-C-*-
  2.  
  3. $Id: interp.h,v 9.42 2000/12/05 21:23:45 cph Exp $
  4.  
  5. Copyright (c) 1987-1999 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. */
  21.  
  22. /* Macros used by the interpreter and some utilities. */
  23.  
  24. extern void EXFUN (abort_to_interpreter, (int argument));
  25. extern int EXFUN (abort_to_interpreter_argument, (void));
  26.  
  27.                      /********************/
  28.                      /* OPEN CODED RACKS */
  29.                      /********************/
  30.  
  31. /* Move from register to static storage and back */
  32.  
  33. /* Note defined() cannot be used because VMS does not understand it. */
  34.  
  35. #ifdef In_Main_Interpreter
  36. #ifndef ENABLE_DEBUGGING_TOOLS
  37. #define Cache_Registers
  38. #endif
  39. #endif
  40.  
  41. #ifdef Cache_Registers
  42.  
  43. #define Regs        Reg_Block
  44. #define Stack_Pointer    Reg_Stack_Pointer
  45. #define History        Reg_History
  46.  
  47. #define Import_Registers()                        \
  48. {                                    \
  49.   Reg_Stack_Pointer = Ext_Stack_Pointer;                \
  50.   Reg_History = Ext_History;                        \
  51. }
  52.  
  53. #define Export_Registers()                        \
  54. {                                    \
  55.   Ext_History = Reg_History;                        \
  56.   Ext_Stack_Pointer = Reg_Stack_Pointer;                \
  57. }
  58.  
  59. /* Importing History is required for C_call_scheme for work correctly because
  60.    the recursive call to Interpret() can rotate the history:
  61. */
  62. #define IMPORT_REGS_AFTER_PRIMITIVE()                                   \
  63. {                                                                       \
  64.     Reg_History = Ext_History;                                          \
  65. }
  66.  
  67. #define EXPORT_REGS_BEFORE_PRIMITIVE Export_Registers
  68.  
  69. #else
  70.  
  71. #define Regs        Registers
  72. #define Stack_Pointer    Ext_Stack_Pointer
  73. #define History        Ext_History
  74.  
  75. #define Import_Registers()
  76. #define Export_Registers()
  77.  
  78. #define IMPORT_REGS_AFTER_PRIMITIVE()
  79. #define EXPORT_REGS_BEFORE_PRIMITIVE()
  80.  
  81. #endif
  82.  
  83. #define Import_Val()
  84. #define Import_Registers_Except_Val()        Import_Registers()
  85.  
  86. #define Env        Regs[REGBLOCK_ENV]
  87. #define Val        Regs[REGBLOCK_VAL]
  88. #define Expression    Regs[REGBLOCK_EXPR]
  89. #define Return        Regs[REGBLOCK_RETURN]
  90.  
  91. /* Internal_Will_Push is in stack.h. */
  92.  
  93. #ifdef ENABLE_DEBUGGING_TOOLS
  94.  
  95. #define Will_Push(N)                            \
  96. {                                    \
  97.   SCHEME_OBJECT *Will_Push_Limit;                    \
  98.                                     \
  99.   Internal_Will_Push((N));                        \
  100.   Will_Push_Limit = (STACK_LOC (- (N)))
  101.  
  102. #define Pushed()                            \
  103.   if (Stack_Pointer < Will_Push_Limit)                    \
  104.   {                                    \
  105.     Stack_Death();                            \
  106.   }                                    \
  107. }
  108.  
  109. #else
  110.  
  111. #define Will_Push(N)            Internal_Will_Push(N)
  112. #define Pushed()            /* No op */
  113.  
  114. #endif
  115.  
  116. /*
  117.   N in Will_Eventually_Push is the maximum contiguous (single return code)
  118.   amount that this operation may take.  On the average case it may use less.
  119.   M in Finished_Eventual_Pushing is the amount not yet pushed.
  120.  */
  121.  
  122. #define Will_Eventually_Push(N)        Internal_Will_Push(N)
  123. #define Finished_Eventual_Pushing(M)    /* No op */
  124.  
  125. /* Primitive stack operations:
  126.    These operations hide the direction of stack growth.
  127.    `Throw' in "stack.h", `Allocate_New_Stacklet' in "utils.c",
  128.    `apply', `cwcc' and friends in "hooks.c", and possibly other stuff,
  129.    depend on the direction in which the stack grows. */
  130.  
  131. #define STACK_LOCATIVE_DECREMENT(locative) (-- (locative))
  132. #define STACK_LOCATIVE_INCREMENT(locative) ((locative) ++)
  133. #define STACK_LOCATIVE_OFFSET(locative, offset) ((locative) + (offset))
  134. #define STACK_LOCATIVE_REFERENCE(locative, offset) ((locative) [(offset)])
  135. #define STACK_LOCATIVE_DIFFERENCE(x, y) ((x) - (y))
  136.  
  137. #define STACK_LOCATIVE_PUSH(locative)                    \
  138.   (* (STACK_LOCATIVE_DECREMENT (locative)))
  139.  
  140. #define STACK_LOCATIVE_POP(locative)                    \
  141.   (* (STACK_LOCATIVE_INCREMENT (locative)))
  142.  
  143. #define STACK_PUSH(object) (STACK_LOCATIVE_PUSH (Stack_Pointer)) = (object)
  144. #define STACK_POP() (STACK_LOCATIVE_POP (Stack_Pointer))
  145. #define STACK_LOC(offset) (STACK_LOCATIVE_OFFSET (Stack_Pointer, (offset)))
  146. #define STACK_REF(offset) (STACK_LOCATIVE_REFERENCE (Stack_Pointer, (offset)))
  147.  
  148. /* Fetch from register */
  149.  
  150. #define Fetch_Expression()    Expression
  151. #define Fetch_Env()        Env
  152. #define Fetch_Return()        Return
  153.  
  154. /* Store into register */
  155.  
  156. #define Store_Expression(P)    Expression = (P)
  157. #define Store_Env(P)        Env = (P)
  158. #define Store_Return(P)                            \
  159.   Return = (MAKE_OBJECT (TC_RETURN_CODE, (P)))
  160.  
  161. #define Save_Env()        STACK_PUSH (Env)
  162. #define Restore_Env()        Env = (STACK_POP ())
  163. #define Restore_Then_Save_Env()    Env = (STACK_REF (0))
  164.  
  165. /* Note: Save_Cont must match the definitions in sdata.h */
  166.  
  167. #define Save_Cont()                            \
  168. {                                    \
  169.   STACK_PUSH (Expression);                        \
  170.   STACK_PUSH (Return);                            \
  171. }
  172.  
  173. #define Restore_Cont()                            \
  174. {                                    \
  175.   Return = (STACK_POP ());                        \
  176.   Expression = (STACK_POP ());                        \
  177. }
  178.  
  179. #define Stop_Trapping()                            \
  180. {                                    \
  181.   Trapping = false;                            \
  182. }
  183.  
  184. /* Primitive utility macros */
  185.  
  186. #ifndef ENABLE_DEBUGGING_TOOLS
  187.  
  188. #define PRIMITIVE_APPLY PRIMITIVE_APPLY_INTERNAL
  189.  
  190. #else
  191.  
  192. extern SCHEME_OBJECT EXFUN
  193.   (primitive_apply_internal, (SCHEME_OBJECT primitive));
  194. #define PRIMITIVE_APPLY(loc, primitive)                    \
  195.   (loc) = (primitive_apply_internal (primitive))
  196.  
  197. #endif
  198.  
  199. #define PRIMITIVE_APPLY_INTERNAL(loc, primitive)            \
  200. {                                    \
  201.   (Regs[REGBLOCK_PRIMITIVE]) = (primitive);                \
  202.   {                                    \
  203.     /* Save the dynamic-stack position. */                \
  204.     PTR PRIMITIVE_APPLY_INTERNAL_position = dstack_position;        \
  205.     (loc) =                                \
  206.       ((* (Primitive_Procedure_Table [PRIMITIVE_NUMBER (primitive)]))    \
  207.        ());                                \
  208.     /* If the primitive failed to unwind the dynamic stack, lose. */    \
  209.     if (PRIMITIVE_APPLY_INTERNAL_position != dstack_position)        \
  210.       {                                    \
  211.     outf_fatal ("\nPrimitive slipped the dynamic stack: %s\n",    \
  212.             (PRIMITIVE_NAME (primitive)));            \
  213.     Microcode_Termination (TERM_EXIT);                \
  214.       }                                    \
  215.   }                                    \
  216.   (Regs[REGBLOCK_PRIMITIVE]) = SHARP_F;                    \
  217. }
  218.  
  219. #define POP_PRIMITIVE_FRAME(arity) Stack_Pointer = (STACK_LOC (arity))
  220.  
  221. typedef struct interpreter_state_s * interpreter_state_t;
  222.  
  223. struct interpreter_state_s
  224. {
  225.   interpreter_state_t previous_state;
  226.   unsigned int nesting_level;
  227.   PTR dstack_position;
  228.   jmp_buf catch_env;
  229.   int throw_argument;
  230. };
  231.  
  232. #define interpreter_catch_dstack_position interpreter_state->dstack_position
  233. #define interpreter_catch_env interpreter_state->catch_env
  234. #define interpreter_throw_argument interpreter_state->throw_argument
  235. #define NULL_INTERPRETER_STATE ((interpreter_state_t) NULL)
  236.  
  237. extern interpreter_state_t interpreter_state;
  238. extern void EXFUN (bind_interpreter_state, (interpreter_state_t));
  239. extern void EXFUN (unbind_interpreter_state, (interpreter_state_t));
  240.