diff options
| -rw-r--r-- | src/.gdbinit | 27 | ||||
| -rw-r--r-- | src/alloc.c | 30 | ||||
| -rw-r--r-- | src/lisp.h | 12 | ||||
| -rw-r--r-- | src/pdumper.c | 5 |
4 files changed, 39 insertions, 35 deletions
diff --git a/src/.gdbinit b/src/.gdbinit index c0cf6393594..e9ba5267ece 100644 --- a/src/.gdbinit +++ b/src/.gdbinit | |||
| @@ -382,7 +382,7 @@ define pwinx | |||
| 382 | xgetptr $w->contents | 382 | xgetptr $w->contents |
| 383 | set $tem = (struct buffer *) $ptr | 383 | set $tem = (struct buffer *) $ptr |
| 384 | xgetptr $tem->name_ | 384 | xgetptr $tem->name_ |
| 385 | printf "%s", ((struct Lisp_String *) $ptr)->u.s.data | 385 | printf "%s", $ptr ? (char *) ((struct Lisp_String *) $ptr)->u.s.data : "DEAD" |
| 386 | printf "\n" | 386 | printf "\n" |
| 387 | xgetptr $w->start | 387 | xgetptr $w->start |
| 388 | set $tem = (struct Lisp_Marker *) $ptr | 388 | set $tem = (struct Lisp_Marker *) $ptr |
| @@ -508,7 +508,12 @@ define pgx | |||
| 508 | xgettype ($g.object) | 508 | xgettype ($g.object) |
| 509 | if ($type == Lisp_String) | 509 | if ($type == Lisp_String) |
| 510 | xgetptr $g.object | 510 | xgetptr $g.object |
| 511 | printf " str=0x%x[%d]", ((struct Lisp_String *)$ptr)->u.s.data, $g.charpos | 511 | if ($ptr) |
| 512 | printf " str=0x%x", ((struct Lisp_String *)$ptr)->u.s.data | ||
| 513 | else | ||
| 514 | printf " str=DEAD" | ||
| 515 | end | ||
| 516 | printf "[%d]", $g.charpos | ||
| 512 | else | 517 | else |
| 513 | printf " pos=%d", $g.charpos | 518 | printf " pos=%d", $g.charpos |
| 514 | end | 519 | end |
| @@ -879,7 +884,7 @@ define xbuffer | |||
| 879 | xgetptr $ | 884 | xgetptr $ |
| 880 | print (struct buffer *) $ptr | 885 | print (struct buffer *) $ptr |
| 881 | xgetptr $->name_ | 886 | xgetptr $->name_ |
| 882 | output ((struct Lisp_String *) $ptr)->u.s.data | 887 | output $ptr ? (char *) ((struct Lisp_String *) $ptr)->u.s.data : "DEAD" |
| 883 | echo \n | 888 | echo \n |
| 884 | end | 889 | end |
| 885 | document xbuffer | 890 | document xbuffer |
| @@ -1046,13 +1051,17 @@ Print $ as a lisp object of any type. | |||
| 1046 | end | 1051 | end |
| 1047 | 1052 | ||
| 1048 | define xprintstr | 1053 | define xprintstr |
| 1049 | set $data = (char *) $arg0->u.s.data | 1054 | if (! $arg0) |
| 1050 | set $strsize = ($arg0->u.s.size_byte < 0) ? ($arg0->u.s.size & ~ARRAY_MARK_FLAG) : $arg0->u.s.size_byte | 1055 | output "DEAD" |
| 1051 | # GDB doesn't like zero repetition counts | ||
| 1052 | if $strsize == 0 | ||
| 1053 | output "" | ||
| 1054 | else | 1056 | else |
| 1055 | output ($arg0->u.s.size > 1000) ? 0 : ($data[0])@($strsize) | 1057 | set $data = (char *) $arg0->u.s.data |
| 1058 | set $strsize = ($arg0->u.s.size_byte < 0) ? ($arg0->u.s.size & ~ARRAY_MARK_FLAG) : $arg0->u.s.size_byte | ||
| 1059 | # GDB doesn't like zero repetition counts | ||
| 1060 | if $strsize == 0 | ||
| 1061 | output "" | ||
| 1062 | else | ||
| 1063 | output ($arg0->u.s.size > 1000) ? 0 : ($data[0])@($strsize) | ||
| 1064 | end | ||
| 1056 | end | 1065 | end |
| 1057 | end | 1066 | end |
| 1058 | 1067 | ||
diff --git a/src/alloc.c b/src/alloc.c index 833176d4e90..7a0611dd3e2 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -420,14 +420,11 @@ enum mem_type | |||
| 420 | MEM_TYPE_SPARE | 420 | MEM_TYPE_SPARE |
| 421 | }; | 421 | }; |
| 422 | 422 | ||
| 423 | /* A unique object in pure space used to make some Lisp objects | 423 | static bool |
| 424 | on free lists recognizable in O(1). */ | 424 | deadp (Lisp_Object x) |
| 425 | 425 | { | |
| 426 | #ifndef ENABLE_CHECKING | 426 | return EQ (x, dead_object ()); |
| 427 | static | 427 | } |
| 428 | #endif | ||
| 429 | Lisp_Object Vdead; | ||
| 430 | #define DEADP(x) EQ (x, Vdead) | ||
| 431 | 428 | ||
| 432 | #ifdef GC_MALLOC_CHECK | 429 | #ifdef GC_MALLOC_CHECK |
| 433 | 430 | ||
| @@ -499,10 +496,6 @@ static void mem_delete (struct mem_node *); | |||
| 499 | static void mem_delete_fixup (struct mem_node *); | 496 | static void mem_delete_fixup (struct mem_node *); |
| 500 | static struct mem_node *mem_find (void *); | 497 | static struct mem_node *mem_find (void *); |
| 501 | 498 | ||
| 502 | #ifndef DEADP | ||
| 503 | # define DEADP(x) 0 | ||
| 504 | #endif | ||
| 505 | |||
| 506 | /* Addresses of staticpro'd variables. Initialize it to a nonzero | 499 | /* Addresses of staticpro'd variables. Initialize it to a nonzero |
| 507 | value if we might unexec; otherwise some compilers put it into | 500 | value if we might unexec; otherwise some compilers put it into |
| 508 | BSS. */ | 501 | BSS. */ |
| @@ -2548,7 +2541,7 @@ void | |||
| 2548 | free_cons (struct Lisp_Cons *ptr) | 2541 | free_cons (struct Lisp_Cons *ptr) |
| 2549 | { | 2542 | { |
| 2550 | ptr->u.s.u.chain = cons_free_list; | 2543 | ptr->u.s.u.chain = cons_free_list; |
| 2551 | ptr->u.s.car = Vdead; | 2544 | ptr->u.s.car = dead_object (); |
| 2552 | cons_free_list = ptr; | 2545 | cons_free_list = ptr; |
| 2553 | consing_since_gc -= sizeof *ptr; | 2546 | consing_since_gc -= sizeof *ptr; |
| 2554 | gcstat.total_free_conses++; | 2547 | gcstat.total_free_conses++; |
| @@ -4374,7 +4367,7 @@ live_cons_holding (struct mem_node *m, void *p) | |||
| 4374 | { | 4367 | { |
| 4375 | cp = ptr_bounds_copy (cp, b); | 4368 | cp = ptr_bounds_copy (cp, b); |
| 4376 | struct Lisp_Cons *s = p = cp -= offset % sizeof b->conses[0]; | 4369 | struct Lisp_Cons *s = p = cp -= offset % sizeof b->conses[0]; |
| 4377 | if (!EQ (s->u.s.car, Vdead)) | 4370 | if (!deadp (s->u.s.car)) |
| 4378 | return make_lisp_ptr (s, Lisp_Cons); | 4371 | return make_lisp_ptr (s, Lisp_Cons); |
| 4379 | } | 4372 | } |
| 4380 | } | 4373 | } |
| @@ -4410,7 +4403,7 @@ live_symbol_holding (struct mem_node *m, void *p) | |||
| 4410 | { | 4403 | { |
| 4411 | cp = ptr_bounds_copy (cp, b); | 4404 | cp = ptr_bounds_copy (cp, b); |
| 4412 | struct Lisp_Symbol *s = p = cp -= offset % sizeof b->symbols[0]; | 4405 | struct Lisp_Symbol *s = p = cp -= offset % sizeof b->symbols[0]; |
| 4413 | if (!EQ (s->u.s.function, Vdead)) | 4406 | if (!deadp (s->u.s.function)) |
| 4414 | return make_lisp_symbol (s); | 4407 | return make_lisp_symbol (s); |
| 4415 | } | 4408 | } |
| 4416 | } | 4409 | } |
| @@ -6717,7 +6710,7 @@ sweep_conses (void) | |||
| 6717 | this_free++; | 6710 | this_free++; |
| 6718 | cblk->conses[pos].u.s.u.chain = cons_free_list; | 6711 | cblk->conses[pos].u.s.u.chain = cons_free_list; |
| 6719 | cons_free_list = &cblk->conses[pos]; | 6712 | cons_free_list = &cblk->conses[pos]; |
| 6720 | cons_free_list->u.s.car = Vdead; | 6713 | cons_free_list->u.s.car = dead_object (); |
| 6721 | } | 6714 | } |
| 6722 | else | 6715 | else |
| 6723 | { | 6716 | { |
| @@ -6883,7 +6876,7 @@ sweep_symbols (void) | |||
| 6883 | } | 6876 | } |
| 6884 | sym->u.s.next = symbol_free_list; | 6877 | sym->u.s.next = symbol_free_list; |
| 6885 | symbol_free_list = sym; | 6878 | symbol_free_list = sym; |
| 6886 | symbol_free_list->u.s.function = Vdead; | 6879 | symbol_free_list->u.s.function = dead_object (); |
| 6887 | ++this_free; | 6880 | ++this_free; |
| 6888 | } | 6881 | } |
| 6889 | else | 6882 | else |
| @@ -7072,7 +7065,7 @@ which_symbols (Lisp_Object obj, EMACS_INT find_max) | |||
| 7072 | ptrdiff_t gc_count = inhibit_garbage_collection (); | 7065 | ptrdiff_t gc_count = inhibit_garbage_collection (); |
| 7073 | Lisp_Object found = Qnil; | 7066 | Lisp_Object found = Qnil; |
| 7074 | 7067 | ||
| 7075 | if (! DEADP (obj)) | 7068 | if (! deadp (obj)) |
| 7076 | { | 7069 | { |
| 7077 | for (int i = 0; i < ARRAYELTS (lispsym); i++) | 7070 | for (int i = 0; i < ARRAYELTS (lispsym); i++) |
| 7078 | { | 7071 | { |
| @@ -7251,7 +7244,6 @@ init_alloc_once_for_pdumper (void) | |||
| 7251 | purebeg = PUREBEG; | 7244 | purebeg = PUREBEG; |
| 7252 | pure_size = PURESIZE; | 7245 | pure_size = PURESIZE; |
| 7253 | mem_init (); | 7246 | mem_init (); |
| 7254 | Vdead = make_pure_string ("DEAD", 4, 4, 0); | ||
| 7255 | 7247 | ||
| 7256 | #ifdef DOUG_LEA_MALLOC | 7248 | #ifdef DOUG_LEA_MALLOC |
| 7257 | mallopt (M_TRIM_THRESHOLD, 128 * 1024); /* Trim threshold. */ | 7249 | mallopt (M_TRIM_THRESHOLD, 128 * 1024); /* Trim threshold. */ |
diff --git a/src/lisp.h b/src/lisp.h index 7641b2aab4d..e93a219625e 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -1247,6 +1247,15 @@ make_lisp_ptr (void *ptr, enum Lisp_Type type) | |||
| 1247 | #define XSETSYMBOL(a, b) ((a) = make_lisp_symbol (b)) | 1247 | #define XSETSYMBOL(a, b) ((a) = make_lisp_symbol (b)) |
| 1248 | #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float)) | 1248 | #define XSETFLOAT(a, b) ((a) = make_lisp_ptr (b, Lisp_Float)) |
| 1249 | 1249 | ||
| 1250 | /* Return a Lisp_Object value that does not correspond to any object. | ||
| 1251 | This can make some Lisp objects on free lists recognizable in O(1). */ | ||
| 1252 | |||
| 1253 | INLINE Lisp_Object | ||
| 1254 | dead_object (void) | ||
| 1255 | { | ||
| 1256 | return make_lisp_ptr (NULL, Lisp_String); | ||
| 1257 | } | ||
| 1258 | |||
| 1250 | /* Pseudovector types. */ | 1259 | /* Pseudovector types. */ |
| 1251 | 1260 | ||
| 1252 | #define XSETPVECTYPE(v, code) \ | 1261 | #define XSETPVECTYPE(v, code) \ |
| @@ -3759,9 +3768,6 @@ extern byte_ct const memory_full_cons_threshold; | |||
| 3759 | #ifdef HAVE_PDUMPER | 3768 | #ifdef HAVE_PDUMPER |
| 3760 | extern int number_finalizers_run; | 3769 | extern int number_finalizers_run; |
| 3761 | #endif | 3770 | #endif |
| 3762 | #ifdef ENABLE_CHECKING | ||
| 3763 | extern Lisp_Object Vdead; | ||
| 3764 | #endif | ||
| 3765 | extern Lisp_Object list1 (Lisp_Object); | 3771 | extern Lisp_Object list1 (Lisp_Object); |
| 3766 | extern Lisp_Object list2 (Lisp_Object, Lisp_Object); | 3772 | extern Lisp_Object list2 (Lisp_Object, Lisp_Object); |
| 3767 | extern Lisp_Object list3 (Lisp_Object, Lisp_Object, Lisp_Object); | 3773 | extern Lisp_Object list3 (Lisp_Object, Lisp_Object, Lisp_Object); |
diff --git a/src/pdumper.c b/src/pdumper.c index 3d8531c6a43..b80757c2071 100644 --- a/src/pdumper.c +++ b/src/pdumper.c | |||
| @@ -3061,10 +3061,7 @@ dump_object (struct dump_context *ctx, Lisp_Object object) | |||
| 3061 | #if CHECK_STRUCTS && !defined (HASH_Lisp_Type_E2AD97D3F7) | 3061 | #if CHECK_STRUCTS && !defined (HASH_Lisp_Type_E2AD97D3F7) |
| 3062 | # error "Lisp_Type changed. See CHECK_STRUCTS comment in config.h." | 3062 | # error "Lisp_Type changed. See CHECK_STRUCTS comment in config.h." |
| 3063 | #endif | 3063 | #endif |
| 3064 | #ifdef ENABLE_CHECKING | 3064 | eassert (!EQ (object, dead_object ())); |
| 3065 | /* Vdead is extern only when ENABLE_CHECKING. */ | ||
| 3066 | eassert (!EQ (object, Vdead)); | ||
| 3067 | #endif | ||
| 3068 | 3065 | ||
| 3069 | dump_off offset = dump_recall_object (ctx, object); | 3066 | dump_off offset = dump_recall_object (ctx, object); |
| 3070 | if (offset > 0) | 3067 | if (offset > 0) |