xemacs-beta: src/alloc.c comparison

comparison src/alloc.c @ 382:064ab7fed2e0 r21-2-6

Import from CVS: tag r21-2-6

author	cvs
date	Mon, 13 Aug 2007 11:07:39 +0200
parents	8626e4521993
children	4af0ddfb7c5b

comparison

equal deleted inserted replaced

-:908a86f940e6
+:064ab7fed2e0
 #include <malloc.h>
 #endif
 EXFUN (Fgarbage_collect, 0);
-/* #define GDB_SUCKS */
+/* Return the true size of a struct with a variable-length array field.  */
+#define STRETCHY_STRUCT_SIZEOF(stretchy_struct_type,		\
+			       stretchy_array_field,		\
+			       stretchy_array_length)		\
+(offsetof (stretchy_struct_type, stretchy_array_field) +	\
+(offsetof (stretchy_struct_type, stretchy_array_field[1]) -	\
+offsetof (stretchy_struct_type, stretchy_array_field[0])) *	\
+(stretchy_array_length))
 #if 0 /* this is _way_ too slow to be part of the standard debug options */
 #if defined(DEBUG_XEMACS) && defined(MULE)
 #define VERIFY_STRING_CHARS_INTEGRITY
 #endif
 }
 static size_t
 size_vector (CONST void *lheader)
 {
-return offsetof (Lisp_Vector, contents[((Lisp_Vector *) lheader)->size]);
+return STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents,
+				 ((Lisp_Vector *) lheader)->size);
 }
 static int
 vector_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 {
-int indice;
 int len = XVECTOR_LENGTH (obj1);
 if (len != XVECTOR_LENGTH (obj2))
 return 0;
-for (indice = 0; indice < len; indice++)
 {
-if (!internal_equal (XVECTOR_DATA (obj1) [indice],
+Lisp_Object *ptr1 = XVECTOR_DATA (obj1);
-			   XVECTOR_DATA (obj2) [indice],
+Lisp_Object *ptr2 = XVECTOR_DATA (obj2);
-			   depth + 1))
+while (len--)
+if (!internal_equal (*ptr1++, *ptr2++, depth + 1))
 	return 0;
 }
 return 1;
 }
 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION("vector", vector,
 				       mark_vector, print_vector, 0,
 /* #### should allocate `small' vectors from a frob-block */
 static Lisp_Vector *
 make_vector_internal (size_t sizei)
 {
 /* no vector_next */
-size_t sizem = offsetof (Lisp_Vector, contents[sizei]);
+size_t sizem = STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, sizei);
 Lisp_Vector *p = (Lisp_Vector *) alloc_lcrecord (sizem, lrecord_vector);
 p->size = sizei;
 return p;
 }
 /* #### should allocate `small' vectors from a frob-block */
 static Lisp_Vector *
 make_vector_internal (size_t sizei)
 {
 /* + 1 to account for vector_next */
-size_t sizem = offsetof (Lisp_Vector, contents[sizei+1]);
+size_t sizem = STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, sizei+1);
 Lisp_Vector *p = (Lisp_Vector *) allocate_lisp_storage (sizem);
 INCREMENT_CONS_COUNTER (sizem, "vector");
 p->size = sizei;
 }
 #endif /* ! LRECORD_VECTOR */
 Lisp_Object
-make_vector (EMACS_INT length, Lisp_Object init)
+make_vector (size_t length, Lisp_Object init)
 {
-int elt;
+Lisp_Vector *vecp = make_vector_internal (length);
-Lisp_Object vector;
+Lisp_Object *p = vector_data (vecp);
-Lisp_Vector *p;
+while (length--)
-if (length < 0)
+*p++ = init;
-length = XINT (wrong_type_argument (Qnatnump, make_int (length)));
-p = make_vector_internal (length);
-XSETVECTOR (vector, p);
-#if 0
-/* Initialize big arrays full of 0's quickly, for what that's worth */
 {
-char *travesty = (char *) &init;
+Lisp_Object vector;
-for (i = 1; i < sizeof (Lisp_Object); i++)
+XSETVECTOR (vector, vecp);
-{
-if (travesty[i] != travesty[0])
-goto fill;
-}
-memset (vector_data (p), travesty[0], length * sizeof (Lisp_Object));
 return vector;
 }
-fill:
-#endif
-for (elt = 0; elt < length; elt++)
-vector_data(p)[elt] = init;
-return vector;
 }
 DEFUN ("make-vector", Fmake_vector, 2, 2, 0, /*
 Return a new vector of length LENGTH, with each element being INIT.
 See also the function `vector'.
 */
 (length, init))
 {
-CHECK_NATNUM (length);
+CONCHECK_NATNUM (length);
 return make_vector (XINT (length), init);
 }
 DEFUN ("vector", Fvector, 0, MANY, 0, /*
 Return a newly created vector with specified arguments as elements.
 Any number of arguments, even zero arguments, are allowed.
 */
 (int nargs, Lisp_Object *args))
 {
-Lisp_Object vector;
+Lisp_Vector *vecp = make_vector_internal (nargs);
-int elt;
+Lisp_Object *p = vector_data (vecp);
-Lisp_Vector *p = make_vector_internal (nargs);
+while (nargs--)
-for (elt = 0; elt < nargs; elt++)
+*p++ = *args++;
-vector_data(p)[elt] = args[elt];
+{
-XSETVECTOR (vector, p);
+Lisp_Object vector;
-return vector;
+XSETVECTOR (vector, vecp);
+return vector;
+}
 }
 Lisp_Object
 vector1 (Lisp_Object obj0)
 {
 /* #### should allocate `small' bit vectors from a frob-block */
 static struct Lisp_Bit_Vector *
 make_bit_vector_internal (size_t sizei)
 {
-size_t sizem =
+size_t num_longs = BIT_VECTOR_LONG_STORAGE (sizei);
-offsetof (Lisp_Bit_Vector, bits[BIT_VECTOR_LONG_STORAGE (sizei)]);
+size_t sizem = STRETCHY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits, num_longs);
 Lisp_Bit_Vector *p = (Lisp_Bit_Vector *) allocate_lisp_storage (sizem);
 set_lheader_implementation (&(p->lheader), lrecord_bit_vector);
 INCREMENT_CONS_COUNTER (sizem, "bit-vector");
 bit_vector_length (p) = sizei;
 bit_vector_next   (p) = all_bit_vectors;
 /* make sure the extra bits in the last long are 0; the calling
 functions might not set them. */
-p->bits[BIT_VECTOR_LONG_STORAGE (sizei) - 1] = 0;
+p->bits[num_longs - 1] = 0;
 XSETBIT_VECTOR (all_bit_vectors, p);
 return p;
 }
 Lisp_Object
-make_bit_vector (EMACS_INT length, Lisp_Object init)
+make_bit_vector (size_t length, Lisp_Object init)
 {
-Lisp_Object bit_vector;
+struct Lisp_Bit_Vector *p = make_bit_vector_internal (length);
-struct Lisp_Bit_Vector *p;
+size_t num_longs = BIT_VECTOR_LONG_STORAGE (length);
-EMACS_INT num_longs;
 CHECK_BIT (init);
-num_longs = BIT_VECTOR_LONG_STORAGE (length);
-p = make_bit_vector_internal (length);
-XSETBIT_VECTOR (bit_vector, p);
 if (ZEROP (init))
 memset (p->bits, 0, num_longs * sizeof (long));
 else
 {
-EMACS_INT bits_in_last = length & (LONGBITS_POWER_OF_2 - 1);
+size_t bits_in_last = length & (LONGBITS_POWER_OF_2 - 1);
 memset (p->bits, ~0, num_longs * sizeof (long));
 /* But we have to make sure that the unused bits in the
-	 last integer are 0, so that equal/hash is easy. */
+	 last long are 0, so that equal/hash is easy. */
 if (bits_in_last)
 	p->bits[num_longs - 1] &= (1 << bits_in_last) - 1;
 }
-return bit_vector;
+{
+Lisp_Object bit_vector;
+XSETBIT_VECTOR (bit_vector, p);
+return bit_vector;
+}
 }
 Lisp_Object
-make_bit_vector_from_byte_vector (unsigned char *bytevec, EMACS_INT length)
+make_bit_vector_from_byte_vector (unsigned char *bytevec, size_t length)
 {
-Lisp_Object bit_vector;
-struct Lisp_Bit_Vector *p;
 int i;
+Lisp_Bit_Vector *p = make_bit_vector_internal (length);
-if (length < 0)
-length = XINT (wrong_type_argument (Qnatnump, make_int (length)));
-p = make_bit_vector_internal (length);
-XSETBIT_VECTOR (bit_vector, p);
 for (i = 0; i < length; i++)
 set_bit_vector_bit (p, i, bytevec[i]);
-return bit_vector;
+{
+Lisp_Object bit_vector;
+XSETBIT_VECTOR (bit_vector, p);
+return bit_vector;
+}
 }
 DEFUN ("make-bit-vector", Fmake_bit_vector, 2, 2, 0, /*
 Return a new bit vector of length LENGTH. with each bit being INIT.
 Each element is set to INIT.  See also the function `bit-vector'.
 Return a newly created bit vector with specified arguments as elements.
 Any number of arguments, even zero arguments, are allowed.
 */
 (int nargs, Lisp_Object *args))
 {
-Lisp_Object bit_vector;
+int i;
-int elt;
+Lisp_Bit_Vector *p = make_bit_vector_internal (nargs);
-struct Lisp_Bit_Vector *p;
+for (i = 0; i < nargs; i++)
-for (elt = 0; elt < nargs; elt++)
+{
-CHECK_BIT (args[elt]);
+CHECK_BIT (args[i]);
+set_bit_vector_bit (p, i, !ZEROP (args[i]));
-p = make_bit_vector_internal (nargs);
+}
-for (elt = 0; elt < nargs; elt++)
+{
-set_bit_vector_bit (p, elt, !ZEROP (args[elt]));
+Lisp_Object bit_vector;
+XSETBIT_VECTOR (bit_vector, p);
-XSETBIT_VECTOR (bit_vector, p);
+return bit_vector;
-return bit_vector;
+}
 }
 /************************************************************************/
 /*		     Compiled-function allocation			*/
 current_string_chars_block->pos += fullsize;
 }
 else
 {
 /* Make a new current string chars block */
-struct string_chars_block *new = xnew (struct string_chars_block);
+struct string_chars_block *new_scb = xnew (struct string_chars_block);
-current_string_chars_block->next = new;
+current_string_chars_block->next = new_scb;
-new->prev = current_string_chars_block;
+new_scb->prev = current_string_chars_block;
-new->next = 0;
+new_scb->next = 0;
-current_string_chars_block = new;
+current_string_chars_block = new_scb;
-new->pos = fullsize;
+new_scb->pos = fullsize;
 s_chars = (struct string_chars *)
 	current_string_chars_block->string_chars;
 }
 s_chars->string = string_it_goes_with;
 #ifdef MULE
 void
 set_string_char (struct Lisp_String *s, Charcount i, Emchar c)
 {
-Bytecount oldlen, newlen;
 Bufbyte newstr[MAX_EMCHAR_LEN];
 Bytecount bytoff = charcount_to_bytecount (string_data (s), i);
+Bytecount oldlen = charcount_to_bytecount (string_data (s) + bytoff, 1);
-oldlen = charcount_to_bytecount (string_data (s) + bytoff, 1);
+Bytecount newlen = set_charptr_emchar (newstr, c);
-newlen = set_charptr_emchar (newstr, c);
 if (oldlen != newlen)
 resize_string (s, bytoff, newlen - oldlen);
 /* Remember, string_data (s) might have changed so we can't cache it. */
 memcpy (string_data (s) + bytoff, newstr, newlen);
 Lisp_Object
 make_pure_string (CONST Bufbyte *data, Bytecount length,
 		  Lisp_Object plist, int no_need_to_copy_data)
 {
-Lisp_Object new;
+Lisp_String *s;
-struct Lisp_String *s;
+size_t size = sizeof (Lisp_String) +
-size_t size = sizeof (struct Lisp_String) +
 (no_need_to_copy_data ? 0 : (length + 1)); /* + 1 for terminating 0 */
 size = ALIGN_SIZE (size, ALIGNOF (Lisp_Object));
 if (symbols_initialized && !pure_lossage)
 {
 Lisp_Object tem = oblookup (Vobarray, data, length);
 if (SYMBOLP (tem))
 	{
 	  s = XSYMBOL (tem)->name;
 	  if (!PURIFIED (s)) abort ();
-	  XSETSTRING (new, s);
-	  return new;
+	  {
+	    Lisp_Object string;
+	    XSETSTRING (string, s);
+	    return string;
+	  }
 	}
 }
 if (!check_purespace (size))
 return make_string (data, length);
-s = (struct Lisp_String *) (PUREBEG + pure_bytes_used);
+s = (Lisp_String *) (PUREBEG + pure_bytes_used);
 #ifdef LRECORD_STRING
 set_lheader_implementation (&(s->lheader), lrecord_string);
 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
 s->lheader.pure = 1;
 #endif
 {
 set_string_data (s, (Bufbyte *) data);
 }
 else
 {
-set_string_data (s, (Bufbyte *) s + sizeof (struct Lisp_String));
+set_string_data (s, (Bufbyte *) s + sizeof (Lisp_String));
 memcpy (string_data (s), data, length);
 set_string_byte (s, length, 0);
 }
 s->plist = Qnil;
 pure_bytes_used += size;
 #endif /* PURESTAT */
 /* Do this after the official "completion" of the purecopying. */
 s->plist = Fpurecopy (plist);
-XSETSTRING (new, s);
+{
-return new;
+Lisp_Object string;
+XSETSTRING (string, s);
+return string;
+}
 }
 Lisp_Object
 make_pure_pname (CONST Bufbyte *data, Bytecount length,
 Lisp_Object
 pure_cons (Lisp_Object car, Lisp_Object cdr)
 {
-Lisp_Object new;
+Lisp_Cons *c;
-struct Lisp_Cons *c;
+if (!check_purespace (sizeof (Lisp_Cons)))
-if (!check_purespace (sizeof (struct Lisp_Cons)))
 return Fcons (Fpurecopy (car), Fpurecopy (cdr));
-c = (struct Lisp_Cons *) (PUREBEG + pure_bytes_used);
+c = (Lisp_Cons *) (PUREBEG + pure_bytes_used);
 #ifdef LRECORD_CONS
 set_lheader_implementation (&(c->lheader), lrecord_cons);
 #ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
 c->lheader.pure = 1;
 #endif
 #endif
-pure_bytes_used += sizeof (struct Lisp_Cons);
+pure_bytes_used += sizeof (Lisp_Cons);
-bump_purestat (&purestat_cons, sizeof (struct Lisp_Cons));
+bump_purestat (&purestat_cons, sizeof (Lisp_Cons));
 c->car = Fpurecopy (car);
 c->cdr = Fpurecopy (cdr);
-XSETCONS (new, c);
-return new;
+{
+Lisp_Object cons;
+XSETCONS (cons, c);
+return cons;
+}
 }
 Lisp_Object
 pure_list (int nargs, Lisp_Object *args)
 {
 #endif /* LISP_FLOAT_TYPE */
 Lisp_Object
 make_pure_vector (size_t len, Lisp_Object init)
 {
-Lisp_Object new;
 Lisp_Vector *v;
-size_t size = offsetof (Lisp_Vector, contents[len]);
+size_t size = STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, len);
 init = Fpurecopy (init);
 if (!check_purespace (size))
 return make_vector (len, init);
 v->size = len;
 for (size = 0; size < len; size++)
 v->contents[size] = init;
-XSETVECTOR (new, v);
+{
-return new;
+Lisp_Object vector;
+XSETVECTOR (vector, v);
+return vector;
+}
 }
 #if 0
 /* Presently unused */
 void *
 	  ? implementation->size_in_bytes_method (lheader)
 	  : implementation->static_size;
 }
 #ifndef LRECORD_VECTOR
 else if (VECTORP (obj))
-return offsetof (Lisp_Vector, contents[XVECTOR_LENGTH (obj)]);
+return STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, XVECTOR_LENGTH (obj));
 #endif /* !LRECORD_VECTOR */
 #ifndef LRECORD_CONS
 else if (CONSP (obj))
 return sizeof (struct Lisp_Cons);
 	{
 len = - (len + 1);
 	  v->size = len;
 	  total_size += len;
 total_storage +=
-	    MALLOC_OVERHEAD + offsetof (Lisp_Vector, contents[len + 1]);
+	    MALLOC_OVERHEAD +
+	    STRETCHY_STRUCT_SIZEOF (Lisp_Vector, contents, len + 1);
 	  num_used++;
 	  prev = &(vector_next (v));
 	  vector = *prev;
 	}
 else
 if (MARKED_RECORD_P (bit_vector))
 	{
 	  UNMARK_RECORD_HEADER (&(v->lheader));
 	  total_size += len;
 total_storage +=
-	    MALLOC_OVERHEAD
+	    MALLOC_OVERHEAD +
-	    + offsetof (Lisp_Bit_Vector, bits[BIT_VECTOR_LONG_STORAGE (len)]);
+	    STRETCHY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits,
+				    BIT_VECTOR_LONG_STORAGE (len));
 	  num_used++;
 	  prev = &(bit_vector_next (v));
 	  bit_vector = *prev;
 	}
 else

Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 382:064ab7fed2e0 r21-2-6