Merged from miles@gnu.org--gnu-2005 (patch 307-312)

[gnu-emacs] / src / alloc.c

diff --git a/src/alloc.c b/src/alloc.c
index 49fc69e70581c5f386c62ccf1a643f80a995a222..35ce8a5cfa1e1d51b96540eaf5db300cea77144e 100644 (file)
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1,6 +1,6 @@
 /* Storage allocation and gc for GNU Emacs Lisp interpreter.
    Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999,
-      2000, 2001, 2002, 2003, 2004  Free Software Foundation, Inc.
+      2000, 2001, 2002, 2003, 2004, 2005  Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -535,6 +535,12 @@ memory_full ()
     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);
+}
 
 /* Called if we can't allocate relocatable space for a buffer.  */
 
@@ -891,12 +897,13 @@ lisp_free (block)
    On glibc-2.3.2, malloc never tries to align, so a padding of 0 is best.
    posix_memalign on the other hand would ideally prefer a value of 4
    because otherwise, there's 1020 bytes wasted between each ablocks.
-   But testing shows that those 1020 will most of the time be efficiently
-   used by malloc to place other objects, so a value of 0 is still preferable
-   unless you have a lot of cons&floats and virtually nothing else.  */
+   In Emacs, testing shows that those 1020 can most of the time be
+   efficiently used by malloc to place other objects, so a value of 0 can
+   still preferable unless you have a lot of aligned blocks and virtually
+   nothing else.  */
 #define BLOCK_PADDING 0
 #define BLOCK_BYTES \
-  (BLOCK_ALIGN - sizeof (struct aligned_block *) - BLOCK_PADDING)
+  (BLOCK_ALIGN - sizeof (struct ablock *) - BLOCK_PADDING)
 
 /* Internal data structures and constants.  */
 
@@ -1502,7 +1509,7 @@ mark_interval_tree (tree)
 #ifndef make_number
 Lisp_Object
 make_number (n)
-     int n;
+     EMACS_INT n;
 {
   Lisp_Object obj;
   obj.s.val = n;
@@ -1933,14 +1940,18 @@ allocate_string_data (s, nchars, nbytes)
          mmap'ed data typically have an address towards the top of the
          address space, which won't fit into an EMACS_INT (at least on
          32-bit systems with the current tagging scheme).  --fx  */
+      BLOCK_INPUT;
       mallopt (M_MMAP_MAX, 0);
+      UNBLOCK_INPUT;
 #endif
 
       b = (struct sblock *) lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP);
 
 #ifdef DOUG_LEA_MALLOC
       /* Back to a reasonable maximum of mmap'ed areas. */
+      BLOCK_INPUT;
       mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
+      UNBLOCK_INPUT;
 #endif
 
       b->next_free = &b->first_data;
@@ -3010,18 +3021,18 @@ The property's value should be an integer between 0 and 10.  */)
 }
 
 
-/* Return a newly created sub char table with default value DEFALT.
+/* Return a newly created sub char table with slots initialized by INIT.
    Since a sub char table does not appear as a top level Emacs Lisp
    object, we don't need a Lisp interface to make it.  */
 
 Lisp_Object
-make_sub_char_table (defalt)
-     Lisp_Object defalt;
+make_sub_char_table (init)
+     Lisp_Object init;
 {
   Lisp_Object vector
-    = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), Qnil);
+    = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), init);
   XCHAR_TABLE (vector)->top = Qnil;
-  XCHAR_TABLE (vector)->defalt = defalt;
+  XCHAR_TABLE (vector)->defalt = Qnil;
   XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
   return vector;
 }
@@ -4683,6 +4694,8 @@ returns nil, because real GC can't be done.  */)
   if (pure_bytes_used_before_overflow)
     return Qnil;
 
+  CHECK_CONS_LIST ();
+
   /* Don't keep undo information around forever.
      Do this early on, so it is no problem if the user quits.  */
   {
@@ -4877,6 +4890,8 @@ returns nil, because real GC can't be done.  */)
 
   UNBLOCK_INPUT;
 
+  CHECK_CONS_LIST ();
+
   /* clear_marks (); */
   gc_in_progress = 0;
 
@@ -6071,6 +6086,7 @@ The time is in seconds as a floating point value.  */);
   DEFVAR_INT ("gcs-done", &gcs_done,
              doc: /* Accumulated number of garbage collections done.  */);
 
+  defsubr (&Smemory_full_p);
   defsubr (&Scons);
   defsubr (&Slist);
   defsubr (&Svector);