(abbrev-start-location): Doc fix.

[gnu-emacs] / src / alloc.c

diff --git a/src/alloc.c b/src/alloc.c
index 6340761c88091d49ef611ae98754a3949c22fed0..067dd7b753e8ee594ecee59b6f657ebbb603213b 100644 (file)
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1,5 +1,5 @@
 /* Storage allocation and gc for GNU Emacs Lisp interpreter.
 /* Storage allocation and gc for GNU Emacs Lisp interpreter.

-   Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001
+   Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001, 2002

       Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
       Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.


@@ -122,18 +122,18 @@ int consing_since_gc;
 
 /* Count the amount of consing of various sorts of space.  */
 
 
 /* Count the amount of consing of various sorts of space.  */
 

-int cons_cells_consed;
-int floats_consed;
-int vector_cells_consed;
-int symbols_consed;
-int string_chars_consed;
-int misc_objects_consed;
-int intervals_consed;
-int strings_consed;
+EMACS_INT cons_cells_consed;
+EMACS_INT floats_consed;
+EMACS_INT vector_cells_consed;
+EMACS_INT symbols_consed;
+EMACS_INT string_chars_consed;
+EMACS_INT misc_objects_consed;
+EMACS_INT intervals_consed;
+EMACS_INT strings_consed;

 
 /* Number of bytes of consing since GC before another GC should be done. */
 
 
 /* Number of bytes of consing since GC before another GC should be done. */
 

-int gc_cons_threshold;
+EMACS_INT gc_cons_threshold;

 
 /* Nonzero during GC.  */
 
 
 /* Nonzero during GC.  */
 


@@ -155,8 +155,8 @@ int malloc_sbrk_unused;
 
 /* Two limits controlling how much undo information to keep.  */
 
 
 /* Two limits controlling how much undo information to keep.  */
 

-int undo_limit;
-int undo_strong_limit;
+EMACS_INT undo_limit;
+EMACS_INT undo_strong_limit;

 
 /* Number of live and free conses etc.  */
 
 
 /* Number of live and free conses etc.  */
 


@@ -215,7 +215,7 @@ static size_t pure_bytes_used_before_overflow;
 
 /* Index in pure at which next pure object will be allocated.. */
 
 
 /* Index in pure at which next pure object will be allocated.. */
 

-int pure_bytes_used;
+EMACS_INT pure_bytes_used;

 
 /* If nonzero, this is a warning delivered by malloc and not yet
    displayed.  */
 
 /* If nonzero, this is a warning delivered by malloc and not yet
    displayed.  */


@@ -396,7 +396,7 @@ struct gcpro *gcprolist;
 
 /* Addresses of staticpro'd variables.  */
 
 
 /* Addresses of staticpro'd variables.  */
 

-#define NSTATICS 1024
+#define NSTATICS 1280

 Lisp_Object *staticvec[NSTATICS] = {0};
 
 /* Index of next unused slot in staticvec.  */
 Lisp_Object *staticvec[NSTATICS] = {0};
 
 /* Index of next unused slot in staticvec.  */


@@ -1020,7 +1020,7 @@ make_number (n)
 
 /* Lisp_Strings are allocated in string_block structures.  When a new
    string_block is allocated, all the Lisp_Strings it contains are
 
 /* Lisp_Strings are allocated in string_block structures.  When a new
    string_block is allocated, all the Lisp_Strings it contains are

-   added to a free-list stiing_free_list.  When a new Lisp_String is
+   added to a free-list string_free_list.  When a new Lisp_String is

    needed, it is taken from that list.  During the sweep phase of GC,
    string_blocks that are entirely free are freed, except two which
    we keep.
    needed, it is taken from that list.  During the sweep phase of GC,
    string_blocks that are entirely free are freed, except two which
    we keep.


@@ -1668,8 +1668,8 @@ Both LENGTH and INIT must be numbers.  */)
   register unsigned char *p, *end;
   int c, nbytes;
 
   register unsigned char *p, *end;
   int c, nbytes;
 

-  CHECK_NATNUM (length, 0);
-  CHECK_NUMBER (init, 1);
+  CHECK_NATNUM (length);
+  CHECK_NUMBER (init);

 
   c = XINT (init);
   if (SINGLE_BYTE_CHAR_P (c))
 
   c = XINT (init);
   if (SINGLE_BYTE_CHAR_P (c))


@@ -1713,7 +1713,7 @@ LENGTH must be a number.  INIT matters only in whether it is t or nil.  */)
   int real_init, i;
   int length_in_chars, length_in_elts, bits_per_value;
 
   int real_init, i;
   int length_in_chars, length_in_elts, bits_per_value;
 

-  CHECK_NATNUM (length, 0);
+  CHECK_NATNUM (length);

 
   bits_per_value = sizeof (EMACS_INT) * BITS_PER_CHAR;
 
 
   bits_per_value = sizeof (EMACS_INT) * BITS_PER_CHAR;
 


@@ -2130,7 +2130,7 @@ list5 (arg1, arg2, arg3, arg4, arg5)
 
 
 DEFUN ("list", Flist, Slist, 0, MANY, 0,
 
 
 DEFUN ("list", Flist, Slist, 0, MANY, 0,

-  doc: /* Return a newly created list with specified arguments as elements.
+       doc: /* Return a newly created list with specified arguments as elements.

 Any number of arguments, even zero arguments, are allowed.
 usage: (list &rest OBJECTS)  */)
      (nargs, args)
 Any number of arguments, even zero arguments, are allowed.
 usage: (list &rest OBJECTS)  */)
      (nargs, args)


@@ -2157,7 +2157,7 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
   register Lisp_Object val;
   register int size;
 
   register Lisp_Object val;
   register int size;
 

-  CHECK_NATNUM (length, 0);
+  CHECK_NATNUM (length);

   size = XFASTINT (length);
 
   val = Qnil;
   size = XFASTINT (length);
 
   val = Qnil;


@@ -2347,7 +2347,7 @@ See also the function `vector'.  */)
   register int index;
   register struct Lisp_Vector *p;
 
   register int index;
   register struct Lisp_Vector *p;
 

-  CHECK_NATNUM (length, 0);
+  CHECK_NATNUM (length);

   sizei = XFASTINT (length);
 
   p = allocate_vector (sizei);
   sizei = XFASTINT (length);
 
   p = allocate_vector (sizei);


@@ -2369,9 +2369,9 @@ The property's value should be an integer between 0 and 10.  */)
 {
   Lisp_Object vector;
   Lisp_Object n;
 {
   Lisp_Object vector;
   Lisp_Object n;

-  CHECK_SYMBOL (purpose, 1);
+  CHECK_SYMBOL (purpose);

   n = Fget (purpose, Qchar_table_extra_slots);
   n = Fget (purpose, Qchar_table_extra_slots);

-  CHECK_NUMBER (n, 0);
+  CHECK_NUMBER (n);

   if (XINT (n) < 0 || XINT (n) > 10)
     args_out_of_range (n, Qnil);
   /* Add 2 to the size for the defalt and parent slots.  */
   if (XINT (n) < 0 || XINT (n) > 10)
     args_out_of_range (n, Qnil);
   /* Add 2 to the size for the defalt and parent slots.  */


@@ -2403,7 +2403,7 @@ make_sub_char_table (defalt)
 
 
 DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
 
 
 DEFUN ("vector", Fvector, Svector, 0, MANY, 0,

-  doc: /* Return a newly created vector with specified arguments as elements.
+       doc: /* Return a newly created vector with specified arguments as elements.

 Any number of arguments, even zero arguments, are allowed.
 usage: (vector &rest OBJECTS)  */)
      (nargs, args)
 Any number of arguments, even zero arguments, are allowed.
 usage: (vector &rest OBJECTS)  */)
      (nargs, args)


@@ -2521,7 +2521,7 @@ Its value and function definition are void, and its property list is nil.  */)
   register Lisp_Object val;
   register struct Lisp_Symbol *p;
 
   register Lisp_Object val;
   register struct Lisp_Symbol *p;
 

-  CHECK_STRING (name, 0);
+  CHECK_STRING (name);

 
   if (symbol_free_list)
     {
 
   if (symbol_free_list)
     {


@@ -2711,6 +2711,17 @@ make_event_array (nargs, args)
 
 #if GC_MARK_STACK || defined GC_MALLOC_CHECK
 
 
 #if GC_MARK_STACK || defined GC_MALLOC_CHECK
 

+/* Conservative C stack marking requires a method to identify possibly
+   live Lisp objects given a pointer value.  We do this by keeping
+   track of blocks of Lisp data that are allocated in a red-black tree
+   (see also the comment of mem_node which is the type of nodes in
+   that tree).  Function lisp_malloc adds information for an allocated
+   block to the red-black tree with calls to mem_insert, and function
+   lisp_free removes it with mem_delete.  Functions live_string_p etc
+   call mem_find to lookup information about a given pointer in the
+   tree, and use that to determine if the pointer points to a Lisp
+   object or not.  */
+

 /* Initialize this part of alloc.c.  */
 
 static void
 /* Initialize this part of alloc.c.  */
 
 static void


@@ -3574,7 +3585,7 @@ If you are a system-programmer, or can get the help of a local wizard\n\
 who is, please take a look at the function mark_stack in alloc.c, and\n\
 verify that the methods used are appropriate for your system.\n\
 \n\
 who is, please take a look at the function mark_stack in alloc.c, and\n\
 verify that the methods used are appropriate for your system.\n\
 \n\

-Please mail the result to <gerd@gnu.org>.\n\
+Please mail the result to <emacs-devel@gnu.org>.\n\

 "
 
 #define SETJMP_WILL_NOT_WORK "\
 "
 
 #define SETJMP_WILL_NOT_WORK "\


@@ -3586,7 +3597,7 @@ solution for your system.\n\
 \n\
 Please take a look at the function mark_stack in alloc.c, and\n\
 try to find a way to make it work on your system.\n\
 \n\
 Please take a look at the function mark_stack in alloc.c, and\n\
 try to find a way to make it work on your system.\n\

-Please mail the result to <gerd@gnu.org>.\n\
+Please mail the result to <emacs-devel@gnu.org>.\n\

 "
 
 
 "
 
 


@@ -3723,6 +3734,7 @@ dump_zombies ()
 static void
 mark_stack ()
 {
 static void
 mark_stack ()
 {

+  int i;

   jmp_buf j;
   volatile int stack_grows_down_p = (char *) &j > (char *) stack_base;
   void *end;
   jmp_buf j;
   volatile int stack_grows_down_p = (char *) &j > (char *) stack_base;
   void *end;


@@ -3758,17 +3770,11 @@ mark_stack ()
   /* This assumes that the stack is a contiguous region in memory.  If
      that's not the case, something has to be done here to iterate
      over the stack segments.  */
   /* This assumes that the stack is a contiguous region in memory.  If
      that's not the case, something has to be done here to iterate
      over the stack segments.  */

-#if GC_LISP_OBJECT_ALIGNMENT == 1
-  mark_memory (stack_base, end);
-  mark_memory ((char *) stack_base + 1, end);
-  mark_memory ((char *) stack_base + 2, end);
-  mark_memory ((char *) stack_base + 3, end);
-#elif GC_LISP_OBJECT_ALIGNMENT == 2
-  mark_memory (stack_base, end);
-  mark_memory ((char *) stack_base + 2, end);
-#else
-  mark_memory (stack_base, end);
+#ifndef GC_LISP_OBJECT_ALIGNMENT
+#define GC_LISP_OBJECT_ALIGNMENT sizeof (Lisp_Object)

 #endif
 #endif

+  for (i = 0; i < sizeof (Lisp_Object); i += GC_LISP_OBJECT_ALIGNMENT)
+    mark_memory ((char *) stack_base + i, end);

 
 #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
   check_gcpros ();
 
 #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
   check_gcpros ();


@@ -3816,8 +3822,11 @@ pure_alloc (size, type)
   
   if (pure_bytes_used + nbytes > pure_size)
     {
   
   if (pure_bytes_used + nbytes > pure_size)
     {

-      beg = purebeg = (char *) xmalloc (PURESIZE);
-      pure_size = PURESIZE;
+      /* Don't allocate a large amount here,
+        because it might get mmap'd and then its address
+        might not be usable.  */
+      beg = purebeg = (char *) xmalloc (10000);
+      pure_size = 10000;

       pure_bytes_used_before_overflow += pure_bytes_used;
       pure_bytes_used = 0;
     }
       pure_bytes_used_before_overflow += pure_bytes_used;
       pure_bytes_used = 0;
     }


@@ -3828,14 +3837,14 @@ pure_alloc (size, type)
 }
 
 
 }
 
 

-/* Signal an error if PURESIZE is too small.  */
+/* Print a warning if PURESIZE is too small.  */

 
 void
 check_pure_size ()
 {
   if (pure_bytes_used_before_overflow)
 
 void
 check_pure_size ()
 {
   if (pure_bytes_used_before_overflow)

-    error ("Pure Lisp storage overflow (approx. %d bytes needed)",
-          (int) (pure_bytes_used + pure_bytes_used_before_overflow));
+    message ("Pure Lisp storage overflow (approx. %d bytes needed)",
+            (int) (pure_bytes_used + pure_bytes_used_before_overflow));

 }
 
 
 }
 
 


@@ -4012,7 +4021,9 @@ int
 inhibit_garbage_collection ()
 {
   int count = specpdl_ptr - specpdl;
 inhibit_garbage_collection ()
 {
   int count = specpdl_ptr - specpdl;

-  specbind (Qgc_cons_threshold, make_number (MOST_POSITIVE_FIXNUM));
+  int nbits = min (VALBITS, BITS_PER_INT);
+
+  specbind (Qgc_cons_threshold, make_number (((EMACS_INT) 1 << (nbits - 1)) - 1));

   return count;
 }
 
   return count;
 }
 


@@ -4096,6 +4107,24 @@ Garbage collection happens automatically if you cons more than
          nextb->undo_list 
            = truncate_undo_list (nextb->undo_list, undo_limit,
                                  undo_strong_limit);
          nextb->undo_list 
            = truncate_undo_list (nextb->undo_list, undo_limit,
                                  undo_strong_limit);

+
+       /* Shrink buffer gaps, but skip indirect and dead buffers.  */
+       if (nextb->base_buffer == 0 && !NILP (nextb->name))
+         {
+           /* If a buffer's gap size is more than 10% of the buffer
+              size, or larger than 2000 bytes, then shrink it
+              accordingly.  Keep a minimum size of 20 bytes.  */
+           int size = min (2000, max (20, (nextb->text->z_byte / 10)));
+
+           if (nextb->text->gap_size > size)
+             {
+               struct buffer *save_current = current_buffer;
+               current_buffer = nextb;
+               make_gap (-(nextb->text->gap_size - size));
+               current_buffer = save_current;
+             }
+         }
+

        nextb = nextb->next;
       }
   }
        nextb = nextb->next;
       }
   }


@@ -4610,6 +4639,10 @@ mark_object (argptr)
          h->size |= ARRAY_MARK_FLAG;
 
          /* Mark contents.  */
          h->size |= ARRAY_MARK_FLAG;
 
          /* Mark contents.  */

+         /* Do not mark next_free or next_weak.
+            Being in the next_weak chain 
+            should not keep the hash table alive.
+            No need to mark `count' since it is an integer.  */

          mark_object (&h->test);
          mark_object (&h->weak);
          mark_object (&h->rehash_size);
          mark_object (&h->test);
          mark_object (&h->weak);
          mark_object (&h->rehash_size);


@@ -4859,6 +4892,7 @@ mark_kboards ()
       mark_object (&kb->Vsystem_key_alist);
       mark_object (&kb->system_key_syms);
       mark_object (&kb->Vdefault_minibuffer_frame);
       mark_object (&kb->Vsystem_key_alist);
       mark_object (&kb->system_key_syms);
       mark_object (&kb->Vdefault_minibuffer_frame);

+      mark_object (&kb->echo_string);

     }
 }
 
     }
 }