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 / stack.h < prev    next >
C/C++ Source or Header  |  1999-01-02  |  12KB  |  360 lines
  1. /* -*-C-*-
  2.  
  3. $Id: stack.h,v 9.38 1999/01/02 06:11:34 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. /* This file contains macros for manipulating stacks and stacklets. */
  23.  
  24. #ifndef STACK_RESET
  25. # define STACK_RESET() do {} while (0)
  26. #endif /* STACK_RESET */
  27.  
  28. #ifdef USE_STACKLETS
  29.  
  30. /*
  31.   Stack is made up of linked small parts, each in the heap
  32.  */
  33.  
  34. #define INITIALIZE_STACK() do                        \
  35. {                                    \
  36.   if (GC_Check(Default_Stacklet_Size))                    \
  37.     Microcode_Termination(TERM_STACK_ALLOCATION_FAILED);        \
  38.   SET_STACK_GUARD (Free + STACKLET_HEADER_SIZE);            \
  39.   *Free =                                \
  40.     (MAKE_OBJECT (TC_MANIFEST_VECTOR, (Default_Stacklet_Size - 1)));    \
  41.   Free += Default_Stacklet_Size;                    \
  42.   Stack_Pointer = Free;                            \
  43.   Free_Stacklets = NULL;                        \
  44.   Prev_Restore_History_Stacklet = NULL;                    \
  45.   Prev_Restore_History_Offset = 0;                    \
  46. } while (0)
  47.  
  48. /* This is a lie, but OK in the context in which it is used. */
  49.  
  50. #define STACK_OVERFLOWED_P()    FALSE
  51.  
  52. #define Internal_Will_Push(N)                        \
  53. {                                    \
  54.   if ((Stack_Pointer - (N)) < Stack_Guard)                \
  55.   {                                    \
  56.     Export_Registers();                            \
  57.     Allocate_New_Stacklet((N));                        \
  58.     Import_Registers();                            \
  59.   }                                    \
  60. }
  61.  
  62. /* No space required independent of the heap for the stacklets */
  63.  
  64. #define STACK_ALLOCATION_SIZE(Stack_Blocks)    0
  65.  
  66. #define Current_Stacklet    (Stack_Guard - STACKLET_HEADER_SIZE)
  67.  
  68. /* Make the unused portion of the old stacklet invisible to garbage
  69.  * collection. This also allows the stack pointer to be reconstructed.
  70.  */
  71.  
  72. #define Internal_Terminate_Old_Stacklet()                \
  73. {                                    \
  74.   Current_Stacklet[STACKLET_REUSE_FLAG] = SHARP_T;            \
  75.   Current_Stacklet[STACKLET_UNUSED_LENGTH] =                \
  76.     MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, (Stack_Pointer - Stack_Guard));    \
  77. }
  78.  
  79. #ifdef ENABLE_DEBUGGING_TOOLS
  80.  
  81. #define Terminate_Old_Stacklet()                    \
  82. {                                    \
  83.   if (Stack_Pointer < Stack_Guard)                    \
  84.   {                                    \
  85.     outf_fatal ("\nStack_Pointer: 0x%lx, Guard: 0x%lx\n",        \
  86.                 ((long) Stack_Pointer), ((long) Stack_Guard));        \
  87.     Microcode_Termination(TERM_EXIT);                    \
  88.   }                                    \
  89.   Internal_Terminate_Old_Stacklet();                    \
  90. }
  91.  
  92. #else /* not ENABLE_DEBUGGING_TOOLS */
  93.  
  94. #define Terminate_Old_Stacklet()    Internal_Terminate_Old_Stacklet()
  95.  
  96. #endif /* ENABLE_DEBUGGING_TOOLS */
  97.  
  98. /* Used by garbage collector to detect the end of constant space */
  99.  
  100. #define CONSTANT_AREA_START()    Constant_Space
  101.  
  102. #define Get_Current_Stacklet()                        \
  103.   (MAKE_POINTER_OBJECT (TC_CONTROL_POINT, Current_Stacklet))
  104.  
  105. #define Previous_Stack_Pointer(Where)                    \
  106.   (MEMORY_LOC                                \
  107.    (Where,                                \
  108.     (STACKLET_HEADER_SIZE +                        \
  109.      (OBJECT_DATUM (MEMORY_REF (Where, STACKLET_UNUSED_LENGTH))))))
  110.  
  111. #define Set_Current_Stacklet(Where)                    \
  112. {                                    \
  113.   SCHEME_OBJECT Our_Where;                        \
  114.                                     \
  115.   Our_Where = (Where);                            \
  116.   SET_STACK_GUARD (MEMORY_LOC (Our_Where, STACKLET_HEADER_SIZE));    \
  117.   Stack_Pointer = Previous_Stack_Pointer(Our_Where);            \
  118. }
  119.  
  120. #define STACKLET_SLACK    (STACKLET_HEADER_SIZE + CONTINUATION_SIZE)
  121.  
  122. #define Default_Stacklet_Size     (Stack_Size + STACKLET_SLACK)
  123.  
  124. #define New_Stacklet_Size(N)                        \
  125.  (STACKLET_SLACK + Stack_Size * (((N) + Stack_Size - 1) / Stack_Size))
  126.  
  127. #define Get_End_Of_Stacklet()                        \
  128.   (&(Current_Stacklet[1 + OBJECT_DATUM (Current_Stacklet[STACKLET_LENGTH])]))
  129.  
  130. #define Apply_Stacklet_Backout()                    \
  131. Will_Push((2 * CONTINUATION_SIZE) + (STACK_ENV_EXTRA_SLOTS + 2));    \
  132.   Store_Expression(SHARP_F);                        \
  133.   Store_Return(RC_END_OF_COMPUTATION);                    \
  134.   Save_Cont();                                \
  135.   STACK_PUSH (Val);                            \
  136.   STACK_PUSH (Previous_Stacklet);                    \
  137.   STACK_PUSH (STACK_FRAME_HEADER + 1);                    \
  138.   Store_Return(RC_INTERNAL_APPLY);                    \
  139.   Save_Cont();                                \
  140. Pushed()
  141.  
  142. #define Join_Stacklet_Backout()        Apply_Stacklet_Backout()
  143.  
  144. /* This depends on the fact that Within_Control_Point is going to
  145.  * push an apply frame immediately after Return_To_Previous_Stacklet
  146.  * "returns".  This apply will cause the GC, then the 2nd argument to
  147.  * Within_Control_Point will be invoked, and finally the control point
  148.  * will be entered.
  149.  */
  150.  
  151. #define Within_Stacklet_Backout()                    \
  152. {                                    \
  153.   SCHEME_OBJECT Old_Expression;                        \
  154.                                     \
  155.   Old_Expression = Fetch_Expression();                    \
  156.   Store_Expression(Previous_Stacklet);                    \
  157.   Store_Return(RC_JOIN_STACKLETS);                    \
  158.   Save_Cont();                                \
  159.   Store_Expression(Old_Expression);                    \
  160. }
  161.  
  162. /* Our_Throw is used in chaining from one stacklet to another.  In
  163.  * order to improve efficiency, the entire stack is copied neither on
  164.  * catch or throw, but is instead copied one stacklet at a time as
  165.  * needed.  The need to copy a stacklet is signified by the object in
  166.  * the STACKLET_REUSE_FLAG of a stacklet.  If this object is #F, the
  167.  * stacklet is copied when it is "returned into", and the word is set
  168.  * to #F in the stacklet into which the copied one will return. When a
  169.  * stacklet is returned from, it is no longer needed for anything so it
  170.  * can be deallocated.  A free list of deallocate stacklets is kept in
  171.  * order to improve the efficiencty of their use.
  172.  */
  173.  
  174. #define Our_Throw(From_Pop_Return, Stacklet)                \
  175. {                                    \
  176.   SCHEME_OBJECT Previous_Stacklet;                    \
  177.   SCHEME_OBJECT *Stacklet_Top;                        \
  178.                                     \
  179.   Previous_Stacklet = (Stacklet);                    \
  180.   Stacklet_Top = Current_Stacklet;                    \
  181.   Stacklet_Top[STACKLET_FREE_LIST_LINK] =                \
  182.     ((SCHEME_OBJECT) Free_Stacklets);                    \
  183.   Free_Stacklets = Stacklet_Top;                    \
  184.   if (!(From_Pop_Return))                        \
  185.   {                                    \
  186.     Prev_Restore_History_Stacklet = NULL;                \
  187.     Prev_Restore_History_Offset = 0;                    \
  188.   }                                    \
  189.   if ((MEMORY_REF (Previous_Stacklet, STACKLET_REUSE_FLAG)) == SHARP_F)    \
  190.   {                                    \
  191.     /* We need to copy the stacklet into which we are            \
  192.        returning.                            \
  193.      */                                    \
  194.                                     \
  195.     if (GC_Check(VECTOR_LENGTH (Previous_Stacklet) + 1))        \
  196.     {                                    \
  197.       /* We don't have enough space to copy the stacklet. */        \
  198.                                     \
  199.       Free_Stacklets =                            \
  200.     ((SCHEME_OBJECT *) Free_Stacklets[STACKLET_FREE_LIST_LINK]);    \
  201.       Stack_Pointer = Get_End_Of_Stacklet();                \
  202.       Prev_Restore_History_Stacklet = NULL;                \
  203.       Prev_Restore_History_Offset = 0
  204.  
  205.       /* Backout code inserted here by macro user */
  206.  
  207. #define Our_Throw_Part_2()                        \
  208.       Request_GC(VECTOR_LENGTH (Previous_Stacklet) + 1);        \
  209.     }                                    \
  210.     else                                \
  211.     {                                    \
  212.       /* There is space available to copy the stacklet. */        \
  213.                                     \
  214.       long Unused_Length;                        \
  215.       fast Used_Length;                            \
  216.       fast SCHEME_OBJECT *Old_Stacklet_Top, *temp;            \
  217.       SCHEME_OBJECT *First_Continuation;                \
  218.                                     \
  219.       Old_Stacklet_Top = OBJECT_ADDRESS (Previous_Stacklet);        \
  220.       First_Continuation =                        \
  221.         MEMORY_LOC (Previous_Stacklet,                    \
  222.             ((1 + VECTOR_LENGTH (Previous_Stacklet)) -        \
  223.              CONTINUATION_SIZE));                \
  224.       if (Old_Stacklet_Top == Prev_Restore_History_Stacklet)        \
  225.         Prev_Restore_History_Stacklet = NULL;                \
  226.       if (First_Continuation[CONTINUATION_RETURN_CODE] ==        \
  227.       MAKE_OBJECT (TC_RETURN_CODE, RC_JOIN_STACKLETS))        \
  228.       {                                    \
  229.     SCHEME_OBJECT Older_Stacklet;                    \
  230.                                     \
  231.     Older_Stacklet = First_Continuation[CONTINUATION_EXPRESSION];    \
  232.     MEMORY_SET (Older_Stacklet, STACKLET_REUSE_FLAG, SHARP_F);    \
  233.       }                                    \
  234.       temp = Free;                            \
  235.       SET_STACK_GUARD (& (temp[STACKLET_HEADER_SIZE]));            \
  236.       temp[STACKLET_LENGTH] = Old_Stacklet_Top[STACKLET_LENGTH];    \
  237.       Unused_Length =                            \
  238.     OBJECT_DATUM (Old_Stacklet_Top[STACKLET_UNUSED_LENGTH]) +    \
  239.         STACKLET_HEADER_SIZE;                        \
  240.       temp += Unused_Length;                        \
  241.       Stack_Pointer = temp;                        \
  242.       Used_Length =                            \
  243.         (OBJECT_DATUM (Old_Stacklet_Top[STACKLET_LENGTH]) -        \
  244.          Unused_Length) + 1;                        \
  245.       Old_Stacklet_Top += Unused_Length;                \
  246.       while (--Used_Length >= 0)                    \
  247.     *temp++ = *Old_Stacklet_Top++;                    \
  248.       Free = temp;                            \
  249.     }                                    \
  250.   }                                    \
  251.   else                                    \
  252.   {                                    \
  253.     /* No need to copy the stacklet we are going into */        \
  254.                                     \
  255.     if (OBJECT_ADDRESS (Previous_Stacklet)==                \
  256.         Prev_Restore_History_Stacklet)                    \
  257.       Prev_Restore_History_Stacklet = NULL;                \
  258.     Set_Current_Stacklet(Previous_Stacklet);                \
  259.   }                                    \
  260. }
  261.  
  262. #else /* not USE_STACKLETS */
  263.  
  264. /*
  265.   Full size stack in a statically allocated area
  266.  */
  267.  
  268. #define Stack_Check(P) do                        \
  269. {                                    \
  270.   if ((P) <= Stack_Guard)                        \
  271.     {                                    \
  272.       extern void EXFUN (stack_death, (CONST char *));            \
  273.       if (STACK_OVERFLOWED_P ())                    \
  274.     stack_death ("Stack_Check");                    \
  275.       REQUEST_INTERRUPT (INT_Stack_Overflow);                \
  276.     }                                    \
  277. } while (0)
  278.  
  279. #define Internal_Will_Push(N)    Stack_Check(Stack_Pointer - (N))
  280.  
  281. #define Terminate_Old_Stacklet()
  282.  
  283. #define Get_Current_Stacklet() SHARP_F
  284.  
  285. #define Set_Current_Stacklet(Where) {}
  286.  
  287. #define Previous_Stack_Pointer(Where)                    \
  288.   (MEMORY_LOC                                \
  289.    (Where,                                \
  290.     (STACKLET_HEADER_SIZE +                        \
  291.      (OBJECT_DATUM (MEMORY_REF (Where, STACKLET_UNUSED_LENGTH))))))
  292.  
  293. /* Never allocate more space */
  294. #define New_Stacklet_Size(N)    0
  295.  
  296. #define Get_End_Of_Stacklet()    Stack_Top
  297.  
  298. /* Not needed in this version */
  299.  
  300. #define Join_Stacklet_Backout()
  301. #define Apply_Stacklet_Backout()
  302. #define Within_Stacklet_Backout()
  303.  
  304. /* This piece of code KNOWS which way the stack grows.
  305.    The assumption is that successive pushes modify decreasing addresses.
  306.  */
  307.  
  308. /* Clear the stack and replace it with a copy of the contents of the
  309.    control point. Also disables the history collection mechanism,
  310.    since the saved history would be incorrect on the new stack. */
  311.  
  312. #define Our_Throw(From_Pop_Return, P) do                \
  313. {                                    \
  314.   SCHEME_OBJECT Control_Point;                        \
  315.   fast SCHEME_OBJECT *To_Where, *From_Where;                \
  316.   fast long len, valid, invalid;                    \
  317.                                     \
  318.   Control_Point = (P);                            \
  319.   if ((Consistency_Check)                        \
  320.       && (OBJECT_TYPE (Control_Point) != TC_CONTROL_POINT))        \
  321.     Microcode_Termination (TERM_BAD_STACK);                \
  322.   len = VECTOR_LENGTH (Control_Point);                    \
  323.   invalid = ((OBJECT_DATUM (MEMORY_REF (Control_Point,            \
  324.                     STACKLET_UNUSED_LENGTH))) +    \
  325.          STACKLET_HEADER_SIZE);                    \
  326.   valid = ((len + 1) - invalid);                    \
  327.   CLEAR_INTERRUPT(INT_Stack_Overflow);                    \
  328.   To_Where = (Stack_Top - valid);                    \
  329.   From_Where = MEMORY_LOC (Control_Point, invalid);            \
  330.   Stack_Check (To_Where);                        \
  331.   Stack_Pointer = To_Where;                        \
  332.   while (--valid >= 0)                            \
  333.     *To_Where++ = *From_Where++;                    \
  334.   if (Consistency_Check)                        \
  335.   {                                    \
  336.     if ((To_Where != Stack_Top) ||                    \
  337.     (From_Where !=                            \
  338.      MEMORY_LOC (Control_Point, (1 + len))))            \
  339.       Microcode_Termination (TERM_BAD_STACK);                \
  340.   }                                    \
  341.   STACK_RESET ();                            \
  342.   if (!(From_Pop_Return))                        \
  343.   {                                    \
  344.     Prev_Restore_History_Stacklet = NULL;                \
  345.     Prev_Restore_History_Offset = 0;                    \
  346.     if ((!Valid_Fixed_Obj_Vector ()) ||                    \
  347.     (Get_Fixed_Obj_Slot (Dummy_History) == SHARP_F))        \
  348.       History = Make_Dummy_History ();                    \
  349.     else                                \
  350.       History = OBJECT_ADDRESS (Get_Fixed_Obj_Slot (Dummy_History));    \
  351.   }                                    \
  352.   else if (Prev_Restore_History_Stacklet ==                \
  353.        OBJECT_ADDRESS (Control_Point))                \
  354.     Prev_Restore_History_Stacklet = NULL;                \
  355. } while (0)
  356.  
  357. #define Our_Throw_Part_2()
  358.  
  359. #endif /* USE_STACKLETS */
  360.