home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD2.bin / bbs / dev / umbscheme-2.12.lha / UMBScheme / src / architecture.c < prev    next >
C/C++ Source or Header  |  1993-11-29  |  14KB  |  651 lines
  1. /* architecture.c -- UMB Scheme, symbol table, stacks and heap.
  2.  
  3. UMB Scheme Interpreter                  $Revision: 2.12 $
  4. Copyright (C) 1988, 1991 William R Campbell
  5.  
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. This program is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with this program; if not, write to the Free Software
  18. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. UMB Scheme was written by Bill Campbell with help from Karl Berry,
  21. Barbara Dixey, Ira Gerstein, Mary Glaser, Kathy Hargreaves, Bill McCabe,
  22. Long Nguyen, Susan Quina, Jeyashree Sivasubram, Bela Sohoni and Thang Quoc Tran.
  23.  
  24. For additional information about UMB Scheme, contact the author:
  25.  
  26.     Bill Campbell
  27.     Department of Mathematics and Computer Science
  28.     University of Massachusetts at Boston
  29.     Harbor Campus
  30.     Boston, MA 02125
  31.  
  32.     Telephone: 617-287-6449        Internet: bill@cs.umb.edu
  33.  
  34. */
  35.  
  36. #include <signal.h>
  37. #include "portable.h"
  38. #include "io.h"
  39. #include "eval.h"
  40. #include "object.h"
  41. #include "architecture.h"
  42. #include "steering.h"
  43. #include "debug.h"
  44. #include "primitive.h"
  45. #include "number.h"
  46.  
  47. Public Object     Expression_Register, Value_Register, Environment_Register, 
  48.         Function_Register, Arguments_Register, State_Register;
  49.  
  50. Public ELabel    PC_Register;
  51.  
  52. Public    Object    Value_Debugged, State_Debugged;
  53.  
  54. Public    ELabel    PC_Debugged;
  55.  
  56. Public    Integer Arg_Stack_Ptr = 0;
  57. Public    Integer    Debugged_Ptr  = 0;
  58. Public    Object    Arg_Stack[ARG_STACK_SIZE];
  59.  
  60. /* Garbage collector declarations. */
  61.  
  62. Public    Boolean    Allocating = FALSE;
  63. Public    Boolean Show_GC_Messages = TRUE;
  64.  
  65. Private Integer Free = 0;        /* First free location. */
  66. Private Integer Working = 0;        /* Space allocations come from this. */
  67. Private Integer Fallow = 1;        /* The half currently not in use. */
  68. Private Byte * Heap[2] = { NULL,NULL};    /* Two spaces. */
  69.  
  70. #define INITIAL_HEAPSIZE     200000
  71. #define MAX_HEAPSIZE          800000
  72. #define    ENLARGEMENT_FACTOR    2
  73. #define DESIRED_RECLAIMATION    0.2
  74.  
  75. Private Integer Heapsize = INITIAL_HEAPSIZE;
  76. Private    Boolean    Enable_Heap_Enlargement = TRUE;
  77. Private    Integer    Next_Heapsize = INITIAL_HEAPSIZE;
  78.  
  79.  
  80. typedef struct entry_structure
  81. {
  82.     Object Symbol;
  83.     struct entry_structure *Next;
  84. } Entry;
  85.  
  86.  
  87. Private Entry * Make_Entry();
  88.  
  89. Private    void Init_Heap(size)
  90.  
  91. Integer size;
  92.  
  93. {
  94.     if (Heap[0] == NULL && Heap[1] == NULL )
  95.     {
  96.         Heap[0] = (Byte *)malloc( (unsigned) (size+ALIGNMENT));
  97.         Heap[1] = (Byte *)malloc( (unsigned) (size+ALIGNMENT));
  98.     }
  99.  
  100.     if ( Heap[0] == NULL || Heap[1] == NULL )
  101.     {
  102.         Output( "\nPANIC: Not enough memory for the heap.\n" );
  103.         exit(1);
  104.     }
  105.  
  106.     Free = 0;
  107.     Working = 0;
  108.     Fallow = 1;
  109. }
  110.  
  111. /* Get the current size of the heap. */
  112.  
  113. Public void Get_Heap_Size()
  114. {
  115.     Integer_To_Number(Heapsize - Free);
  116. }
  117.  
  118. Public void Get_Arg_Stack_Ptr()
  119. {
  120.     Integer_To_Number( Arg_Stack_Ptr );
  121. }
  122.  
  123.  
  124.  
  125. /* Allocate some memory from the working space. */
  126.  
  127. Public Object Allocate(size)
  128.  
  129.     Integer size;
  130.  
  131. {
  132.     Object    new;
  133.     void    Garbage_Collect();
  134.  
  135.     Allocating = TRUE;
  136.  
  137.     if (Free + size >= Heapsize)
  138.     {
  139.         /* Not enough space. */
  140.         Garbage_Collect();
  141.     }
  142.  
  143.     if (Free + size < Heapsize)
  144.     {
  145.         /* Enough space now, or was before. */
  146.         new = (Object)&Heap[Working][Free];
  147. #if (ALIGNMENT-1)
  148.         /* Alignment (if not 1; defined in portable.h) */
  149.  
  150.         Free += ((size+ALIGNMENT-1)/ALIGNMENT)*ALIGNMENT;
  151. #else
  152.         Free += size;
  153. #endif
  154.     }
  155.     else
  156.     {
  157.         Panic( "Memory Exhausted" );
  158.         new =  Nil; 
  159.     }
  160.  
  161.     if ( Control_C )
  162.     {
  163.         Control_C = FALSE;
  164.         Allocating = FALSE;
  165.         Handler( SIGINT );
  166.     }
  167.     Allocating = FALSE;
  168.  
  169.     return new;
  170. }
  171.  
  172.  
  173. Public void Garbage_Collect()
  174. {
  175.     Integer this_argument;
  176.     Integer orig_free = Free;
  177.     Byte    *new_heap[2] ;
  178.     Character temp_string[120];
  179.     
  180.     if ( Show_GC_Messages )
  181.     {
  182.         Output( "GCing... " );
  183.     }
  184.  
  185.     if ( Next_Heapsize > Heapsize )
  186.     {
  187.         /* Allocate a new, larger, heap */
  188.  
  189.         new_heap[0] = NULL;
  190.         new_heap[1] = NULL;
  191.         new_heap[0] = (Byte *) malloc((unsigned) Next_Heapsize);
  192.         new_heap[1] = (Byte *) malloc((unsigned) Next_Heapsize);
  193.  
  194.         if ( new_heap[0] == NULL || new_heap[1] == NULL )
  195.         {
  196.             /* Reallocation has failed  -- Disable enlargement */
  197.  
  198.             if ( new_heap[0] != NULL ) free( new_heap[0] );
  199.             if ( new_heap[1] != NULL ) free( new_heap[1] );
  200.             Enable_Heap_Enlargement = FALSE;
  201.             Next_Heapsize = Heapsize;
  202.         }
  203.         else
  204.         {
  205.             /* Enlarge the current fallow (next working) heap. */
  206.             free( Heap[Fallow] );
  207.             Heap[Fallow] = new_heap[Fallow];
  208.         }
  209.     }
  210.  
  211.     /* Exchange spaces. */
  212.     Working = 1 - Working;
  213.     Fallow = 1 - Fallow;
  214.  
  215.     /* Nothing's allocated yet in the new space. */
  216.     Free = 0;
  217.  
  218.     /* Garbage collect the (object) registers. */
  219.     Relocate(&Expression_Register);
  220.     Relocate(&Value_Register);
  221.     Relocate(&Environment_Register);
  222.     Relocate(&Function_Register);
  223.     Relocate(&Arguments_Register);
  224.     Relocate(&State_Register);
  225.  
  226.     /* Garbage collect the (object) debugged registers */
  227.  
  228.     Relocate(&Value_Debugged);
  229.     Relocate(&State_Debugged);
  230.  
  231.     /* And the special objects. */
  232.     Relocate(&Nil);
  233.     Relocate(&The_Global_Environment);
  234.     Relocate(&The_True_Object);
  235.     Relocate(&The_False_Object);
  236.     Relocate(&The_Eof_Object);
  237.     Relocate(&Current_Input_Port);
  238.     Relocate(&Current_Output_Port);
  239.     Relocate(&The_Transcript_Port);
  240.     Relocate(&The_Dot_Object);
  241.     Relocate(&The_Rparen_Object);
  242.  
  243.     /* Debugger Registers */
  244.     Relocate(&Traced_Procedures);
  245.  
  246.     /* And the special symbols. */
  247.     Relocate(&The_Undefined_Symbol);
  248.     Relocate(&The_Syntactic_Keyword);
  249.     Relocate(&An_Argument);
  250.     Relocate("E_Symbol);
  251.     Relocate(&DEFINE_Symbol);
  252.     Relocate(&SET_Symbol);
  253.     Relocate(&IF_Symbol);
  254.     Relocate(&MACRO_Symbol);
  255.     Relocate(&BEGIN_Symbol);
  256.     Relocate(&DELAY_Symbol);
  257.     Relocate(&LAMBDA_Symbol);
  258.  
  259.     /* Now gc the stack... */
  260.     for (this_argument = 0; this_argument < Arg_Stack_Ptr; 
  261.                 this_argument++)
  262.     {
  263.         Relocate(&Arg_Stack[this_argument]);
  264.     }
  265.  
  266.     /* ...and the symbols. */
  267.     Symbol_Hash_Iterate(Relocate);
  268.  
  269.     if ( Next_Heapsize != Heapsize )
  270.     {
  271.         /* Enlarge the current fallow (previous working) heap. */
  272.         free( Heap[Fallow] );
  273.         Heap[Fallow] = new_heap[Fallow];
  274.         Heapsize = Next_Heapsize;
  275.     }
  276.  
  277.     if ( Show_GC_Messages )
  278.     {
  279.         sprintf( temp_string,
  280.          "%d bytes collected, %d bytes used, heapsize %d bytes.\n", 
  281.          orig_free-Free, Free, Heapsize );
  282.             Output(temp_string);
  283.     }
  284.  
  285.     if ( Enable_Heap_Enlargement && Heapsize < MAX_HEAPSIZE )
  286.     {
  287.         /* Decide whether to enlarge heap at next garbage collection */
  288.  
  289.         if ( (float) Free / (float) Heapsize > DESIRED_RECLAIMATION )
  290.         {
  291.             Next_Heapsize = Heapsize * ENLARGEMENT_FACTOR;
  292.             if ( Next_Heapsize > MAX_HEAPSIZE )
  293.             {
  294.                 Next_Heapsize = MAX_HEAPSIZE;
  295.                 if ( Show_GC_Messages )
  296.                  Output("Disabling enlargement due to size.\n");
  297.             }
  298.         }
  299.     }
  300. }
  301.  
  302.  
  303. Public void Relocate( old )
  304.  
  305.     Object * old;
  306. {
  307.     if ( *old != NULL )
  308.     {
  309.         if (Is_Forwarded(*old))
  310.         {
  311.             *old = Get_Forwarding_Address(*old);
  312.         }
  313.         else
  314.         {
  315.             *old = GC_Object(*old);
  316.         }
  317.     }
  318. }
  319.  
  320.  
  321.  
  322. Public Object Move_Object(old_object, size)
  323.  
  324.     Object old_object;
  325.     Integer size;
  326. {
  327.     Byte *new, *old;
  328.     Object new_object;
  329.  
  330.     new_object = Allocate(size); /* GC never called during GC */
  331.     old = (Byte *) old_object;
  332.     new = (Byte *) new_object;
  333.  
  334.     for (; size > 0; size--)
  335.     {
  336.         *new++ = *old++;
  337.     }
  338.  
  339.     Set_Forwarding_Address(old_object,new_object);
  340.     return( new_object );
  341. }
  342.  
  343. /* Symbol table/environment handling stuff. */
  344.  
  345. Public void Assign(var, value, env)
  346.     
  347.     Object var, value, env;
  348. {
  349.     Object*    location;
  350.     Object* how;
  351.     Integer    frame;
  352.  
  353.     if ( Is_Local_Variable( var ) )
  354.     {
  355.         for ( frame = 0;
  356.               frame < Get_Variable_Frame_Number( var );
  357.                   frame++ ) env = Get_Environment_Frame_Previous( env );
  358.         location = &Get_Environment_Frame_Binding_Value( env ,
  359.                 Get_Variable_Displacement( var ) );
  360.         how = &Get_Environment_Frame_Binding_How( env ,
  361.                 Get_Variable_Displacement( var ) );
  362.     }
  363.     else
  364.     {
  365.         location = &Get_Global_Binding(Get_Variable_Symbol( var ) );
  366.         how = &Get_Symbol_How(Get_Variable_Symbol( var ) );
  367.     }
  368.  
  369.     if (*location == The_Undefined_Symbol)
  370.     {
  371.         Error1("`%s' is undefi