/[emacs]/emacs/src/alloc.c
ViewVC logotype

Diff of /emacs/src/alloc.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.377 by rms, Fri Oct 28 16:25:37 2005 UTC revision 1.378 by rms, Sat Oct 29 19:39:50 2005 UTC
# Line 182  EMACS_INT gc_relative_threshold; Line 182  EMACS_INT gc_relative_threshold;
182    
183  static Lisp_Object Vgc_cons_percentage;  static Lisp_Object Vgc_cons_percentage;
184    
185    /* Minimum number of bytes of consing since GC before next GC,
186       when memory is full.  */
187    
188    EMACS_INT memory_full_cons_threshold;
189    
190  /* Nonzero during GC.  */  /* Nonzero during GC.  */
191    
192  int gc_in_progress;  int gc_in_progress;
# Line 213  static int total_free_conses, total_free Line 218  static int total_free_conses, total_free
218  static int total_free_floats, total_floats;  static int total_free_floats, total_floats;
219    
220  /* Points to memory space allocated as "spare", to be freed if we run  /* Points to memory space allocated as "spare", to be freed if we run
221     out of memory.  */     out of memory.  We keep one large block, four cons-blocks, and
222       two string blocks.  */
223    
224  char *spare_memory;  char *spare_memory[7];
225    
226  /* Amount of spare memory to keep in reserve.  */  /* Amount of spare memory to keep in large reserve block.  */
227    
228  #define SPARE_MEMORY (1 << 14)  #define SPARE_MEMORY (1 << 14)
229    
# Line 350  enum mem_type Line 356  enum mem_type
356    MEM_TYPE_WINDOW    MEM_TYPE_WINDOW
357  };  };
358    
359    static POINTER_TYPE *lisp_align_malloc P_ ((size_t, enum mem_type));
360    static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type));
361    
362  #if GC_MARK_STACK || defined GC_MALLOC_CHECK  #if GC_MARK_STACK || defined GC_MALLOC_CHECK
363    
364  #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES  #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
# Line 449  static void mem_rotate_right P_ ((struct Line 458  static void mem_rotate_right P_ ((struct
458  static void mem_delete P_ ((struct mem_node *));  static void mem_delete P_ ((struct mem_node *));
459  static void mem_delete_fixup P_ ((struct mem_node *));  static void mem_delete_fixup P_ ((struct mem_node *));
460  static INLINE struct mem_node *mem_find P_ ((void *));  static INLINE struct mem_node *mem_find P_ ((void *));
461    void refill_memory_reserve ();
462    
463    
464  #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS  #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
465  static void check_gcpros P_ ((void));  static void check_gcpros P_ ((void));
# Line 514  display_malloc_warning () Line 525  display_malloc_warning ()
525  #else  #else
526  #  define BYTES_USED _bytes_used  #  define BYTES_USED _bytes_used
527  #endif  #endif
   
   
 /* Called if malloc returns zero.  */  
   
 void  
 memory_full ()  
 {  
   Vmemory_full = Qt;  
   
 #ifndef SYSTEM_MALLOC  
   bytes_used_when_full = BYTES_USED;  
 #endif  
   
   /* The first time we get here, free the spare memory.  */  
   if (spare_memory)  
     {  
       free (spare_memory);  
       spare_memory = 0;  
     }  
   
   /* This used to call error, but if we've run out of memory, we could  
      get infinite recursion trying to build the string.  */  
   while (1)  
     Fsignal (Qnil, Vmemory_signal_data);  
 }  
   
 DEFUN ("memory-full-p", Fmemory_full_p, Smemory_full_p, 0, 0, 0,  
        doc: /* t if memory is nearly full, nil otherwise.  */)  
   ()  
 {  
   return (spare_memory ? Qnil : Qt);  
 }  
   
 /* If we released our reserve (due to running out of memory),  
    and we have a fair amount free once again,  
    try to set aside another reserve in case we run out once more.  
   
    This is called when a relocatable block is freed in ralloc.c.  */  
   
 void  
 refill_memory_reserve ()  
 {  
 #ifndef SYSTEM_MALLOC  
   if (spare_memory == 0)  
     spare_memory = (char *) malloc ((size_t) SPARE_MEMORY);  
 #endif  
 }  
528    
529  /* Called if we can't allocate relocatable space for a buffer.  */  /* Called if we can't allocate relocatable space for a buffer.  */
530    
# Line 578  buffer_memory_full () Line 542  buffer_memory_full ()
542    memory_full ();    memory_full ();
543  #endif  #endif
544    
   Vmemory_full = Qt;  
   
545    /* This used to call error, but if we've run out of memory, we could    /* This used to call error, but if we've run out of memory, we could
546       get infinite recursion trying to build the string.  */       get infinite recursion trying to build the string.  */
547    while (1)    while (1)
# Line 805  xfree (block) Line 767  xfree (block)
767    BLOCK_INPUT;    BLOCK_INPUT;
768    free (block);    free (block);
769    UNBLOCK_INPUT;    UNBLOCK_INPUT;
770      /* We don't call refill_memory_reserve here
771  #ifndef SYSTEM_MALLOC       because that duplicates doing so in emacs_blocked_free
772    /* Refill the spare memory if we can.  */       and the criterion should go there.  */
   if (spare_memory == 0)  
     refill_memory_reserve ();  
 #endif  
773  }  }
774    
775    
# Line 1184  emacs_blocked_free (ptr, ptr2) Line 1143  emacs_blocked_free (ptr, ptr2)
1143       void *ptr;       void *ptr;
1144       const void *ptr2;       const void *ptr2;
1145  {  {
1146      EMACS_INT bytes_used_now;
1147    
1148    BLOCK_INPUT_ALLOC;    BLOCK_INPUT_ALLOC;
1149    
1150  #ifdef GC_MALLOC_CHECK  #ifdef GC_MALLOC_CHECK
# Line 1212  emacs_blocked_free (ptr, ptr2) Line 1173  emacs_blocked_free (ptr, ptr2)
1173    /* If we released our reserve (due to running out of memory),    /* If we released our reserve (due to running out of memory),
1174       and we have a fair amount free once again,       and we have a fair amount free once again,
1175       try to set aside another reserve in case we run out once more.  */       try to set aside another reserve in case we run out once more.  */
1176    if (spare_memory == 0    if (! NILP (Vmemory_full)
1177        /* Verify there is enough space that even with the malloc        /* Verify there is enough space that even with the malloc
1178           hysteresis this call won't run out again.           hysteresis this call won't run out again.
1179           The code here is correct as long as SPARE_MEMORY           The code here is correct as long as SPARE_MEMORY
1180           is substantially larger than the block size malloc uses.  */           is substantially larger than the block size malloc uses.  */
1181        && (bytes_used_when_full        && (bytes_used_when_full
1182            > BYTES_USED + max (malloc_hysteresis, 4) * SPARE_MEMORY))            > ((bytes_used_now = BYTES_USED)
1183      spare_memory = (char *) malloc ((size_t) SPARE_MEMORY);               + max (malloc_hysteresis, 4) * SPARE_MEMORY))
1184        refill_memory_reserve ();
1185    
1186    __free_hook = emacs_blocked_free;    __free_hook = emacs_blocked_free;
1187    UNBLOCK_INPUT_ALLOC;    UNBLOCK_INPUT_ALLOC;
# Line 3386  make_event_array (nargs, args) Line 3348  make_event_array (nargs, args)
3348    
3349    
3350  /************************************************************************  /************************************************************************
3351                               Memory Full Handling
3352     ************************************************************************/
3353    
3354    
3355    /* Called if malloc returns zero.  */
3356    
3357    void
3358    memory_full ()
3359    {
3360      int i;
3361    
3362      Vmemory_full = Qt;
3363    
3364      memory_full_cons_threshold = sizeof (struct cons_block);
3365    
3366      /* The first time we get here, free the spare memory.  */
3367      for (i = 0; i < sizeof (spare_memory) / sizeof (char *); i++)
3368        if (spare_memory[i])
3369          {
3370            if (i == 0)
3371              free (spare_memory[i]);
3372            else if (i >= 1 && i <= 4)
3373              lisp_align_free (spare_memory[i]);
3374            else
3375              lisp_free (spare_memory[i]);
3376            spare_memory[i] = 0;
3377          }
3378    
3379      /* Record the space now used.  When it decreases substantially,
3380         we can refill the memory reserve.  */
3381    #ifndef SYSTEM_MALLOC
3382      bytes_used_when_full = BYTES_USED;
3383    #endif
3384    
3385      /* This used to call error, but if we've run out of memory, we could
3386         get infinite recursion trying to build the string.  */
3387      while (1)
3388        Fsignal (Qnil, Vmemory_signal_data);
3389    }
3390    
3391    /* If we released our reserve (due to running out of memory),
3392       and we have a fair amount free once again,
3393       try to set aside another reserve in case we run out once more.
3394    
3395       This is called when a relocatable block is freed in ralloc.c,
3396       and also directly from this file, in case we're not using ralloc.c.  */
3397    
3398    void
3399    refill_memory_reserve ()
3400    {
3401    #ifndef SYSTEM_MALLOC
3402      if (spare_memory[0] == 0)
3403        spare_memory[0] = (char *) malloc ((size_t) SPARE_MEMORY);
3404      if (spare_memory[1] == 0)
3405        spare_memory[1] = (char *) lisp_align_malloc (sizeof (struct cons_block),
3406                                                      MEM_TYPE_CONS);
3407      if (spare_memory[2] == 0)
3408        spare_memory[2] = (char *) lisp_align_malloc (sizeof (struct cons_block),
3409                                                      MEM_TYPE_CONS);
3410      if (spare_memory[3] == 0)
3411        spare_memory[3] = (char *) lisp_align_malloc (sizeof (struct cons_block),
3412                                                      MEM_TYPE_CONS);
3413      if (spare_memory[4] == 0)
3414        spare_memory[4] = (char *) lisp_align_malloc (sizeof (struct cons_block),
3415                                                      MEM_TYPE_CONS);
3416      if (spare_memory[5] == 0)
3417        spare_memory[5] = (char *) lisp_malloc (sizeof (struct string_block),
3418                                                MEM_TYPE_STRING);
3419      if (spare_memory[6] == 0)
3420        spare_memory[6] = (char *) lisp_malloc (sizeof (struct string_block),
3421                                                MEM_TYPE_STRING);
3422      if (spare_memory[0] && spare_memory[1] && spare_memory[5])
3423        Vmemory_full = Qnil;
3424    #endif
3425    }
3426    
3427    /************************************************************************
3428                             C Stack Marking                             C Stack Marking
3429   ************************************************************************/   ************************************************************************/
3430    
# Line 6012  init_alloc_once () Line 6051  init_alloc_once ()
6051    malloc_hysteresis = 0;    malloc_hysteresis = 0;
6052  #endif  #endif
6053    
6054    spare_memory = (char *) malloc (SPARE_MEMORY);    refill_memory_reserve ();
6055    
6056    ignore_warnings = 0;    ignore_warnings = 0;
6057    gcprolist = 0;    gcprolist = 0;
# Line 6113  This means that certain objects should b Line 6152  This means that certain objects should b
6152               build_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"));               build_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"));
6153    
6154    DEFVAR_LISP ("memory-full", &Vmemory_full,    DEFVAR_LISP ("memory-full", &Vmemory_full,
6155                 doc: /* Non-nil means we are handling a memory-full error.  */);                 doc: /* Non-nil means Emacs cannot get much more Lisp memory.  */);
6156    Vmemory_full = Qnil;    Vmemory_full = Qnil;
6157    
6158    staticpro (&Qgc_cons_threshold);    staticpro (&Qgc_cons_threshold);
# Line 6128  The time is in seconds as a floating poi Line 6167  The time is in seconds as a floating poi
6167    DEFVAR_INT ("gcs-done", &gcs_done,    DEFVAR_INT ("gcs-done", &gcs_done,
6168                doc: /* Accumulated number of garbage collections done.  */);                doc: /* Accumulated number of garbage collections done.  */);
6169    
   defsubr (&Smemory_full_p);  
6170    defsubr (&Scons);    defsubr (&Scons);
6171    defsubr (&Slist);    defsubr (&Slist);
6172    defsubr (&Svector);    defsubr (&Svector);

Legend:
Removed from v.1.377  
changed lines
  Added in v.1.378

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26