*** empty log message ***

[gnu-emacs] / src / alloc.c

diff --git a/src/alloc.c b/src/alloc.c
index d7e4214c6c43610b5390a7b10786a6adc2a5e79f..0c58f3cc1bef3f141e9a914448e16b77e66b4b4f 100644 (file)
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -97,9 +97,9 @@ static __malloc_size_t bytes_used_when_full;
 /* Mark, unmark, query mark bit of a Lisp string.  S must be a pointer
    to a struct Lisp_String.  */
 
-#define MARK_STRING(S)         XMARK ((S)->size)
-#define UNMARK_STRING(S)       XUNMARK ((S)->size)
-#define STRING_MARKED_P(S)     XMARKBIT ((S)->size)
+#define MARK_STRING(S)         ((S)->size |= MARKBIT)
+#define UNMARK_STRING(S)       ((S)->size &= ~MARKBIT)
+#define STRING_MARKED_P(S)     ((S)->size & MARKBIT)
 
 /* 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
@@ -170,11 +170,6 @@ static char *spare_memory;
 
 static int malloc_hysteresis;
 
-/* Nonzero when malloc is called for allocating Lisp object space.
-   Currently set but not used.  */
-
-int allocating_for_lisp;
-
 /* Non-nil means defun should do purecopy on the function definition.  */
 
 Lisp_Object Vpurify_flag;
@@ -464,6 +459,19 @@ xfree (block)
 }
 
 
+/* Like strdup, but uses xmalloc.  */
+
+char *
+xstrdup (s)
+     char *s;
+{
+  int len = strlen (s) + 1;
+  char *p = (char *) xmalloc (len);
+  bcopy (s, p, len);
+  return p;
+}
+
+
 /* Like malloc but used for allocating Lisp data.  NBYTES is the
    number of bytes to allocate, TYPE describes the intended use of the
    allcated memory block (for strings, for conses, ...).  */
@@ -476,19 +484,16 @@ lisp_malloc (nbytes, type)
   register void *val;
 
   BLOCK_INPUT;
-  allocating_for_lisp++;
   val = (void *) malloc (nbytes);
-  allocating_for_lisp--;
-  UNBLOCK_INPUT;
 
-  if (!val && nbytes)
-    memory_full ();
-  
 #if GC_MARK_STACK
-  if (type != MEM_TYPE_NON_LISP)
+  if (val && type != MEM_TYPE_NON_LISP)
     mem_insert (val, (char *) val + nbytes, type);
 #endif
   
+  UNBLOCK_INPUT;
+  if (!val && nbytes)
+    memory_full ();
   return val;
 }
 
@@ -512,12 +517,10 @@ lisp_free (block)
      long *block;
 {
   BLOCK_INPUT;
-  allocating_for_lisp++;
   free (block);
 #if GC_MARK_STACK
   mem_delete (mem_find (block));
 #endif
-  allocating_for_lisp--;
   UNBLOCK_INPUT;
 }
 
@@ -766,7 +769,7 @@ mark_interval_tree (tree)
 
   /* XMARK expands to an assignment; the LHS of an assignment can't be
      a cast.  */
-  XMARK (* (Lisp_Object *) &tree->parent);
+  XMARK (tree->up.obj);
 
   traverse_intervals (tree, 1, 0, mark_interval, Qnil);
 }
@@ -777,7 +780,7 @@ mark_interval_tree (tree)
 #define MARK_INTERVAL_TREE(i)                          \
   do {                                                 \
     if (!NULL_INTERVAL_P (i)                           \
-       && ! XMARKBIT (*(Lisp_Object *) &i->parent))    \
+       && ! XMARKBIT (i->up.obj))                      \
       mark_interval_tree (i);                          \
   } while (0)
 
@@ -790,12 +793,25 @@ mark_interval_tree (tree)
   do {                                                 \
    if (! NULL_INTERVAL_P (i))                          \
      {                                                 \
-       XUNMARK (* (Lisp_Object *) (&(i)->parent));     \
+       XUNMARK ((i)->up.obj);                          \
        (i) = balance_intervals (i);                    \
      }                                                 \
   } while (0)
 
-
+\f
+/* Number support.  If NO_UNION_TYPE isn't in effect, we
+   can't create number objects in macros.  */
+#ifndef make_number
+Lisp_Object
+make_number (n)
+     int n;
+{
+  Lisp_Object obj;
+  obj.s.val = n;
+  obj.s.type = Lisp_Int;
+  return obj;
+}
+#endif
 \f
 /***********************************************************************
                          String Allocation
@@ -1374,10 +1390,14 @@ make_string (contents, nbytes)
      int nbytes;
 {
   register Lisp_Object val;
-  int nchars = chars_in_text (contents, nbytes);
+  int nchars, multibyte_nbytes;
+
+  parse_str_as_multibyte (contents, nbytes, &nchars, &multibyte_nbytes);
   val = make_uninit_multibyte_string (nchars, nbytes);
   bcopy (contents, XSTRING (val)->data, nbytes);
-  if (STRING_BYTES (XSTRING (val)) == XSTRING (val)->size)
+  if (nbytes == nchars || nbytes != multibyte_nbytes)
+    /* CONTENTS contains no multibyte sequences or contains an invalid
+       multibyte sequence.  We must make unibyte string.  */
     SET_STRING_BYTES (XSTRING (val), -1);
   return val;
 }
@@ -1937,6 +1957,15 @@ significance.")
     val = make_pure_vector ((EMACS_INT) nargs);
   else
     val = Fmake_vector (len, Qnil);
+
+  if (STRINGP (args[1]) && STRING_MULTIBYTE (args[1]))
+    /* BYTECODE-STRING must have been produced by Emacs 20.2 or the
+       earlier because they produced a raw 8-bit string for byte-code
+       and now such a byte-code string is loaded as multibyte while
+       raw 8-bit characters converted to multibyte form.  Thus, now we
+       must convert them back to the original unibyte form.  */
+    args[1] = Fstring_as_unibyte (args[1]);
+
   p = XVECTOR (val);
   for (index = 0; index < nargs; index++)
     {
@@ -4649,6 +4678,18 @@ Frames, windows, buffers, and subprocesses count as vectors\n\
 
   return Flist (8, consed);
 }
+
+int suppress_checking;
+void
+die (msg, file, line)
+     const char *msg;
+     const char *file;
+     int line;
+{
+  fprintf (stderr, "\r\nEmacs fatal error: %s:%d: %s\r\n",
+          file, line, msg);
+  abort ();
+}
 \f
 /* Initialization */