X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Falloc.c;h=e0dbedaf12d69aa1942fd71db03f892ba8893336;hb=26c9e2e09a7ccc89afc02482d72a35984833792a;hp=b069424b9d11c95aac62a869f9e5f1548556e625;hpb=98a6e4055a1fa624c592ac06f79287d55196ca37;p=chise%2Fxemacs-chise.git- diff --git a/src/alloc.c b/src/alloc.c index b069424..e0dbeda 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -42,7 +42,6 @@ Boston, MA 02111-1307, USA. */ #include #include "lisp.h" -#include "alloc.h" #include "backtrace.h" #include "buffer.h" #include "bytecode.h" @@ -358,6 +357,9 @@ 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) @@ -387,6 +389,37 @@ 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. @@ -437,6 +470,14 @@ 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 } @@ -448,17 +489,17 @@ disksave_object_finalization_1 (void) about expressions in src/.gdbinit. See src/.gdbinit or src/.dbxrc to see how this is used. */ -EMACS_UINT dbg_valmask = ((1UL << VALBITS) - 1) << GCBITS; -EMACS_UINT dbg_typemask = (1UL << GCTYPEBITS) - 1; +const EMACS_UINT dbg_valmask = ((1UL << VALBITS) - 1) << GCBITS; +const EMACS_UINT dbg_typemask = (1UL << GCTYPEBITS) - 1; #ifdef USE_UNION_TYPE -unsigned char dbg_USE_UNION_TYPE = 1; +const unsigned char dbg_USE_UNION_TYPE = 1; #else -unsigned char dbg_USE_UNION_TYPE = 0; +const unsigned char dbg_USE_UNION_TYPE = 0; #endif -unsigned char dbg_valbits = VALBITS; -unsigned char dbg_gctypebits = GCTYPEBITS; +const unsigned char dbg_valbits = VALBITS; +const unsigned char dbg_gctypebits = GCTYPEBITS; /* Macros turned into functions for ease of debugging. Debuggers don't know about macros! */ @@ -779,16 +820,18 @@ You have some weird system and need to supply a reasonable value here. /* The construct (* (void **) (ptr)) would cause aliasing problems with modern optimizing compilers like `gcc -O3 -fstrict-aliasing'. - But `char *' can legally alias any pointer. Hence this union trick. */ + But `char *' can legally alias any pointer. Hence this union trick... + + It turned out that the union trick was not good enough for xlC -O3; + and it is questionable whether it really complies with the C standard. + so we use memset instead, which should be safe from optimizations. */ typedef union { char c; void *p; } *aliasing_voidpp; #define ALIASING_VOIDPP_DEREFERENCE(ptr) \ (((aliasing_voidpp) (ptr))->p) #define FREE_STRUCT_P(ptr) \ (ALIASING_VOIDPP_DEREFERENCE (ptr) == (void *) INVALID_POINTER_VALUE) -#define MARK_STRUCT_AS_FREE(ptr) \ - (ALIASING_VOIDPP_DEREFERENCE (ptr) = (void *) INVALID_POINTER_VALUE) -#define MARK_STRUCT_AS_NOT_FREE(ptr) \ - (ALIASING_VOIDPP_DEREFERENCE (ptr) = 0) +#define MARK_STRUCT_AS_FREE(ptr) memset (ptr, 0xff, sizeof (void *)) +#define MARK_STRUCT_AS_NOT_FREE(ptr) memset (ptr, 0x00, sizeof (void *)) #ifdef ERROR_CHECK_GC @@ -1143,6 +1186,74 @@ 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'. @@ -2061,6 +2172,10 @@ LENGTH must be a non-negative integer. Bufbyte *init_ptr = init_str; switch (len) { +#ifdef UTF2000 + case 6: *ptr++ = *init_ptr++; + case 5: *ptr++ = *init_ptr++; +#endif case 4: *ptr++ = *init_ptr++; case 3: *ptr++ = *init_ptr++; case 2: *ptr++ = *init_ptr++; @@ -2347,98 +2462,47 @@ Lisp_Object (*lrecord_markers[countof (lrecord_implementations_table)]) (Lisp_Ob struct gcpro *gcprolist; -/* 415 used Mly 29-Jun-93 */ -/* 1327 used slb 28-Feb-98 */ -/* 1328 used og 03-Oct-99 (moving slowly, heh?) */ -#ifdef HAVE_SHLIB -#define NSTATICS 4000 -#else -#define NSTATICS 2000 -#endif - -/* Not "static" because used by dumper.c */ -Lisp_Object *staticvec[NSTATICS]; -int staticidx; - -/* Put an entry in staticvec, pointing at the variable whose address is given - */ -void -staticpro (Lisp_Object *varaddress) -{ - /* #### This is now a dubious assert() since this routine may be called */ - /* by Lisp attempting to load a DLL. */ - assert (staticidx < countof (staticvec)); - staticvec[staticidx++] = varaddress; -} - - -Lisp_Object *staticvec_nodump[200]; -int staticidx_nodump; - -/* Put an entry in staticvec_nodump, pointing at the variable whose address is given - */ -void -staticpro_nodump (Lisp_Object *varaddress) -{ - /* #### This is now a dubious assert() since this routine may be called */ - /* by Lisp attempting to load a DLL. */ - assert (staticidx_nodump < countof (staticvec_nodump)); - staticvec_nodump[staticidx_nodump++] = varaddress; -} - - -struct pdump_dumpstructinfo dumpstructvec[200]; -int dumpstructidx; - -/* Put an entry in dumpstructvec, pointing at the variable whose address is given - */ -void -dumpstruct (void *varaddress, const struct struct_description *desc) -{ - assert (dumpstructidx < countof (dumpstructvec)); - dumpstructvec[dumpstructidx].data = varaddress; - dumpstructvec[dumpstructidx].desc = desc; - dumpstructidx++; -} +/* We want the staticpros relocated, but not the pointers found therein. + Hence we use a trivial description, as for pointerless objects. */ +static const struct lrecord_description staticpro_description_1[] = { + { XD_END } +}; -struct pdump_dumpopaqueinfo dumpopaquevec[250]; -int dumpopaqueidx; +static const struct struct_description staticpro_description = { + sizeof (Lisp_Object *), + staticpro_description_1 +}; -/* Put an entry in dumpopaquevec, pointing at the variable whose address is given - */ -void -dumpopaque (void *varaddress, size_t size) -{ - assert (dumpopaqueidx < countof (dumpopaquevec)); +static const struct lrecord_description staticpros_description_1[] = { + XD_DYNARR_DESC (Lisp_Object_ptr_dynarr, &staticpro_description), + { XD_END } +}; - dumpopaquevec[dumpopaqueidx].data = varaddress; - dumpopaquevec[dumpopaqueidx].size = size; - dumpopaqueidx++; -} +static const struct struct_description staticpros_description = { + sizeof (Lisp_Object_ptr_dynarr), + staticpros_description_1 +}; -Lisp_Object *pdump_wirevec[50]; -int pdump_wireidx; +Lisp_Object_ptr_dynarr *staticpros; -/* Put an entry in pdump_wirevec, pointing at the variable whose address is given - */ +/* Mark the Lisp_Object at non-heap VARADDRESS as a root object for + garbage collection, and for dumping. */ void -pdump_wire (Lisp_Object *varaddress) +staticpro (Lisp_Object *varaddress) { - assert (pdump_wireidx < countof (pdump_wirevec)); - pdump_wirevec[pdump_wireidx++] = varaddress; + Dynarr_add (staticpros, varaddress); + dump_add_root_object (varaddress); } -Lisp_Object *pdump_wirevec_list[50]; -int pdump_wireidx_list; +Lisp_Object_ptr_dynarr *staticpros_nodump; -/* Put an entry in pdump_wirevec_list, pointing at the variable whose address is given - */ +/* Mark the Lisp_Object at non-heap VARADDRESS as a root object for + garbage collection, but not for dumping. */ void -pdump_wire_list (Lisp_Object *varaddress) +staticpro_nodump (Lisp_Object *varaddress) { - assert (pdump_wireidx_list < countof (pdump_wirevec_list)); - pdump_wirevec_list[pdump_wireidx_list++] = varaddress; + Dynarr_add (staticpros_nodump, varaddress); } #ifdef ERROR_CHECK_GC @@ -2479,7 +2543,11 @@ 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)) + if ( (!MARKED_RECORD_HEADER_P (lheader)) +#ifdef UTF2000 + && (!OLDER_RECORD_HEADER_P (lheader)) +#endif + ) { MARK_RECORD_HEADER (lheader); @@ -3429,11 +3497,17 @@ garbage_collect_1 (void) /* Mark all the special slots that serve as the roots of accessibility. */ { /* staticpro() */ - int i; - for (i = 0; i < staticidx; i++) - mark_object (*(staticvec[i])); - for (i = 0; i < staticidx_nodump; i++) - mark_object (*(staticvec_nodump[i])); + Lisp_Object **p = Dynarr_begin (staticpros); + size_t count; + for (count = Dynarr_length (staticpros); count; count--) + mark_object (**p++); + } + + { /* staticpro_nodump() */ + Lisp_Object **p = Dynarr_begin (staticpros_nodump); + size_t count; + for (count = Dynarr_length (staticpros_nodump); count; count--) + mark_object (**p++); } { /* GCPRO() */ @@ -3470,7 +3544,7 @@ garbage_collect_1 (void) int i; mark_object (*backlist->function); - if (nargs == UNEVALLED || nargs == MANY) + if (nargs < 0 /* nargs == UNEVALLED || nargs == MANY */) mark_object (backlist->args[0]); else for (i = 0; i < nargs; i++) @@ -3875,6 +3949,9 @@ 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 */ @@ -3897,9 +3974,10 @@ reinit_alloc_once_early (void) ignore_malloc_warnings = 0; - staticidx_nodump = 0; - dumpstructidx = 0; - pdump_wireidx = 0; + if (staticpros_nodump) + Dynarr_free (staticpros_nodump); + staticpros_nodump = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *); + Dynarr_resize (staticpros_nodump, 100); /* merely a small optimization */ consing_since_gc = 0; #if 1 @@ -3941,11 +4019,11 @@ init_alloc_once_early (void) INIT_LRECORD_IMPLEMENTATION (string); INIT_LRECORD_IMPLEMENTATION (lcrecord_list); - staticidx = 0; + staticpros = Dynarr_new2 (Lisp_Object_ptr_dynarr, Lisp_Object *); + Dynarr_resize (staticpros, 1410); /* merely a small optimization */ + dump_add_root_struct_ptr (&staticpros, &staticpros_description); } -int pure_bytes_used = 0; - void reinit_alloc (void) { @@ -3997,10 +4075,6 @@ prevent garbage collection during a part of the program. See also `consing-since-gc'. */ ); - DEFVAR_INT ("pure-bytes-used", &pure_bytes_used /* -Number of bytes of sharable Lisp data allocated so far. -*/ ); - #ifdef DEBUG_XEMACS DEFVAR_INT ("debug-allocation", &debug_allocation /* If non-zero, print out information to stderr about all objects allocated.