emacs: src/alloc.c comparison

comparison src/alloc.c @ 90573:858cb33ae39d

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 357-381) - Merge from gnus--rel--5.10 - Update from CVS - Merge from erc--emacs--21 * gnus--rel--5.10 (patch 116-122) - Update from CVS - Merge from emacs--devo--0 Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-98

author	Miles Bader <miles@gnu.org>
date	Thu, 03 Aug 2006 11:45:23 +0000
parents	8a8e69664178 4eba80d54b43
children	cf4b4d3f2600

comparison

equal deleted inserted replaced

-:ab9b8d043c39
+:858cb33ae39d
 #define INCLUDED_FCNTL
 #include <fcntl.h>
 #endif
 #ifndef O_WRONLY
 #define O_WRONLY 1
+#endif
+#ifdef WINDOWSNT
+#include <fcntl.h>
 #endif
 #ifdef DOUG_LEA_MALLOC
 #include <malloc.h>
 (((PNTR_COMPARISON_TYPE) (P)				\
 < (PNTR_COMPARISON_TYPE) ((char *) purebeg + pure_size))	\
 && ((PNTR_COMPARISON_TYPE) (P)				\
 	  >= (PNTR_COMPARISON_TYPE) purebeg))
-/* Index in pure at which next pure object will be allocated.. */
+/* Total number of bytes allocated in pure storage. */
 EMACS_INT pure_bytes_used;
+/* Index in pure at which next pure Lisp object will be allocated.. */
+static EMACS_INT pure_bytes_used_lisp;
+/* Number of bytes allocated for non-Lisp objects in pure storage.  */
+static EMACS_INT pure_bytes_used_non_lisp;
 /* If nonzero, this is a warning delivered by malloc and not yet
 displayed.  */
 char *pending_malloc_warning;
 }
 #endif /* GC_MARK_STACK != 0 */
+/* Determine whether it is safe to access memory at address P.  */
+int
+valid_pointer_p (p)
+void *p;
+{
+int fd;
+/* Obviously, we cannot just access it (we would SEGV trying), so we
+trick the o/s to tell us whether p is a valid pointer.
+Unfortunately, we cannot use NULL_DEVICE here, as emacs_write may
+not validate p in that case.  */
+if ((fd = emacs_open ("__Valid__Lisp__Object__", O_CREAT | O_WRONLY | O_TRUNC, 0666)) >= 0)
+{
+int valid = (emacs_write (fd, (char *)p, 16) == 16);
+emacs_close (fd);
+unlink ("__Valid__Lisp__Object__");
+return valid;
+}
+return -1;
+}
 /* Return 1 if OBJ is a valid lisp object.
 Return 0 if OBJ is NOT a valid lisp object.
 Return -1 if we cannot validate OBJ.
 This function can be quite slow,
 int
 valid_lisp_object_p (obj)
 Lisp_Object obj;
 {
 void *p;
-#if !GC_MARK_STACK
+#if GC_MARK_STACK
-int fd;
-#else
 struct mem_node *m;
 #endif
 if (INTEGERP (obj))
 return 1;
 p = (void *) XPNTR (obj);
 if (PURE_POINTER_P (p))
 return 1;
 #if !GC_MARK_STACK
-/* We need to determine whether it is safe to access memory at
+return valid_pointer_p (p);
-address P.  Obviously, we cannot just access it (we would SEGV
-trying), so we trick the o/s to tell us whether p is a valid
-pointer.  Unfortunately, we cannot use NULL_DEVICE here, as
-emacs_write may not validate p in that case.  */
-if ((fd = emacs_open ("__Valid__Lisp__Object__", O_CREAT | O_WRONLY | O_TRUNC, 0666)) >= 0)
-{
-int valid = (emacs_write (fd, (char *)p, 16) == 16);
-emacs_close (fd);
-unlink ("__Valid__Lisp__Object__");
-return valid;
-}
-return -1;
 #else
 m = mem_find (p);
 if (m == MEM_NIL)
-return 0;
+{
+int valid = valid_pointer_p (p);
+if (valid <= 0)
+	return valid;
+if (SUBRP (obj))
+	return 1;
+return 0;
+}
 switch (m->type)
 {
 case MEM_TYPE_NON_LISP:
 return 0;
 		       Pure Storage Management
 ***********************************************************************/
 /* Allocate room for SIZE bytes from pure Lisp storage and return a
 pointer to it.  TYPE is the Lisp type for which the memory is
-allocated.  TYPE < 0 means it's not used for a Lisp object.
+allocated.  TYPE < 0 means it's not used for a Lisp object.  */
-If store_pure_type_info is set and TYPE is >= 0, the type of
-the allocated object is recorded in pure_types.  */
 static POINTER_TYPE *
 pure_alloc (size, type)
 size_t size;
 int type;
 #endif
 }
 #endif
 again:
-result = ALIGN (purebeg + pure_bytes_used, alignment);
+if (type >= 0)
-pure_bytes_used = ((char *)result - (char *)purebeg) + size;
+{
+/* Allocate space for a Lisp object from the beginning of the free
+	 space with taking account of alignment.  */
+result = ALIGN (purebeg + pure_bytes_used_lisp, alignment);
+pure_bytes_used_lisp = ((char *)result - (char *)purebeg) + size;
+}
+else
+{
+/* Allocate space for a non-Lisp object from the end of the free
+	 space.  */
+pure_bytes_used_non_lisp += size;
+result = purebeg + pure_size - pure_bytes_used_non_lisp;
+}
+pure_bytes_used = pure_bytes_used_lisp + pure_bytes_used_non_lisp;
 if (pure_bytes_used <= pure_size)
 return result;
 /* Don't allocate a large amount here,
 might not be usable.  */
 purebeg = (char *) xmalloc (10000);
 pure_size = 10000;
 pure_bytes_used_before_overflow += pure_bytes_used - size;
 pure_bytes_used = 0;
+pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0;
 goto again;
 }
 /* Print a warning if PURESIZE is too small.  */
 check_pure_size ()
 {
 if (pure_bytes_used_before_overflow)
 message ("emacs:0:Pure Lisp storage overflow (approx. %d bytes needed)",
 	     (int) (pure_bytes_used + pure_bytes_used_before_overflow));
+}
+/* Find the byte sequence {DATA[0], ..., DATA[NBYTES-1], '\0'} from
+the non-Lisp data pool of the pure storage, and return its start
+address.  Return NULL if not found.  */
+static char *
+find_string_data_in_pure (data, nbytes)
+char *data;
+int nbytes;
+{
+int i, skip, bm_skip[256], last_char_skip, infinity, start, start_max;
+unsigned char *p;
+char *non_lisp_beg;
+if (pure_bytes_used_non_lisp < nbytes + 1)
+return NULL;
+/* Set up the Boyer-Moore table.  */
+skip = nbytes + 1;
+for (i = 0; i < 256; i++)
+bm_skip[i] = skip;
+p = (unsigned char *) data;
+while (--skip > 0)
+bm_skip[*p++] = skip;
+last_char_skip = bm_skip['\0'];
+non_lisp_beg = purebeg + pure_size - pure_bytes_used_non_lisp;
+start_max = pure_bytes_used_non_lisp - (nbytes + 1);
+/* See the comments in the function `boyer_moore' (search.c) for the
+use of `infinity'.  */
+infinity = pure_bytes_used_non_lisp + 1;
+bm_skip['\0'] = infinity;
+p = (unsigned char *) non_lisp_beg + nbytes;
+start = 0;
+do
+{
+/* Check the last character (== '\0').  */
+do
+	{
+	  start += bm_skip[*(p + start)];
+	}
+while (start <= start_max);
+if (start < infinity)
+	/* Couldn't find the last character.  */
+	return NULL;
+/* No less than `infinity' means we could find the last
+	 character at `p[start - infinity]'.  */
+start -= infinity;
+/* Check the remaining characters.  */
+if (memcmp (data, non_lisp_beg + start, nbytes) == 0)
+	/* Found.  */
+	return non_lisp_beg + start;
+start += last_char_skip;
+}
+while (start <= start_max);
+return NULL;
 }
 /* Return a string allocated in pure space.  DATA is a buffer holding
 NCHARS characters, and NBYTES bytes of string data.  MULTIBYTE
 {
 Lisp_Object string;
 struct Lisp_String *s;
 s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
-s->data = (unsigned char *) pure_alloc (nbytes + 1, -1);
+s->data = find_string_data_in_pure (data, nbytes);
+if (s->data == NULL)
+{
+s->data = (unsigned char *) pure_alloc (nbytes + 1, -1);
+bcopy (data, s->data, nbytes);
+s->data[nbytes] = '\0';
+}
 s->size = nchars;
 s->size_byte = multibyte ? nbytes : -1;
-bcopy (data, s->data, nbytes);
-s->data[nbytes] = '\0';
 s->intervals = NULL_INTERVAL;
 XSETSTRING (string, s);
 return string;
 }
 {
 /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet!  */
 purebeg = PUREBEG;
 pure_size = PURESIZE;
 pure_bytes_used = 0;
+pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0;
 pure_bytes_used_before_overflow = 0;
 /* Initialize the list of free aligned blocks.  */
 free_ablock = NULL;

Mercurial > emacs

comparison src/alloc.c @ 90573:858cb33ae39d