* process.c (read_process_output): Do adaptive read buffering even if carryover.
[bpt/emacs.git] / src / alloc.c
index 1ad8af0..54c4760 100644 (file)
@@ -92,7 +92,8 @@ extern __malloc_size_t __malloc_extra_blocks;
 
 #endif /* not DOUG_LEA_MALLOC */
 
-#if ! defined (SYSTEM_MALLOC) && defined (HAVE_GTK_AND_PTHREAD)
+#if ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT
+#ifdef HAVE_GTK_AND_PTHREAD
 
 /* When GTK uses the file chooser dialog, different backends can be loaded
    dynamically.  One such a backend is the Gnome VFS backend that gets loaded
@@ -130,12 +131,13 @@ static pthread_mutex_t alloc_mutex;
     }                                                   \
   while (0)
 
-#else /* SYSTEM_MALLOC || not HAVE_GTK_AND_PTHREAD */
+#else /* ! defined HAVE_GTK_AND_PTHREAD */
 
 #define BLOCK_INPUT_ALLOC BLOCK_INPUT
 #define UNBLOCK_INPUT_ALLOC UNBLOCK_INPUT
 
-#endif /* SYSTEM_MALLOC || not HAVE_GTK_AND_PTHREAD */
+#endif /* ! defined HAVE_GTK_AND_PTHREAD */
+#endif /* ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT */
 
 /* Value of _bytes_used, when spare_memory was freed.  */
 
@@ -152,13 +154,11 @@ static __malloc_size_t bytes_used_when_full;
 #define VECTOR_UNMARK(V)       ((V)->size &= ~ARRAY_MARK_FLAG)
 #define VECTOR_MARKED_P(V)     (((V)->size & ARRAY_MARK_FLAG) != 0)
 
-/* Value is the number of bytes/chars of S, a pointer to a struct
-   Lisp_String.  This must be used instead of STRING_BYTES (S) or
-   S->size during GC, because S->size contains the mark bit for
+/* Value is the number of bytes of S, a pointer to a struct Lisp_String.
+   Be careful during GC, because S->size contains the mark bit for
    strings.  */
 
 #define GC_STRING_BYTES(S)     (STRING_BYTES (S))
-#define GC_STRING_CHARS(S)     ((S)->size & ~ARRAY_MARK_FLAG)
 
 /* Global variables.  */
 struct emacs_globals globals;
@@ -254,8 +254,10 @@ const char *pending_malloc_warning;
 
 /* Buffer in which we save a copy of the C stack at each GC.  */
 
+#if MAX_SAVE_STACK > 0
 static char *stack_copy;
-static int stack_copy_size;
+static size_t stack_copy_size;
+#endif
 
 /* Non-zero means ignore malloc warnings.  Set during initialization.
    Currently not used.  */
@@ -270,7 +272,6 @@ Lisp_Object Qpost_gc_hook;
 
 static void mark_buffer (Lisp_Object);
 static void mark_terminals (void);
-extern void mark_backtrace (void);
 static void gc_sweep (void);
 static void mark_glyph_matrix (struct glyph_matrix *);
 static void mark_face_cache (struct face_cache *);
@@ -2706,7 +2707,7 @@ DEFUN ("list", Flist, Slist, 0, MANY, 0,
        doc: /* Return a newly created list with specified arguments as elements.
 Any number of arguments, even zero arguments, are allowed.
 usage: (list &rest OBJECTS)  */)
-  (int nargs, register Lisp_Object *args)
+  (size_t nargs, register Lisp_Object *args)
 {
   register Lisp_Object val;
   val = Qnil;
@@ -2903,15 +2904,15 @@ See also the function `vector'.  */)
 {
   Lisp_Object vector;
   register EMACS_INT sizei;
-  register EMACS_INT index;
+  register EMACS_INT i;
   register struct Lisp_Vector *p;
 
   CHECK_NATNUM (length);
   sizei = XFASTINT (length);
 
   p = allocate_vector (sizei);
-  for (index = 0; index < sizei; index++)
-    p->contents[index] = init;
+  for (i = 0; i < sizei; i++)
+    p->contents[i] = init;
 
   XSETVECTOR (vector, p);
   return vector;
@@ -2922,32 +2923,41 @@ 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.
 usage: (vector &rest OBJECTS)  */)
-  (register int nargs, Lisp_Object *args)
+  (register size_t nargs, Lisp_Object *args)
 {
   register Lisp_Object len, val;
-  register int index;
+  register size_t i;
   register struct Lisp_Vector *p;
 
   XSETFASTINT (len, nargs);
   val = Fmake_vector (len, Qnil);
   p = XVECTOR (val);
-  for (index = 0; index < nargs; index++)
-    p->contents[index] = args[index];
+  for (i = 0; i < nargs; i++)
+    p->contents[i] = args[i];
   return val;
 }
 
 
 DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
        doc: /* Create a byte-code object with specified arguments as elements.
-The arguments should be the arglist, bytecode-string, constant vector,
-stack size, (optional) doc string, and (optional) interactive spec.
+The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant
+vector CONSTANTS, maximum stack size DEPTH, (optional) DOCSTRING,
+and (optional) INTERACTIVE-SPEC.
 The first four arguments are required; at most six have any
 significance.
+The ARGLIST can be either like the one of `lambda', in which case the arguments
+will be dynamically bound before executing the byte code, or it can be an
+integer of the form NNNNNNNRMMMMMMM where the 7bit MMMMMMM specifies the
+minimum number of arguments, the 7-bit NNNNNNN specifies the maximum number
+of arguments (ignoring &rest) and the R bit specifies whether there is a &rest
+argument to catch the left-over arguments.  If such an integer is used, the
+arguments will not be dynamically bound but will be instead pushed on the
+stack before executing the byte-code.
 usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS)  */)
-  (register int nargs, Lisp_Object *args)
+  (register size_t nargs, Lisp_Object *args)
 {
   register Lisp_Object len, val;
-  register int index;
+  register size_t i;
   register struct Lisp_Vector *p;
 
   XSETFASTINT (len, nargs);
@@ -2965,11 +2975,11 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
     args[1] = Fstring_as_unibyte (args[1]);
 
   p = XVECTOR (val);
-  for (index = 0; index < nargs; index++)
+  for (i = 0; i < nargs; i++)
     {
       if (!NILP (Vpurify_flag))
-       args[index] = Fpurecopy (args[index]);
-      p->contents[index] = args[index];
+       args[i] = Fpurecopy (args[i]);
+      p->contents[i] = args[i];
     }
   XSETPVECTYPE (p, PVEC_COMPILED);
   XSETCOMPILED (val, p);
@@ -3070,6 +3080,7 @@ Its value and function definition are void, and its property list is nil.  */)
   p->gcmarkbit = 0;
   p->interned = SYMBOL_UNINTERNED;
   p->constant = 0;
+  p->declared_special = 0;
   consing_since_gc += sizeof (struct Lisp_Symbol);
   symbols_consed++;
   return val;
@@ -4229,7 +4240,7 @@ static void
 check_gcpros (void)
 {
   struct gcpro *p;
-  int i;
+  size_t i;
 
   for (p = gcprolist; p; p = p->next)
     for (i = 0; i < p->nvars; ++i)
@@ -4312,12 +4323,6 @@ static void
 mark_stack (void)
 {
   int i;
-  /* jmp_buf may not be aligned enough on darwin-ppc64 */
-  union aligned_jmpbuf {
-    Lisp_Object o;
-    jmp_buf j;
-  } j;
-  volatile int stack_grows_down_p = (char *) &j > (char *) stack_base;
   void *end;
 
 #ifdef HAVE___BUILTIN_UNWIND_INIT
@@ -4327,6 +4332,14 @@ mark_stack (void)
   __builtin_unwind_init ();
   end = &end;
 #else /* not HAVE___BUILTIN_UNWIND_INIT */
+#ifndef GC_SAVE_REGISTERS_ON_STACK
+  /* jmp_buf may not be aligned enough on darwin-ppc64 */
+  union aligned_jmpbuf {
+    Lisp_Object o;
+    jmp_buf j;
+  } j;
+  volatile int stack_grows_down_p = (char *) &j > (char *) stack_base;
+#endif
   /* This trick flushes the register windows so that all the state of
      the process is contained in the stack.  */
   /* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is
@@ -4836,7 +4849,7 @@ returns nil, because real GC can't be done.  */)
 {
   register struct specbinding *bind;
   char stack_top_variable;
-  register int i;
+  register size_t i;
   int message_p;
   Lisp_Object total[8];
   int count = SPECPDL_INDEX ();
@@ -4902,21 +4915,26 @@ returns nil, because real GC can't be done.  */)
 #if MAX_SAVE_STACK > 0
   if (NILP (Vpurify_flag))
     {
-      i = &stack_top_variable - stack_bottom;
-      if (i < 0) i = -i;
-      if (i < MAX_SAVE_STACK)
+      char *stack;
+      size_t stack_size;
+      if (&stack_top_variable < stack_bottom)
        {
-         if (stack_copy == 0)
-           stack_copy = (char *) xmalloc (stack_copy_size = i);
-         else if (stack_copy_size < i)
-           stack_copy = (char *) xrealloc (stack_copy, (stack_copy_size = i));
-         if (stack_copy)
+         stack = &stack_top_variable;
+         stack_size = stack_bottom - &stack_top_variable;
+       }
+      else
+       {
+         stack = stack_bottom;
+         stack_size = &stack_top_variable - stack_bottom;
+       }
+      if (stack_size <= MAX_SAVE_STACK)
+       {
+         if (stack_copy_size < stack_size)
            {
-             if ((EMACS_INT) (&stack_top_variable - stack_bottom) > 0)
-               memcpy (stack_copy, stack_bottom, i);
-             else
-               memcpy (stack_copy, &stack_top_variable, i);
+             stack_copy = (char *) xrealloc (stack_copy, stack_size);
+             stack_copy_size = stack_size;
            }
+         memcpy (stack_copy, stack, stack_size);
        }
     }
 #endif /* MAX_SAVE_STACK > 0 */
@@ -5063,18 +5081,18 @@ returns nil, because real GC can't be done.  */)
 
   if (FLOATP (Vgc_cons_percentage))
     { /* Set gc_cons_combined_threshold.  */
-      EMACS_INT total = 0;
-
-      total += total_conses  * sizeof (struct Lisp_Cons);
-      total += total_symbols * sizeof (struct Lisp_Symbol);
-      total += total_markers * sizeof (union Lisp_Misc);
-      total += total_string_size;
-      total += total_vector_size * sizeof (Lisp_Object);
-      total += total_floats  * sizeof (struct Lisp_Float);
-      total += total_intervals * sizeof (struct interval);
-      total += total_strings * sizeof (struct Lisp_String);
-
-      gc_relative_threshold = total * XFLOAT_DATA (Vgc_cons_percentage);
+      EMACS_INT tot = 0;
+
+      tot += total_conses  * sizeof (struct Lisp_Cons);
+      tot += total_symbols * sizeof (struct Lisp_Symbol);
+      tot += total_markers * sizeof (union Lisp_Misc);
+      tot += total_string_size;
+      tot += total_vector_size * sizeof (Lisp_Object);
+      tot += total_floats  * sizeof (struct Lisp_Float);
+      tot += total_intervals * sizeof (struct interval);
+      tot += total_strings * sizeof (struct Lisp_String);
+
+      gc_relative_threshold = tot * XFLOAT_DATA (Vgc_cons_percentage);
     }
   else
     gc_relative_threshold = 0;
@@ -5123,9 +5141,9 @@ returns nil, because real GC can't be done.  */)
 
   if (!NILP (Vpost_gc_hook))
     {
-      int count = inhibit_garbage_collection ();
+      int gc_count = inhibit_garbage_collection ();
       safe_run_hooks (Qpost_gc_hook);
-      unbind_to (count, Qnil);
+      unbind_to (gc_count, Qnil);
     }
 
   /* Accumulate statistics.  */
@@ -5203,7 +5221,7 @@ int last_marked_index;
    links of a list, in mark_object.  In debugging,
    the call to abort will hit a breakpoint.
    Normally this is zero and the check never goes off.  */
-static int mark_object_loop_halt;
+static size_t mark_object_loop_halt;
 
 static void
 mark_vectorlike (struct Lisp_Vector *ptr)
@@ -5260,7 +5278,7 @@ mark_object (Lisp_Object arg)
   void *po;
   struct mem_node *m;
 #endif
-  int cdr_count = 0;
+  size_t cdr_count = 0;
 
  loop:
 
@@ -5304,7 +5322,6 @@ mark_object (Lisp_Object arg)
 
 #else /* not GC_CHECK_MARKED_OBJECTS */
 
-#define CHECK_ALLOCATED()              (void) 0
 #define CHECK_LIVE(LIVEP)              (void) 0
 #define CHECK_ALLOCATED_AND_LIVE(LIVEP)        (void) 0
 
@@ -6056,7 +6073,7 @@ We divide the value by 1024 to make sure it fits in a Lisp integer.  */)
 {
   Lisp_Object end;
 
-  XSETINT (end, (EMACS_INT) sbrk (0) / 1024);
+  XSETINT (end, (EMACS_INT) (char *) sbrk (0) / 1024);
 
   return end;
 }