xemacs-beta: src/alloc.c comparison

comparison src/alloc.c @ 211:78478c60bfcd r20-4b4

Import from CVS: tag r20-4b4

author	cvs
date	Mon, 13 Aug 2007 10:05:51 +0200
parents	e45d5e7c476e
children	52952cbfc5b5

comparison

equal deleted inserted replaced

-:49f55ca3ba57
+:78478c60bfcd
 * After doing the mark phase, the GC will walk this linked
 *  list and free any record which hasn't been marked
 */
 static struct lcrecord_header *all_lcrecords;
+int lrecord_type_index (CONST struct lrecord_implementation *implementation);
 void *
 alloc_lcrecord (int size, CONST struct lrecord_implementation *implementation)
 {
 struct lcrecord_header *lcheader;
 }
 else if (implementation->static_size != size)
 abort ();
 lcheader = (struct lcrecord_header *) allocate_lisp_storage (size);
-lcheader->lheader.implementation = implementation;
+set_lheader_implementation(&(lcheader->lheader), 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 */
 lcheader->uid = (int) &lcheader;
 {
 struct lcrecord_header *header;
 for (header = all_lcrecords; header; header = header->next)
 {
-if (header->lheader.implementation->finalizer && !header->free)
+if (LHEADER_IMPLEMENTATION(&header->lheader)->finalizer &&
-	((header->lheader.implementation->finalizer) (header, 1));
+	  !header->free)
+	((LHEADER_IMPLEMENTATION(&header->lheader)->finalizer)
+	 (header, 1));
 }
 }
 /* This must not be called -- it just serves as for EQ test
 /* XGCTYPE for records */
 int
 gc_record_type_p (Lisp_Object frob, CONST struct lrecord_implementation *type)
 {
+#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
+return (XGCTYPE (frob) == Lisp_Type_Record
+&& XRECORD_LHEADER_IMPLEMENTATION (frob) == type);
+#else
 return (XGCTYPE (frob) == Lisp_Type_Record
 && (XRECORD_LHEADER (frob)->implementation == type ||
 XRECORD_LHEADER (frob)->implementation == type + 1));
+#endif
 }
 /**********************************************************************/
 /*                        Fixed-size type macros                      */
 {
 Lisp_Object val;
 struct Lisp_Float *f;
 ALLOCATE_FIXED_TYPE (float, struct Lisp_Float, f);
-f->lheader.implementation = lrecord_float;
+set_lheader_implementation (&(f->lheader), lrecord_float);
 float_next (f) = ((struct Lisp_Float *) -1);
 float_data (f) = float_value;
 XSETFLOAT (val, f);
 return val;
 }
 if (make_pure && check_purespace (size))
 {
 b = (struct Lisp_Compiled_Function *) (PUREBEG + pureptr);
 set_lheader_implementation (&(b->lheader), lrecord_compiled_function);
+#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
+b->lheader.pure = 1;
+#endif
 pureptr += size;
 bump_purestat (&purestat_bytecode, size);
 }
 else
 {
 struct free_lcrecord_header *free_header =
 	(struct free_lcrecord_header *) lheader;
 #ifdef ERROR_CHECK_GC
 CONST struct lrecord_implementation *implementation
-	= lheader->implementation;
+	= LHEADER_IMPLEMENTATION(lheader);
 /* There should be no other pointers to the free list. */
 assert (!MARKED_RECORD_HEADER_P (lheader));
 /* Only lcrecords should be here. */
 assert (!implementation->basic_p);
 #ifdef ERROR_CHECK_GC
 struct lrecord_header *lheader =
 	(struct lrecord_header *) free_header;
 CONST struct lrecord_implementation *implementation
-	= lheader->implementation;
+	= LHEADER_IMPLEMENTATION (lheader);
 /* There should be no other pointers to the free list. */
 assert (!MARKED_RECORD_HEADER_P (lheader));
 /* Only lcrecords should be here. */
 assert (!implementation->basic_p);
 struct free_lcrecord_header *free_header =
 (struct free_lcrecord_header *) XPNTR (lcrecord);
 struct lrecord_header *lheader =
 (struct lrecord_header *) free_header;
 CONST struct lrecord_implementation *implementation
-= lheader->implementation;
+= LHEADER_IMPLEMENTATION (lheader);
 #ifdef ERROR_CHECK_GC
 /* Make sure the size is correct.  This will catch, for example,
 putting a window configuration on the wrong free list. */
 if (implementation->size_in_bytes_method)
 return make_string (data, length);
 s = (struct Lisp_String *) (PUREBEG + pureptr);
 #ifdef LRECORD_STRING
 set_lheader_implementation (&(s->lheader), lrecord_string);
+#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
+s->lheader.pure = 1;
+#endif
 #endif
 set_string_length (s, length);
 if (no_need_to_copy_data)
 {
 set_string_data (s, (Bufbyte *) data);
 return Fcons (Fpurecopy (car), Fpurecopy (cdr));
 c = (struct Lisp_Cons *) (PUREBEG + pureptr);
 #ifdef LRECORD_CONS
 set_lheader_implementation (&(c->lheader), lrecord_cons);
+#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
+c->lheader.pure = 1;
+#endif
 #endif
 pureptr += sizeof (struct Lisp_Cons);
 bump_purestat (&purestat_cons, sizeof (struct Lisp_Cons));
 c->car = Fpurecopy (car);
 if (!check_purespace (sizeof (struct Lisp_Float)))
 return make_float (num);
 f = (struct Lisp_Float *) (PUREBEG + pureptr);
 set_lheader_implementation (&(f->lheader), lrecord_float);
+#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
+f->lheader.pure = 1;
+#endif
 pureptr += sizeof (struct Lisp_Float);
 bump_purestat (&purestat_float, sizeof (struct Lisp_Float));
 float_next (f) = ((struct Lisp_Float *) -1);
 float_data (f) = num;
 return make_vector (len, init);
 v = (struct Lisp_Vector *) (PUREBEG + pureptr);
 #ifdef LRECORD_VECTOR
 set_lheader_implementation (&(v->header.lheader), lrecord_vector);
+#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
+v->header.lheader.pure = 1;
+#endif
 #endif
 pureptr += size;
 bump_purestat (&purestat_vector_all, size);
 v->size = len;
 case Lisp_Type_Record:
 /* case Lisp_Symbol_Value_Magic: */
 {
 	struct lrecord_header *lheader = XRECORD_LHEADER (obj);
 	CONST struct lrecord_implementation *implementation
-	  = lheader->implementation;
+	  = LHEADER_IMPLEMENTATION (lheader);
 	if (! MARKED_RECORD_HEADER_P (lheader) &&
 	    ! UNMARKABLE_RECORD_HEADER_P (lheader))
 	  {
 	    MARK_RECORD_HEADER (lheader);
 case Lisp_Type_Record:
 {
 	struct lrecord_header *lheader = XRECORD_LHEADER (obj);
 	CONST struct lrecord_implementation *implementation
-	  = lheader->implementation;
+	  = LHEADER_IMPLEMENTATION (lheader);
 #ifdef LRECORD_STRING
 	if (STRINGP (obj))
 	  total += pure_string_sizeof (obj);
 	else
 /* This will be used more extensively In The Future */
 static int last_lrecord_type_index_assigned;
-static CONST struct lrecord_implementation *lrecord_implementations_table[128];
+CONST struct lrecord_implementation *lrecord_implementations_table[128];
 #define max_lrecord_type (countof (lrecord_implementations_table) - 1)
-static int
+int
 lrecord_type_index (CONST struct lrecord_implementation *implementation)
 {
 int type_index = *(implementation->lrecord_type_index);
 /* Have to do this circuitous and validation test because of problems
 dumping out initialized variables (ie can't set xxx_type_index to -1
 }
 static void
 tick_lcrecord_stats (CONST struct lrecord_header *h, int free_p)
 {
-CONST struct lrecord_implementation *implementation = h->implementation;
+CONST struct lrecord_implementation *implementation =
+LHEADER_IMPLEMENTATION (h);
 int type_index = lrecord_type_index (implementation);
 if (((struct lcrecord_header *) h)->free)
 {
 assert (!free_p);
 for (header = *prev; header; header = header->next)
 {
 struct lrecord_header *h = &(header->lheader);
 if (!MARKED_RECORD_HEADER_P (h) && ! (header->free))
 	{
-	  if (h->implementation->finalizer)
+	  if (LHEADER_IMPLEMENTATION (h)->finalizer)
-	    ((h->implementation->finalizer) (h, 0));
+	    ((LHEADER_IMPLEMENTATION (h)->finalizer) (h, 0));
 	}
 }
 for (header = *prev; header; )
 {
 for (iii = 0; iii < countof (lrecord_implementations_table); iii++)
 {
 lrecord_implementations_table[iii] = 0;
 }
+#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
+/*
+* If USE_INDEXED_LRECORD_IMPLEMENTATION is defined, all the staticly
+* defined subr lrecords were initialized with lheader->type == 0.
+* See subr_lheader_initializer in lisp.h.  Force type index 0 to be
+* assigned to lrecord_subr so that those predefined indexes match
+* reality.
+*/
+(void) lrecord_type_index (lrecord_subr);
+assert (*(lrecord_subr[0].lrecord_type_index) == 0);
+/*
+* The same is true for symbol_value_forward objects, except the
+* type is 1.
+*/
+(void) lrecord_type_index (lrecord_symbol_value_forward);
+assert (*(lrecord_symbol_value_forward[0].lrecord_type_index) == 1);
+#endif
 symbols_initialized = 0;
 gc_generation_number[0] = 0;
 /* purify_flag 1 is correct even if CANNOT_DUMP.
 * loadup.el will set to nil at end. */

Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 211:78478c60bfcd r20-4b4