xemacs-beta: src/alloc.c comparison

comparison src/alloc.c @ 5117:3742ea8250b5 ben-lisp-object ben-lisp-object-final-ws-year-2005

Checking in final CVS version of workspace 'ben-lisp-object'

author	Ben Wing <ben@xemacs.org>
date	Sat, 26 Dec 2009 00:20:27 -0600
parents	d30cd499e445
children	e0db3c197671

comparison

equal deleted inserted replaced

-:e56f73345619
+:3742ea8250b5
 DECREMENT_CONS_COUNTER (size);
 }
 #endif /* not (MC_ALLOC && ALLOC_TYPE_STATS) */
+#define assert_proper_sizing(size)			\
+type_checking_assert					\
+(implementation->static_size == 0 ?			\
+implementation->size_in_bytes_method != NULL :	\
+implementation->size_in_bytes_method == NULL &&	\
+implementation->static_size == size)
 #ifndef MC_ALLOC
 /* lcrecords are chained together through their "next" field.
 After doing the mark phase, GC will walk this linked list
 and free any lcrecord which hasn't been marked. */
 static struct old_lcrecord_header *all_lcrecords;
 #endif /* not MC_ALLOC */
 #ifdef MC_ALLOC
 /* The basic lrecord allocation functions. See lrecord.h for details. */
-void *
+static Lisp_Object
-alloc_lrecord (Bytecount size,
+alloc_sized_lrecord_1 (Bytecount size,
-	       const struct lrecord_implementation *implementation)
+		       const struct lrecord_implementation *implementation,
+		       int noseeum)
 {
 struct lrecord_header *lheader;
-type_checking_assert
+assert_proper_sizing (size);
-((implementation->static_size == 0 ?
-implementation->size_in_bytes_method != NULL :
-implementation->static_size == size));
 lheader = (struct lrecord_header *) mc_alloc (size);
 gc_checking_assert (LRECORD_FREE_P (lheader));
 set_lheader_implementation (lheader, implementation);
 #ifdef ALLOC_TYPE_STATS
 inc_lrecord_stats (size, lheader);
 #endif /* ALLOC_TYPE_STATS */
-INCREMENT_CONS_COUNTER (size, implementation->name);
+if (noseeum)
-return lheader;
+NOSEEUM_INCREMENT_CONS_COUNTER (size, implementation->name);
-}
+else
+INCREMENT_CONS_COUNTER (size, implementation->name);
-void *
+return wrap_pointer_1 (lheader);
-noseeum_alloc_lrecord (Bytecount size,
+}
-		       const struct lrecord_implementation *implementation)
-{
+Lisp_Object
-struct lrecord_header *lheader;
+alloc_sized_lrecord (Bytecount size,
+		     const struct lrecord_implementation *implementation)
-type_checking_assert
+{
-((implementation->static_size == 0 ?
+return alloc_sized_lrecord_1 (size, implementation, 0);
-implementation->size_in_bytes_method != NULL :
+}
-implementation->static_size == size));
+Lisp_Object
-lheader = (struct lrecord_header *) mc_alloc (size);
+noseeum_alloc_sized_lrecord (Bytecount size,
-gc_checking_assert (LRECORD_FREE_P (lheader));
+			     const struct lrecord_implementation *
-set_lheader_implementation (lheader, implementation);
+			     implementation)
-#ifdef ALLOC_TYPE_STATS
+{
-inc_lrecord_stats (size, lheader);
+return alloc_sized_lrecord_1 (size, implementation, 1);
-#endif /* ALLOC_TYPE_STATS */
+}
-NOSEEUM_INCREMENT_CONS_COUNTER (size, implementation->name);
-return lheader;
+Lisp_Object
+alloc_lrecord (const struct lrecord_implementation *implementation)
+{
+type_checking_assert (implementation->static_size > 0);
+return alloc_sized_lrecord (implementation->static_size, implementation);
 }
 void
 free_lrecord (Lisp_Object lrecord)
 {
 /* The most basic of the lcrecord allocation functions.  Not usually called
 directly.  Allocates an lrecord not managed by any lcrecord-list, of a
 specified size.  See lrecord.h. */
-void *
+Lisp_Object
-old_basic_alloc_lcrecord (Bytecount size,
+old_alloc_sized_lcrecord (Bytecount size,
 			  const struct lrecord_implementation *implementation)
 {
 struct old_lcrecord_header *lcheader;
+assert_proper_sizing (size);
 type_checking_assert
-((implementation->static_size == 0 ?
+(!implementation->basic_p
-implementation->size_in_bytes_method != NULL :
-implementation->static_size == size)
 &&
-(! implementation->basic_p)
+!(implementation->hash == NULL && implementation->equal != NULL));
-&&
-(! (implementation->hash == NULL && implementation->equal != NULL)));
 lcheader = (struct old_lcrecord_header *) allocate_lisp_storage (size);
 set_lheader_implementation (&lcheader->lheader, implementation);
 lcheader->next = all_lcrecords;
 #if 1                           /* mly prefers to see small ID numbers */
 lcheader->uid = (int) &lcheader;
 #endif
 lcheader->free = 0;
 all_lcrecords = lcheader;
 INCREMENT_CONS_COUNTER (size, implementation->name);
-return lcheader;
+return wrap_pointer_1 (lcheader);
+}
+Lisp_Object
+old_alloc_lcrecord (const struct lrecord_implementation *implementation)
+{
+type_checking_assert (implementation->static_size > 0);
+return old_alloc_sized_lcrecord (implementation->static_size,
+				   implementation);
 }
 #if 0 /* Presently unused */
 /* Very, very poor man's EGC?
 * This may be slow and thrash pages all over the place.
 { XD_LISP_OBJECT, offsetof (Lisp_Cons, car_) },
 { XD_LISP_OBJECT, offsetof (Lisp_Cons, cdr_) },
 { XD_END }
 };
-DEFINE_BASIC_LRECORD_IMPLEMENTATION ("cons", cons,
+DEFINE_FROB_BLOCK_LISP_OBJECT ("cons", cons, Lisp_Cons, cons_description,
-				     1, /*dumpable-flag*/
+			       1, /*dumpable-flag*/
-				     mark_cons, print_cons, 0,
+			       mark_cons, print_cons, cons_equal,
-				     cons_equal,
+			       /*
-				     /*
+				* No `hash' method needed.
-				      * No `hash' method needed.
+				* internal_hash knows how to
-				      * internal_hash knows how to
+				* handle conses.
-				      * handle conses.
+				*/
-				      */
+			       0, 0);
-				     0,
-				     cons_description,
-				     Lisp_Cons);
 DEFUN ("cons", Fcons, 2, 2, 0, /*
 Create a new cons, give it CAR and CDR as components, and return it.
 */
 (car, cdr))
 { XD_LONG,              offsetof (Lisp_Vector, size) },
 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Vector, contents), XD_INDIRECT(0, 0) },
 { XD_END }
 };
-DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("vector", vector,
+DEFINE_SIZABLE_LISP_OBJECT ("vector", vector,
 					1, /*dumpable-flag*/
 					mark_vector, print_vector, 0,
 					vector_equal,
 					vector_hash,
 					vector_description,
 make_vector_internal (Elemcount sizei)
 {
 /* no `next' field; we use lcrecords */
 Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object,
 						  contents, sizei);
-Lisp_Vector *p =
+Lisp_Object obj = ALLOC_SIZED_LISP_OBJECT (sizem, vector);
-(Lisp_Vector *) BASIC_ALLOC_LCRECORD (sizem, &lrecord_vector);
+Lisp_Vector *p = XVECTOR (obj);
 p->size = sizei;
 return p;
 }
 /* no `next' field; we use lcrecords */
 Elemcount num_longs = BIT_VECTOR_LONG_STORAGE (sizei);
 Bytecount sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector,
 						  unsigned long,
 						  bits, num_longs);
-Lisp_Bit_Vector *p = (Lisp_Bit_Vector *)
+Lisp_Object obj = ALLOC_SIZED_LISP_OBJECT (sizem, bit_vector);
-BASIC_ALLOC_LCRECORD (sizem, &lrecord_bit_vector);
+Lisp_Bit_Vector *p = XBIT_VECTOR (obj);
 bit_vector_length (p) = sizei;
 return p;
 }
 internal_hash() already knows how to hash strings and finalization
 is done with the ADDITIONAL_FREE_string macro, which is the
 standard way to do finalization when using
 SWEEP_FIXED_TYPE_BLOCK(). */
-DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string,
+DEFINE_BASIC_LISP_OBJECT_WITH_PROPS ("string", string,
-						1, /*dumpable-flag*/
 						mark_string, print_string,
 						0, string_equal, 0,
 						string_description,
 						string_getprop,
 						string_putprop,
 if (BIG_STRING_SIZE_P (size))
 	xfree (s->data_, Ibyte *);
 }
 }
-DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS ("string", string,
+DEFINE_LISP_OBJECT_WITH_PROPS ("string", string,
-					  1, /*dumpable-flag*/
 					  mark_string, print_string,
 					  finalize_string,
 					  string_equal, 0,
 					  string_description,
 					  string_getprop,
 /************************************************************************/
 /*                           lcrecord lists                             */
 /************************************************************************/
 /* Lcrecord lists are used to manage the allocation of particular
-sorts of lcrecords, to avoid calling BASIC_ALLOC_LCRECORD() (and thus
+sorts of lcrecords, to avoid calling ALLOC_LISP_OBJECT() (and thus
 malloc() and garbage-collection junk) as much as possible.
 It is similar to the Blocktype class.
 See detailed comment in lcrecord.h.
 */
 { XD_LISP_OBJECT, offsetof (struct free_lcrecord_header, chain), 0, { 0 },
 XD_FLAG_FREE_LISP_OBJECT },
 { XD_END }
 };
-DEFINE_LRECORD_IMPLEMENTATION ("free", free,
+DEFINE_NONDUMPABLE_LISP_OBJECT ("free", free, 0, 0,
-			       0, /*dumpable-flag*/
+					   0, 0, 0, free_description,
-			       0, internal_object_printer,
+					   struct free_lcrecord_header);
-			       0, 0, 0, free_description,
-			       struct free_lcrecord_header);
 const struct memory_description lcrecord_list_description[] = {
 { XD_LISP_OBJECT, offsetof (struct lcrecord_list, free), 0, { 0 },
 XD_FLAG_FREE_LISP_OBJECT },
 { XD_END }
 }
 return Qnil;
 }
-DEFINE_LRECORD_IMPLEMENTATION ("lcrecord-list", lcrecord_list,
+DEFINE_NONDUMPABLE_LISP_OBJECT ("lcrecord-list", lcrecord_list,
-			       0, /*dumpable-flag*/
+					   mark_lcrecord_list,
-			       mark_lcrecord_list, internal_object_printer,
+					   0,
-			       0, 0, 0, lcrecord_list_description,
+					   0, 0, 0, lcrecord_list_description,
-			       struct lcrecord_list);
+					   struct lcrecord_list);
 Lisp_Object
 make_lcrecord_list (Elemcount size,
 		    const struct lrecord_implementation *implementation)
 {
 list->free = lcrecord;
 }
 static Lisp_Object all_lcrecord_lists[countof (lrecord_implementations_table)];
-void *
+Lisp_Object
-alloc_automanaged_lcrecord (Bytecount size,
+alloc_automanaged_sized_lcrecord (Bytecount size,
-			    const struct lrecord_implementation *imp)
+				  const struct lrecord_implementation *imp)
 {
 if (EQ (all_lcrecord_lists[imp->lrecord_type_index], Qzero))
 all_lcrecord_lists[imp->lrecord_type_index] =
 make_lcrecord_list (size, imp);
-return XPNTR (alloc_managed_lcrecord
+return alloc_managed_lcrecord (all_lcrecord_lists[imp->lrecord_type_index]);
-		(all_lcrecord_lists[imp->lrecord_type_index]));
+}
+Lisp_Object
+alloc_automanaged_lcrecord (const struct lrecord_implementation *imp)
+{
+type_checking_assert (imp->static_size > 0);
+return alloc_automanaged_sized_lcrecord (imp->static_size, imp);
 }
 void
 old_free_lcrecord (Lisp_Object rec)
 {
 int i;
 for (i = 0; i < countof (lrecord_implementations_table); i++)
 lrecord_implementations_table[i] = 0;
 }
-INIT_LRECORD_IMPLEMENTATION (cons);
+INIT_LISP_OBJECT (cons);
-INIT_LRECORD_IMPLEMENTATION (vector);
+INIT_LISP_OBJECT (vector);
-INIT_LRECORD_IMPLEMENTATION (string);
+INIT_LISP_OBJECT (string);
 #ifndef MC_ALLOC
-INIT_LRECORD_IMPLEMENTATION (lcrecord_list);
+INIT_LISP_OBJECT (lcrecord_list);
-INIT_LRECORD_IMPLEMENTATION (free);
+INIT_LISP_OBJECT (free);
 #endif /* not MC_ALLOC */
 staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *);
 Dynarr_resize (staticpros, 1410); /* merely a small optimization */
 dump_add_root_block_ptr (&staticpros, &staticpros_description);

Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 5117:3742ea8250b5 ben-lisp-object ben-lisp-object-final-ws-year-2005