X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Falloc.c;h=23a6a91d6028ca027b3141d5442d751e2d592f54;hb=153c92fa2a3b77ce954a1e54a5dc9ec15370cfd6;hp=9e0174d1c65ab6a183f765b922a0f6a5bbd1a622;hpb=5483e97d616f1d057edccd2683b499bcf75c402a;p=chise%2Fxemacs-chise.git- diff --git a/src/alloc.c b/src/alloc.c index 9e0174d..23a6a91 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -85,8 +85,8 @@ EXFUN (Fgarbage_collect, 0); #endif #ifdef DEBUG_XEMACS -static int debug_allocation; -static int debug_allocation_backtrace_length; +static Fixnum debug_allocation; +static Fixnum debug_allocation_backtrace_length; #endif /* Number of bytes of consing done since the last gc */ @@ -357,9 +357,6 @@ allocate_lisp_storage (size_t size) After doing the mark phase, GC will walk this linked list and free any lcrecord which hasn't been marked. */ static struct lcrecord_header *all_lcrecords; -#ifdef UTF2000 -static struct lcrecord_header *all_older_lcrecords; -#endif void * alloc_lcrecord (size_t size, const struct lrecord_implementation *implementation) @@ -389,37 +386,6 @@ alloc_lcrecord (size_t size, const struct lrecord_implementation *implementation return lcheader; } -#ifdef UTF2000 -void * -alloc_older_lcrecord (size_t size, - const struct lrecord_implementation *implementation) -{ - struct lcrecord_header *lcheader; - - type_checking_assert - ((implementation->static_size == 0 ? - implementation->size_in_bytes_method != NULL : - implementation->static_size == size) - && - (! implementation->basic_p) - && - (! (implementation->hash == NULL && implementation->equal != NULL))); - - lcheader = (struct lcrecord_header *) allocate_lisp_storage (size); - set_lheader_older_implementation (&lcheader->lheader, implementation); - lcheader->next = all_older_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; -#endif - lcheader->free = 0; - all_older_lcrecords = lcheader; - INCREMENT_CONS_COUNTER (size, implementation->name); - return lcheader; -} -#endif - #if 0 /* Presently unused */ /* Very, very poor man's EGC? * This may be slow and thrash pages all over the place. @@ -470,14 +436,6 @@ disksave_object_finalization_1 (void) !header->free) LHEADER_IMPLEMENTATION (&header->lheader)->finalizer (header, 1); } -#ifdef UTF2000 - for (header = all_older_lcrecords; header; header = header->next) - { - if (LHEADER_IMPLEMENTATION (&header->lheader)->finalizer && - !header->free) - LHEADER_IMPLEMENTATION (&header->lheader)->finalizer (header, 1); - } -#endif } @@ -489,17 +447,31 @@ disksave_object_finalization_1 (void) about expressions in src/.gdbinit. See src/.gdbinit or src/.dbxrc to see how this is used. */ -const EMACS_UINT dbg_valmask = ((1UL << VALBITS) - 1) << GCBITS; -const EMACS_UINT dbg_typemask = (1UL << GCTYPEBITS) - 1; +EMACS_UINT dbg_valmask = ((1UL << VALBITS) - 1) << GCBITS; +EMACS_UINT dbg_typemask = (1UL << GCTYPEBITS) - 1; #ifdef USE_UNION_TYPE -const unsigned char dbg_USE_UNION_TYPE = 1; +unsigned char dbg_USE_UNION_TYPE = 1; #else -const unsigned char dbg_USE_UNION_TYPE = 0; +unsigned char dbg_USE_UNION_TYPE = 0; #endif -const unsigned char dbg_valbits = VALBITS; -const unsigned char dbg_gctypebits = GCTYPEBITS; +unsigned char dbg_valbits = VALBITS; +unsigned char dbg_gctypebits = GCTYPEBITS; + +/* On some systems, the above definitions will be optimized away by + the compiler or linker unless they are referenced in some function. */ +long dbg_inhibit_dbg_symbol_deletion (void); +long +dbg_inhibit_dbg_symbol_deletion (void) +{ + return + (dbg_valmask + + dbg_typemask + + dbg_USE_UNION_TYPE + + dbg_valbits + + dbg_gctypebits); +} /* Macros turned into functions for ease of debugging. Debuggers don't know about macros! */ @@ -1085,7 +1057,7 @@ mark_vector (Lisp_Object obj) static size_t size_vector (const void *lheader) { - return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, contents, + return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, contents, ((Lisp_Vector *) lheader)->size); } @@ -1133,7 +1105,8 @@ static Lisp_Vector * make_vector_internal (size_t sizei) { /* no vector_next */ - size_t sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, contents, sizei); + size_t sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, + contents, sizei); Lisp_Vector *p = (Lisp_Vector *) alloc_lcrecord (sizem, &lrecord_vector); p->size = sizei; @@ -1156,74 +1129,6 @@ make_vector (size_t length, Lisp_Object object) } } -#ifdef HAVE_GGC -Lisp_Object -make_older_vector (size_t length, Lisp_Object init) -{ - struct lcrecord_header* orig_all_lcrecords = all_lcrecords; - Lisp_Object obj; - - all_lcrecords = all_older_lcrecords; - obj = make_vector (length, init); - all_older_lcrecords = all_lcrecords; - all_lcrecords = orig_all_lcrecords; - return obj; -} - -void make_vector_newer_1 (Lisp_Object v); -void -make_vector_newer_1 (Lisp_Object v) -{ - struct lcrecord_header* lcrecords = all_older_lcrecords; - - if (lcrecords != NULL) - { - if (lcrecords == XPNTR (v)) - { - lcrecords->lheader.older = 0; - all_older_lcrecords = all_older_lcrecords->next; - lcrecords->next = all_lcrecords; - all_lcrecords = lcrecords; - return; - } - else - { - struct lcrecord_header* plcrecords = lcrecords; - - lcrecords = lcrecords->next; - while (lcrecords != NULL) - { - if (lcrecords == XPNTR (v)) - { - lcrecords->lheader.older = 0; - plcrecords->next = lcrecords->next; - lcrecords->next = all_lcrecords; - all_lcrecords = lcrecords; - return; - } - plcrecords = lcrecords; - lcrecords = lcrecords->next; - } - } - } -} - -void -make_vector_newer (Lisp_Object v) -{ - int i; - - for (i = 0; i < XVECTOR_LENGTH (v); i++) - { - Lisp_Object obj = XVECTOR_DATA (v)[i]; - - if (VECTORP (obj) && !EQ (obj, v)) - make_vector_newer (obj); - } - make_vector_newer_1 (v); -} -#endif - DEFUN ("make-vector", Fmake_vector, 2, 2, 0, /* Return a new vector of length LENGTH, with each element being OBJECT. See also the function `vector'. @@ -1364,7 +1269,8 @@ static Lisp_Bit_Vector * make_bit_vector_internal (size_t sizei) { size_t num_longs = BIT_VECTOR_LONG_STORAGE (sizei); - size_t sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits, num_longs); + size_t sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, unsigned long, + bits, num_longs); Lisp_Bit_Vector *p = (Lisp_Bit_Vector *) allocate_lisp_storage (sizem); set_lheader_implementation (&p->lheader, &lrecord_bit_vector); @@ -2516,11 +2422,7 @@ mark_object (Lisp_Object obj) /* All c_readonly objects have their mark bit set, so that we only need to check the mark bit here. */ - if ( (!MARKED_RECORD_HEADER_P (lheader)) -#ifdef UTF2000 - && (!OLDER_RECORD_HEADER_P (lheader)) -#endif - ) + if (! MARKED_RECORD_HEADER_P (lheader)) { MARK_RECORD_HEADER (lheader); @@ -2693,8 +2595,8 @@ sweep_bit_vectors_1 (Lisp_Object *prev, total_size += len; total_storage += MALLOC_OVERHEAD + - FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits, - BIT_VECTOR_LONG_STORAGE (len)); + FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, unsigned long, + bits, BIT_VECTOR_LONG_STORAGE (len)); num_used++; /* #### May modify next on a C_READONLY bitvector */ prev = &(bit_vector_next (v)); @@ -3922,9 +3824,6 @@ reinit_alloc_once_early (void) XSETINT (all_bit_vectors, 0); /* Qzero may not be set yet. */ XSETINT (Vgc_message, 0); all_lcrecords = 0; -#ifdef UTF2000 - all_older_lcrecords = 0; -#endif ignore_malloc_warnings = 1; #ifdef DOUG_LEA_MALLOC mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */