]> code.delx.au - gnu-emacs/blobdiff - src/alloc.c
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-34
[gnu-emacs] / src / alloc.c
index f0c77a26710380b6356a316827338fa0d6dd5989..ea52c98fd2497d1d2e1a452d378e8dd01be3c56a 100644 (file)
@@ -49,7 +49,7 @@ Boston, MA 02110-1301, USA.  */
 #include "keyboard.h"
 #include "frame.h"
 #include "blockinput.h"
-#include "charset.h"
+#include "character.h"
 #include "syssignal.h"
 #include <setjmp.h>
 
@@ -1422,7 +1422,11 @@ make_interval ()
 {
   INTERVAL val;
 
-  eassert (!handling_signal);
+  /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+  BLOCK_INPUT;
+#endif
 
   if (interval_free_list)
     {
@@ -1445,6 +1449,11 @@ make_interval ()
        }
       val = &interval_block->intervals[interval_block_index++];
     }
+
+#ifndef SYNC_INPUT
+  UNBLOCK_INPUT;
+#endif
+
   consing_since_gc += sizeof (struct interval);
   intervals_consed++;
   RESET_INTERVAL (val);
@@ -1842,7 +1851,11 @@ allocate_string ()
 {
   struct Lisp_String *s;
 
-  eassert (!handling_signal);
+  /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+  BLOCK_INPUT;
+#endif
 
   /* If the free-list is empty, allocate a new string_block, and
      add all the Lisp_Strings in it to the free-list.  */
@@ -1873,6 +1886,10 @@ allocate_string ()
   s = string_free_list;
   string_free_list = NEXT_FREE_LISP_STRING (s);
 
+#ifndef SYNC_INPUT
+  UNBLOCK_INPUT;
+#endif
+
   /* Probably not strictly necessary, but play it safe.  */
   bzero (s, sizeof *s);
 
@@ -1920,6 +1937,12 @@ allocate_string_data (s, nchars, nbytes)
   /* Determine the number of bytes needed to store NBYTES bytes
      of string data.  */
   needed = SDATA_SIZE (nbytes);
+  old_data = s->data ? SDATA_OF_STRING (s) : NULL;
+  old_nbytes = GC_STRING_BYTES (s);
+
+#ifndef SYNC_INPUT
+  BLOCK_INPUT;
+#endif
 
   if (nbytes > LARGE_STRING_BYTES)
     {
@@ -1974,12 +1997,13 @@ allocate_string_data (s, nchars, nbytes)
   else
     b = current_sblock;
 
-  old_data = s->data ? SDATA_OF_STRING (s) : NULL;
-  old_nbytes = GC_STRING_BYTES (s);
-
   data = b->next_free;
   b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA);
 
+#ifndef SYNC_INPUT
+  UNBLOCK_INPUT;
+#endif
+
   data->string = s;
   s->data = SDATA_DATA (data);
 #ifdef GC_CHECK_STRING_BYTES
@@ -2244,7 +2268,7 @@ INIT must be an integer that represents a character.  */)
   CHECK_NUMBER (init);
 
   c = XINT (init);
-  if (SINGLE_BYTE_CHAR_P (c))
+  if (ASCII_CHAR_P (c))
     {
       nbytes = XINT (length);
       val = make_uninit_string (nbytes);
@@ -2275,7 +2299,7 @@ INIT must be an integer that represents a character.  */)
 
 
 DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
-       doc: /* Return a new bool-vector of length LENGTH, using INIT for as each element.
+       doc: /* Return a new bool-vector of length LENGTH, using INIT for each element.
 LENGTH must be a number.  INIT matters only in whether it is t or nil.  */)
      (length, init)
      Lisp_Object length, init;
@@ -2560,7 +2584,11 @@ make_float (float_value)
 {
   register Lisp_Object val;
 
-  eassert (!handling_signal);
+  /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+  BLOCK_INPUT;
+#endif
 
   if (float_free_list)
     {
@@ -2587,6 +2615,10 @@ make_float (float_value)
       float_block_index++;
     }
 
+#ifndef SYNC_INPUT
+  UNBLOCK_INPUT;
+#endif
+
   XFLOAT_DATA (val) = float_value;
   eassert (!FLOAT_MARKED_P (XFLOAT (val)));
   consing_since_gc += sizeof (struct Lisp_Float);
@@ -2681,7 +2713,11 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
 {
   register Lisp_Object val;
 
-  eassert (!handling_signal);
+  /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+  BLOCK_INPUT;
+#endif
 
   if (cons_free_list)
     {
@@ -2707,6 +2743,10 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
       cons_block_index++;
     }
 
+#ifndef SYNC_INPUT
+  UNBLOCK_INPUT;
+#endif
+
   XSETCAR (val, car);
   XSETCDR (val, cdr);
   eassert (!CONS_MARKED_P (XCONS (val)));
@@ -2880,8 +2920,17 @@ allocate_vectorlike (len, type)
   consing_since_gc += nbytes;
   vector_cells_consed += len;
 
+#ifndef SYNC_INPUT
+  BLOCK_INPUT;
+#endif
+
   p->next = all_vectors;
   all_vectors = p;
+
+#ifndef SYNC_INPUT
+  UNBLOCK_INPUT;
+#endif
+
   ++n_vectors;
   return p;
 }
@@ -2998,49 +3047,6 @@ See also the function `vector'.  */)
 }
 
 
-DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
-       doc: /* Return a newly created char-table, with purpose PURPOSE.
-Each element is initialized to INIT, which defaults to nil.
-PURPOSE should be a symbol which has a `char-table-extra-slots' property.
-The property's value should be an integer between 0 and 10.  */)
-     (purpose, init)
-     register Lisp_Object purpose, init;
-{
-  Lisp_Object vector;
-  Lisp_Object n;
-  CHECK_SYMBOL (purpose);
-  n = Fget (purpose, Qchar_table_extra_slots);
-  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.  */
-  vector = Fmake_vector (make_number (CHAR_TABLE_STANDARD_SLOTS + XINT (n)),
-                        init);
-  XCHAR_TABLE (vector)->top = Qt;
-  XCHAR_TABLE (vector)->parent = Qnil;
-  XCHAR_TABLE (vector)->purpose = purpose;
-  XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
-  return vector;
-}
-
-
-/* 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 (init)
-     Lisp_Object init;
-{
-  Lisp_Object vector
-    = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), init);
-  XCHAR_TABLE (vector)->top = Qnil;
-  XCHAR_TABLE (vector)->defalt = Qnil;
-  XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
-  return vector;
-}
-
-
 DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
        doc: /* Return a newly created vector with specified arguments as elements.
 Any number of arguments, even zero arguments, are allowed.
@@ -3160,7 +3166,11 @@ Its value and function definition are void, and its property list is nil.  */)
 
   CHECK_STRING (name);
 
-  eassert (!handling_signal);
+  /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+  BLOCK_INPUT;
+#endif
 
   if (symbol_free_list)
     {
@@ -3183,6 +3193,10 @@ Its value and function definition are void, and its property list is nil.  */)
       symbol_block_index++;
     }
 
+#ifndef SYNC_INPUT
+  UNBLOCK_INPUT;
+#endif
+
   p = XSYMBOL (val);
   p->xname = name;
   p->plist = Qnil;
@@ -3242,7 +3256,11 @@ allocate_misc ()
 {
   Lisp_Object val;
 
-  eassert (!handling_signal);
+  /* eassert (!handling_signal); */
+
+#ifndef SYNC_INPUT
+  BLOCK_INPUT;
+#endif
 
   if (marker_free_list)
     {
@@ -3266,6 +3284,10 @@ allocate_misc ()
       marker_block_index++;
     }
 
+#ifndef SYNC_INPUT
+  UNBLOCK_INPUT;
+#endif
+
   --total_free_markers;
   consing_since_gc += sizeof (union Lisp_Misc);
   misc_objects_consed++;
@@ -4659,7 +4681,7 @@ void
 check_pure_size ()
 {
   if (pure_bytes_used_before_overflow)
-    message ("Pure Lisp storage overflow (approx. %d bytes needed)",
+    message ("emacs:0:Pure Lisp storage overflow (approx. %d bytes needed)",
             (int) (pure_bytes_used + pure_bytes_used_before_overflow));
 }
 
@@ -4746,7 +4768,7 @@ make_pure_vector (len)
 
 
 DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
-       doc: /* Make a copy of OBJECT in pure storage.
+       doc: /* Make a copy of object OBJ in pure storage.
 Recursively copies contents of vectors and cons cells.
 Does not copy symbols.  Copies strings without text properties.  */)
      (obj)
@@ -6289,7 +6311,6 @@ The time is in seconds as a floating point value.  */);
   defsubr (&Smake_byte_code);
   defsubr (&Smake_list);
   defsubr (&Smake_vector);
-  defsubr (&Smake_char_table);
   defsubr (&Smake_string);
   defsubr (&Smake_bool_vector);
   defsubr (&Smake_symbol);