]> code.delx.au - gnu-emacs/blobdiff - src/alloc.c
Merged in changes from CVS trunk.
[gnu-emacs] / src / alloc.c
index 700845ab6c57b50d4e04b19bdf27fcaac38b859d..293519528609581f1f17a193c73d20fed2b7a0da 100644 (file)
@@ -1,5 +1,5 @@
 /* Storage allocation and gc for GNU Emacs Lisp interpreter.
-   Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001, 2002, 2003
+   Copyright (C) 1985,86,88,93,94,95,97,98,1999,2000,01,02,03,2004
       Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
@@ -599,6 +599,7 @@ lisp_malloc (nbytes, type)
 
   val = (void *) malloc (nbytes);
 
+#ifndef USE_LSB_TAG
   /* If the memory just allocated cannot be addressed thru a Lisp
      object's pointer, and it needs to be,
      that's equivalent to running out of memory.  */
@@ -613,6 +614,7 @@ lisp_malloc (nbytes, type)
          val = 0;
        }
     }
+#endif
 
 #if GC_MARK_STACK && !defined GC_MALLOC_CHECK
   if (val && type != MEM_TYPE_NON_LISP)
@@ -773,6 +775,7 @@ lisp_align_malloc (nbytes, type)
       mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
 #endif
 
+#ifndef USE_LSB_TAG
       /* If the memory just allocated cannot be addressed thru a Lisp
         object's pointer, and it needs to be, that's equivalent to
         running out of memory.  */
@@ -789,6 +792,7 @@ lisp_align_malloc (nbytes, type)
              memory_full ();
            }
        }
+#endif
 
       /* Initialize the blocks and put them on the free list.
         Is `base' was not properly aligned, we can't use the last block.  */
@@ -1105,8 +1109,9 @@ uninterrupt_malloc ()
 
 struct interval_block
 {
-  struct interval_block *next;
+  /* Place `intervals' first, to preserve alignment.  */
   struct interval intervals[INTERVAL_BLOCK_SIZE];
+  struct interval_block *next;
 };
 
 /* Current interval block.  Its `next' pointer points to older
@@ -1344,8 +1349,9 @@ struct sblock
 
 struct string_block
 {
-  struct string_block *next;
+  /* Place `strings' first, to preserve alignment.  */
   struct Lisp_String strings[STRING_BLOCK_SIZE];
+  struct string_block *next;
 };
 
 /* Head and tail of the list of sblock structures holding Lisp string
@@ -1944,10 +1950,11 @@ LENGTH must be a number.  INIT matters only in whether it is t or nil.  */)
 
   CHECK_NATNUM (length);
 
-  bits_per_value = sizeof (EMACS_INT) * BITS_PER_CHAR;
+  bits_per_value = sizeof (EMACS_INT) * BOOL_VECTOR_BITS_PER_CHAR;
 
   length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value;
-  length_in_chars = ((XFASTINT (length) + BITS_PER_CHAR - 1) / BITS_PER_CHAR);
+  length_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
+                    / BOOL_VECTOR_BITS_PER_CHAR);
 
   /* We must allocate one more elements than LENGTH_IN_ELTS for the
      slot `size' of the struct Lisp_Bool_Vector.  */
@@ -1964,9 +1971,9 @@ LENGTH must be a number.  INIT matters only in whether it is t or nil.  */)
     p->data[i] = real_init;
 
   /* Clear the extraneous bits in the last byte.  */
-  if (XINT (length) != length_in_chars * BITS_PER_CHAR)
+  if (XINT (length) != length_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
     XBOOL_VECTOR (val)->data[length_in_chars - 1]
-      &= (1 << (XINT (length) % BITS_PER_CHAR)) - 1;
+      &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
 
   return val;
 }
@@ -2126,8 +2133,10 @@ make_uninit_multibyte_string (nchars, nbytes)
    by GC are put on a free list to be reallocated before allocating
    any new float cells from the latest float_block.  */
 
-#define FLOAT_BLOCK_SIZE \
-  (((BLOCK_BYTES - sizeof (struct float_block *)) * CHAR_BIT) \
+#define FLOAT_BLOCK_SIZE                                       \
+  (((BLOCK_BYTES - sizeof (struct float_block *)               \
+     /* The compiler might add padding at the end.  */         \
+     - (sizeof (struct Lisp_Float) - sizeof (int))) * CHAR_BIT) \
    / (sizeof (struct Lisp_Float) * CHAR_BIT + 1))
 
 #define GETMARKBIT(block,n)                            \
@@ -2499,7 +2508,9 @@ allocate_vectorlike (len, type)
   /* Prevent mmap'ing the chunk.  Lisp data may not be mmap'ed
      because mapped region contents are not preserved in
      a dumped Emacs.  */
+  BLOCK_INPUT;
   mallopt (M_MMAP_MAX, 0);
+  UNBLOCK_INPUT;
 #endif
 
   nbytes = sizeof *p + (len - 1) * sizeof p->contents[0];
@@ -2507,7 +2518,9 @@ allocate_vectorlike (len, type)
 
 #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
 
   consing_since_gc += nbytes;
@@ -2750,8 +2763,9 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
 
 struct symbol_block
 {
-  struct symbol_block *next;
+  /* Place `symbols' first, to preserve alignment.  */
   struct Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE];
+  struct symbol_block *next;
 };
 
 /* Current symbol block and index of first unused Lisp_Symbol
@@ -2842,8 +2856,9 @@ Its value and function definition are void, and its property list is nil.  */)
 
 struct marker_block
 {
-  struct marker_block *next;
+  /* Place `markers' first, to preserve alignment.  */
   union Lisp_Misc markers[MARKER_BLOCK_SIZE];
+  struct marker_block *next;
 };
 
 struct marker_block *marker_block;
@@ -3424,6 +3439,7 @@ live_string_p (m, p)
         must not be on the free-list.  */
       return (offset >= 0
              && offset % sizeof b->strings[0] == 0
+             && offset < (STRING_BLOCK_SIZE * sizeof b->strings[0])
              && ((struct Lisp_String *) p)->data != NULL);
     }
   else
@@ -3448,8 +3464,8 @@ live_cons_p (m, p)
         one of the unused cells in the current cons block,
         and not be on the free-list.  */
       return (offset >= 0
-             && offset < (CONS_BLOCK_SIZE * sizeof b->conses[0])
              && offset % sizeof b->conses[0] == 0
+             && offset < (CONS_BLOCK_SIZE * sizeof b->conses[0])
              && (b != cons_block
                  || offset / sizeof b->conses[0] < cons_block_index)
              && !EQ (((struct Lisp_Cons *) p)->car, Vdead));
@@ -3477,6 +3493,7 @@ live_symbol_p (m, p)
         and not be on the free-list.  */
       return (offset >= 0
              && offset % sizeof b->symbols[0] == 0
+             && offset < (SYMBOL_BLOCK_SIZE * sizeof b->symbols[0])
              && (b != symbol_block
                  || offset / sizeof b->symbols[0] < symbol_block_index)
              && !EQ (((struct Lisp_Symbol *) p)->function, Vdead));
@@ -3502,8 +3519,8 @@ live_float_p (m, p)
       /* P must point to the start of a Lisp_Float and not be
         one of the unused cells in the current float block.  */
       return (offset >= 0
-             && offset < (FLOAT_BLOCK_SIZE * sizeof b->floats[0])
              && offset % sizeof b->floats[0] == 0
+             && offset < (FLOAT_BLOCK_SIZE * sizeof b->floats[0])
              && (b != float_block
                  || offset / sizeof b->floats[0] < float_block_index));
     }
@@ -3530,6 +3547,7 @@ live_misc_p (m, p)
         and not be on the free-list.  */
       return (offset >= 0
              && offset % sizeof b->markers[0] == 0
+             && offset < (MARKER_BLOCK_SIZE * sizeof b->markers[0])
              && (b != marker_block
                  || offset / sizeof b->markers[0] < marker_block_index)
              && ((union Lisp_Misc *) p)->u_marker.type != Lisp_Misc_Free);
@@ -4064,6 +4082,9 @@ pure_alloc (size, type)
      int type;
 {
   POINTER_TYPE *result;
+#ifdef USE_LSB_TAG
+  size_t alignment = (1 << GCTYPEBITS);
+#else
   size_t alignment = sizeof (EMACS_INT);
 
   /* Give Lisp_Floats an extra alignment.  */
@@ -4075,6 +4096,7 @@ pure_alloc (size, type)
       alignment = sizeof (struct Lisp_Float);
 #endif
     }
+#endif
 
  again:
   result = ALIGN (purebeg + pure_bytes_used, alignment);
@@ -4210,12 +4232,13 @@ Does not copy symbols.  Copies strings without text properties.  */)
   else if (COMPILEDP (obj) || VECTORP (obj))
     {
       register struct Lisp_Vector *vec;
-      register int i, size;
+      register int i;
+      EMACS_INT size;
 
       size = XVECTOR (obj)->size;
       if (size & PSEUDOVECTOR_FLAG)
        size &= PSEUDOVECTOR_SIZE_MASK;
-      vec = XVECTOR (make_pure_vector ((EMACS_INT) size));
+      vec = XVECTOR (make_pure_vector (size));
       for (i = 0; i < size; i++)
        vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
       if (COMPILEDP (obj))