xemacs-beta: src/alloc.c comparison

comparison src/alloc.c @ 185:3d6bfa290dbd r20-3b19

Import from CVS: tag r20-3b19

author	cvs
date	Mon, 13 Aug 2007 09:55:28 +0200
parents	e121b013d1f0
children	a2f645c6b9f8

comparison

equal deleted inserted replaced

-:bcd2674570bf
+:3d6bfa290dbd
 #ifdef xmalloc
 #undef xmalloc
 #endif
 void *
-xmalloc (int size)
+xmalloc (size_t size)
 {
-void *val;
+void *val = (void *) malloc (size);
-val = (void *) malloc (size);
 if (!val && (size != 0)) memory_full ();
 return val;
 }
 void *
-xmalloc_and_zero (int size)
+xmalloc_and_zero (size_t size)
 {
 void *val = xmalloc (size);
 memset (val, 0, size);
 return val;
 }
 #ifdef xrealloc
 #undef xrealloc
 #endif
 void *
-xrealloc (void *block, int size)
+xrealloc (void *block, size_t size)
 {
-void *val;
 /* We must call malloc explicitly when BLOCK is 0, since some
 reallocs don't do this.  */
-if (! block)
+void *val = (void *) (block ? realloc (block, size) : malloc (size));
-val = (void *) malloc (size);
-else
-val = (void *) realloc (block, size);
 if (!val && (size != 0)) memory_full ();
 return val;
 }
 #endif
 char *
 xstrdup (CONST char *str)
 {
-char *val;
 int len = strlen (str) + 1;   /* for stupid terminating 0 */
-val = xmalloc (len);
+void *val = xmalloc (len);
 if (val == 0) return 0;
 memcpy (val, str, len);
-return val;
+return (char *) val;
 }
 #ifdef NEED_STRDUP
 char *
 strdup (CONST char *s)
 	abort ();
 }
 else if (implementation->static_size != size)
 abort ();
-lcheader = allocate_lisp_storage (size);
+lcheader = (struct lcrecord_header *) allocate_lisp_storage (size);
 lcheader->lheader.implementation = implementation;
 lcheader->next = all_lcrecords;
 #if 1                           /* mly prefers to see small ID numbers */
 lcheader->uid = lrecord_uid_counter++;
 #else				/* jwz prefers to see real addrs */
 /* XGCTYPE for records */
 int
 gc_record_type_p (Lisp_Object frob, CONST struct lrecord_implementation *type)
 {
-return (XGCTYPE (frob) == Lisp_Record
+return (XGCTYPE (frob) == Lisp_Type_Record
-&& (XRECORD_LHEADER (frob)->implementation == type
+&& (XRECORD_LHEADER (frob)->implementation == type ||
-|| XRECORD_LHEADER (frob)->implementation == type + 1));
+XRECORD_LHEADER (frob)->implementation == type + 1));
 }
 /**********************************************************************/
 /*                        Fixed-size type macros                      */
 #define ALLOCATE_FIXED_TYPE_FROM_BLOCK(type, result)			\
 do {									\
 if (current_##type##_block_index					\
 	== countof (current_##type##_block->block))			\
 {									\
-struct type##_block *__new__					\
+struct type##_block *__new__ = (struct type##_block *)		\
-= allocate_lisp_storage (sizeof (struct type##_block));	\
+allocate_lisp_storage (sizeof (struct type##_block));		\
 __new__->prev = current_##type##_block;				\
 current_##type##_block = __new__;					\
 current_##type##_block_index = 0;					\
 }									\
 (result) =								\
 EMACS_INT sizem = (sizeof (struct Lisp_Vector)
 /* -1 because struct Lisp_Vector includes 1 slot,
 * +1 to account for vector_next */
 + (sizei - 1 + 1) * sizeof (Lisp_Object)
 );
-struct Lisp_Vector *p = allocate_lisp_storage (sizem);
+struct Lisp_Vector *p = (struct Lisp_Vector *) allocate_lisp_storage (sizem);
 #ifdef LRECORD_VECTOR
 set_lheader_implementation (&(p->lheader), lrecord_vector);
 #endif
 INCREMENT_CONS_COUNTER (sizem, "vector");
 make_bit_vector_internal (EMACS_INT sizei)
 {
 EMACS_INT sizem = (sizeof (struct Lisp_Bit_Vector) +
 /* -1 because struct Lisp_Bit_Vector includes 1 slot */
 	       sizeof (long) * (BIT_VECTOR_LONG_STORAGE (sizei) - 1));
-struct Lisp_Bit_Vector *p = allocate_lisp_storage (sizem);
+struct Lisp_Bit_Vector *p =
+(struct 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;
 };
 static void
 init_string_chars_alloc (void)
 {
-first_string_chars_block =
+first_string_chars_block = xnew (struct string_chars_block);
-(struct string_chars_block *) xmalloc (sizeof (struct string_chars_block));
 first_string_chars_block->prev = 0;
 first_string_chars_block->next = 0;
 first_string_chars_block->pos = 0;
 current_string_chars_block = first_string_chars_block;
 }
 current_string_chars_block->pos += fullsize;
 }
 else
 {
 /* Make a new current string chars block */
-struct string_chars_block *new
+struct string_chars_block *new = xnew (struct string_chars_block);
-	= (struct string_chars_block *)
-	  xmalloc (sizeof (struct string_chars_block));
 current_string_chars_block->next = new;
 new->prev = current_string_chars_block;
 new->next = 0;
 current_string_chars_block = new;
 oldlen = charcount_to_bytecount (string_data (s) + bytoff, 1);
 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
+/* Remember, string_data (s) might have changed so we can't cache it. */
-cache it. */
 memcpy (string_data (s) + bytoff, newstr, newlen);
 }
 #endif /* MULE */
 }
 Lisp_Object
 build_string (CONST char *str)
 {
-Bytecount length;
+/* Some strlen's crash and burn if passed null. */
+return make_string ((CONST Bufbyte *) str, (str ? strlen(str) : 0));
-/* Some strlen crash and burn if passed null. */
-if (!str)
-length = 0;
-else
-length = strlen (str);
-return make_string ((CONST Bufbyte *) str, length);
 }
 Lisp_Object
 build_ext_string (CONST char *str, enum external_data_format fmt)
 {
-Bytecount length;
+/* Some strlen's crash and burn if passed null. */
+return make_ext_string ((Extbyte *) str, (str ? strlen(str) : 0), fmt);
-/* Some strlen crash and burn if passed null. */
-if (!str)
-length = 0;
-else
-length = strlen (str);
-return make_ext_string ((Extbyte *) str, length, fmt);
 }
 Lisp_Object
 build_translated_string (CONST char *str)
 {
 Lisp_Object
 make_lcrecord_list (int size,
 		    CONST struct lrecord_implementation *implementation)
 {
-struct lcrecord_list *p = alloc_lcrecord (sizeof (*p),
+struct lcrecord_list *p = alloc_lcrecord_type (struct lcrecord_list,
-					    lrecord_lcrecord_list);
+						 lrecord_lcrecord_list);
 Lisp_Object val = Qnil;
 p->implementation = implementation;
 p->size = size;
 p->free = Qnil;
 free_header->lcheader.free = 0;
 return val;
 }
 else
 {
-Lisp_Object foo = Qnil;
+Lisp_Object val = Qnil;
-XSETOBJ (foo, Lisp_Record,
+XSETOBJ (val, Lisp_Type_Record,
 	       alloc_lcrecord (list->size, list->implementation));
-return foo;
+return val;
 }
 }
 void
 free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord)
 || PURIFIED (XPNTR (obj)))
 return obj;
 switch (XTYPE (obj))
 {
-case Lisp_Cons:
+case Lisp_Type_Cons:
 return pure_cons (XCAR (obj), XCDR (obj));
-case Lisp_String:
+case Lisp_Type_String:
 return make_pure_string (XSTRING_DATA (obj),
 			       XSTRING_LENGTH (obj),
 			       XSTRING (obj)->plist,
 0);
-case Lisp_Vector:
+#ifndef LRECORD_VECTOR
+case Lisp_Type_Vector:
 {
 struct Lisp_Vector *o = XVECTOR (obj);
 Lisp_Object new = make_pure_vector (vector_length (o), Qnil);
 for (i = 0; i < vector_length (o); i++)
 	  XVECTOR_DATA (new)[i] = Fpurecopy (o->contents[i]);
 return new;
 }
+#endif /* !LRECORD_VECTOR */
 default:
 {
 if (COMPILED_FUNCTIONP (obj))
 {
 return;
 if (PURIFIED (XPNTR (obj)))
 return;
 switch (XGCTYPE (obj))
 {
-case Lisp_Cons:
+case Lisp_Type_Cons:
 {
 	struct Lisp_Cons *ptr = XCONS (obj);
 	if (CONS_MARKED_P (ptr))
 	  break;
 	MARK_CONS (ptr);
 	    obj = ptr->cdr;
 	  }
 	goto tail_recurse;
 }
-case Lisp_Record:
+case Lisp_Type_Record:
 /* case Lisp_Symbol_Value_Magic: */
 {
 	struct lrecord_header *lheader = XRECORD_LHEADER (obj);
 	CONST struct lrecord_implementation *implementation
 	  = lheader->implementation;
 	      }
 	  }
 }
 break;
-case Lisp_String:
+case Lisp_Type_String:
 {
 	struct Lisp_String *ptr = XSTRING (obj);
 	if (!XMARKBIT (ptr->plist))
 	  {
 	    goto tail_recurse;
 	  }
 }
 break;
-case Lisp_Vector:
+#ifndef LRECORD_VECTOR
+case Lisp_Type_Vector:
 {
 	struct Lisp_Vector *ptr = XVECTOR (obj);
 	int len = vector_length (ptr);
 	int i;
 obj = ptr->contents[len - 1];
 goto tail_recurse;
 }
 }
 break;
+#endif /* !LRECORD_VECTOR */
 #ifndef LRECORD_SYMBOL
-case Lisp_Symbol:
+case Lisp_Type_Symbol:
 {
 	struct Lisp_Symbol *sym = XSYMBOL (obj);
 	while (!XMARKBIT (sym->plist))
 	  {
 if (SYMBOLP (obj))
 return total;
 switch (XTYPE (obj))
 {
-case Lisp_String:
+case Lisp_Type_String:
 {
 	struct Lisp_String *ptr = XSTRING (obj);
 int size = string_length (ptr);
 if (string_data (ptr) !=
 	  }
 total += size;
 }
 break;
-case Lisp_Vector:
+#ifndef LRECORD_VECTOR
+case Lisp_Type_Vector:
 {
 struct Lisp_Vector *ptr = XVECTOR (obj);
 int len = vector_length (ptr);
 total += (sizeof (struct Lisp_Vector)
 	    goto tail_recurse;
 	  }
 #endif /* unused */
 }
 break;
+#endif /* !LRECORD_SYMBOL */
-case Lisp_Record:
+case Lisp_Type_Record:
 {
 	struct lrecord_header *lheader = XRECORD_LHEADER (obj);
 	CONST struct lrecord_implementation *implementation
 	  = lheader->implementation;
 	  }
 #endif /* unused */
 }
 break;
-case Lisp_Cons:
+case Lisp_Type_Cons:
 {
 struct Lisp_Cons *ptr = XCONS (obj);
 total += sizeof (*ptr);
 #if 0 /* unused */
 if (!recurse)
 {
 if (!POINTER_TYPE_P (XGCTYPE (obj))) return 1;
 if (PURIFIED (XPNTR (obj))) return 1;
 switch (XGCTYPE (obj))
 {
-case Lisp_Cons:
+case Lisp_Type_Cons:
 return XMARKBIT (XCAR (obj));
-case Lisp_Record:
+case Lisp_Type_Record:
 return MARKED_RECORD_HEADER_P (XRECORD_LHEADER (obj));
-case Lisp_String:
+case Lisp_Type_String:
 return XMARKBIT (XSTRING (obj)->plist);
-case Lisp_Vector:
+#ifndef LRECORD_VECTOR
+case Lisp_Type_Vector:
 return XVECTOR_LENGTH (obj) < 0;
+#endif /* !LRECORD_VECTOR */
 #ifndef LRECORD_SYMBOL
-case Lisp_Symbol:
+case Lisp_Type_Symbol:
 return XMARKBIT (XSYMBOL (obj)->plist);
 #endif
 default:
 abort ();
 }

Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 185:3d6bfa290dbd r20-3b19