Mercurial > emacs
comparison src/alloc.c @ 83400:03934708f1e9
Merged from miles@gnu.org--gnu-2005 (patch 152-156, 642-654)
Patches applied:
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-642
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-643
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-644
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-645
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-646
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-647
lisp/gnus/ChangeLog: Remove duplicate entry
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-648
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-649
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-650
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-651
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-652
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-653
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-654
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-152
Update from CVS: lisp/mml.el (mml-preview): Doc fix.
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-153
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-154
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-155
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-156
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-440
author | Karoly Lorentey <lorentey@elte.hu> |
---|---|
date | Fri, 18 Nov 2005 13:13:34 +0000 |
parents | 693e794b57bf e485868e3caf |
children | 1955a4462bf9 |
comparison
equal
deleted
inserted
replaced
83399:2988c5a31dc1 | 83400:03934708f1e9 |
---|---|
2530 | 2530 |
2531 void | 2531 void |
2532 free_float (ptr) | 2532 free_float (ptr) |
2533 struct Lisp_Float *ptr; | 2533 struct Lisp_Float *ptr; |
2534 { | 2534 { |
2535 *(struct Lisp_Float **)&ptr->data = float_free_list; | 2535 ptr->u.chain = float_free_list; |
2536 float_free_list = ptr; | 2536 float_free_list = ptr; |
2537 } | 2537 } |
2538 | 2538 |
2539 | 2539 |
2540 /* Return a new float object with value FLOAT_VALUE. */ | 2540 /* Return a new float object with value FLOAT_VALUE. */ |
2548 if (float_free_list) | 2548 if (float_free_list) |
2549 { | 2549 { |
2550 /* We use the data field for chaining the free list | 2550 /* We use the data field for chaining the free list |
2551 so that we won't use the same field that has the mark bit. */ | 2551 so that we won't use the same field that has the mark bit. */ |
2552 XSETFLOAT (val, float_free_list); | 2552 XSETFLOAT (val, float_free_list); |
2553 float_free_list = *(struct Lisp_Float **)&float_free_list->data; | 2553 float_free_list = float_free_list->u.chain; |
2554 } | 2554 } |
2555 else | 2555 else |
2556 { | 2556 { |
2557 if (float_block_index == FLOAT_BLOCK_SIZE) | 2557 if (float_block_index == FLOAT_BLOCK_SIZE) |
2558 { | 2558 { |
2648 | 2648 |
2649 void | 2649 void |
2650 free_cons (ptr) | 2650 free_cons (ptr) |
2651 struct Lisp_Cons *ptr; | 2651 struct Lisp_Cons *ptr; |
2652 { | 2652 { |
2653 *(struct Lisp_Cons **)&ptr->cdr = cons_free_list; | 2653 ptr->u.chain = cons_free_list; |
2654 #if GC_MARK_STACK | 2654 #if GC_MARK_STACK |
2655 ptr->car = Vdead; | 2655 ptr->car = Vdead; |
2656 #endif | 2656 #endif |
2657 cons_free_list = ptr; | 2657 cons_free_list = ptr; |
2658 } | 2658 } |
2667 if (cons_free_list) | 2667 if (cons_free_list) |
2668 { | 2668 { |
2669 /* We use the cdr for chaining the free list | 2669 /* We use the cdr for chaining the free list |
2670 so that we won't use the same field that has the mark bit. */ | 2670 so that we won't use the same field that has the mark bit. */ |
2671 XSETCONS (val, cons_free_list); | 2671 XSETCONS (val, cons_free_list); |
2672 cons_free_list = *(struct Lisp_Cons **)&cons_free_list->cdr; | 2672 cons_free_list = cons_free_list->u.chain; |
2673 } | 2673 } |
2674 else | 2674 else |
2675 { | 2675 { |
2676 if (cons_block_index == CONS_BLOCK_SIZE) | 2676 if (cons_block_index == CONS_BLOCK_SIZE) |
2677 { | 2677 { |
2702 { | 2702 { |
2703 #ifdef GC_CHECK_CONS_LIST | 2703 #ifdef GC_CHECK_CONS_LIST |
2704 struct Lisp_Cons *tail = cons_free_list; | 2704 struct Lisp_Cons *tail = cons_free_list; |
2705 | 2705 |
2706 while (tail) | 2706 while (tail) |
2707 tail = *(struct Lisp_Cons **)&tail->cdr; | 2707 tail = tail->u.chain; |
2708 #endif | 2708 #endif |
2709 } | 2709 } |
2710 | 2710 |
2711 /* Make a list of 2, 3, 4 or 5 specified objects. */ | 2711 /* Make a list of 2, 3, 4 or 5 specified objects. */ |
2712 | 2712 |
3139 CHECK_STRING (name); | 3139 CHECK_STRING (name); |
3140 | 3140 |
3141 if (symbol_free_list) | 3141 if (symbol_free_list) |
3142 { | 3142 { |
3143 XSETSYMBOL (val, symbol_free_list); | 3143 XSETSYMBOL (val, symbol_free_list); |
3144 symbol_free_list = *(struct Lisp_Symbol **)&symbol_free_list->value; | 3144 symbol_free_list = symbol_free_list->next; |
3145 } | 3145 } |
3146 else | 3146 else |
3147 { | 3147 { |
3148 if (symbol_block_index == SYMBOL_BLOCK_SIZE) | 3148 if (symbol_block_index == SYMBOL_BLOCK_SIZE) |
3149 { | 3149 { |
4483 #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS | 4483 #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS |
4484 check_gcpros (); | 4484 check_gcpros (); |
4485 #endif | 4485 #endif |
4486 } | 4486 } |
4487 | 4487 |
4488 | |
4489 #endif /* GC_MARK_STACK != 0 */ | 4488 #endif /* GC_MARK_STACK != 0 */ |
4489 | |
4490 | |
4491 | |
4492 /* Return 1 if OBJ is a valid lisp object. | |
4493 Return 0 if OBJ is NOT a valid lisp object. | |
4494 Return -1 if we cannot validate OBJ. | |
4495 */ | |
4496 | |
4497 int | |
4498 valid_lisp_object_p (obj) | |
4499 Lisp_Object obj; | |
4500 { | |
4501 #if !GC_MARK_STACK | |
4502 /* Cannot determine this. */ | |
4503 return -1; | |
4504 #else | |
4505 void *p; | |
4506 struct mem_node *m; | |
4507 | |
4508 if (INTEGERP (obj)) | |
4509 return 1; | |
4510 | |
4511 p = (void *) XPNTR (obj); | |
4512 | |
4513 if (PURE_POINTER_P (p)) | |
4514 return 1; | |
4515 | |
4516 m = mem_find (p); | |
4517 | |
4518 if (m == MEM_NIL) | |
4519 return 0; | |
4520 | |
4521 switch (m->type) | |
4522 { | |
4523 case MEM_TYPE_NON_LISP: | |
4524 return 0; | |
4525 | |
4526 case MEM_TYPE_BUFFER: | |
4527 return live_buffer_p (m, p); | |
4528 | |
4529 case MEM_TYPE_CONS: | |
4530 return live_cons_p (m, p); | |
4531 | |
4532 case MEM_TYPE_STRING: | |
4533 return live_string_p (m, p); | |
4534 | |
4535 case MEM_TYPE_MISC: | |
4536 return live_misc_p (m, p); | |
4537 | |
4538 case MEM_TYPE_SYMBOL: | |
4539 return live_symbol_p (m, p); | |
4540 | |
4541 case MEM_TYPE_FLOAT: | |
4542 return live_float_p (m, p); | |
4543 | |
4544 case MEM_TYPE_VECTOR: | |
4545 case MEM_TYPE_PROCESS: | |
4546 case MEM_TYPE_HASH_TABLE: | |
4547 case MEM_TYPE_FRAME: | |
4548 case MEM_TYPE_WINDOW: | |
4549 return live_vector_p (m, p); | |
4550 | |
4551 default: | |
4552 break; | |
4553 } | |
4554 | |
4555 return 0; | |
4556 #endif | |
4557 } | |
4558 | |
4490 | 4559 |
4491 | 4560 |
4492 | 4561 |
4493 /*********************************************************************** | 4562 /*********************************************************************** |
4494 Pure Storage Management | 4563 Pure Storage Management |
4967 total += total_string_size; | 5036 total += total_string_size; |
4968 total += total_vector_size * sizeof (Lisp_Object); | 5037 total += total_vector_size * sizeof (Lisp_Object); |
4969 total += total_floats * sizeof (struct Lisp_Float); | 5038 total += total_floats * sizeof (struct Lisp_Float); |
4970 total += total_intervals * sizeof (struct interval); | 5039 total += total_intervals * sizeof (struct interval); |
4971 total += total_strings * sizeof (struct Lisp_String); | 5040 total += total_strings * sizeof (struct Lisp_String); |
4972 | 5041 |
4973 gc_relative_threshold = total * XFLOAT_DATA (Vgc_cons_percentage); | 5042 gc_relative_threshold = total * XFLOAT_DATA (Vgc_cons_percentage); |
4974 } | 5043 } |
4975 else | 5044 else |
4976 gc_relative_threshold = 0; | 5045 gc_relative_threshold = 0; |
4977 | 5046 |
5494 register struct Lisp_Cons *ptr = XCONS (obj); | 5563 register struct Lisp_Cons *ptr = XCONS (obj); |
5495 if (CONS_MARKED_P (ptr)) break; | 5564 if (CONS_MARKED_P (ptr)) break; |
5496 CHECK_ALLOCATED_AND_LIVE (live_cons_p); | 5565 CHECK_ALLOCATED_AND_LIVE (live_cons_p); |
5497 CONS_MARK (ptr); | 5566 CONS_MARK (ptr); |
5498 /* If the cdr is nil, avoid recursion for the car. */ | 5567 /* If the cdr is nil, avoid recursion for the car. */ |
5499 if (EQ (ptr->cdr, Qnil)) | 5568 if (EQ (ptr->u.cdr, Qnil)) |
5500 { | 5569 { |
5501 obj = ptr->car; | 5570 obj = ptr->car; |
5502 cdr_count = 0; | 5571 cdr_count = 0; |
5503 goto loop; | 5572 goto loop; |
5504 } | 5573 } |
5505 mark_object (ptr->car); | 5574 mark_object (ptr->car); |
5506 obj = ptr->cdr; | 5575 obj = ptr->u.cdr; |
5507 cdr_count++; | 5576 cdr_count++; |
5508 if (cdr_count == mark_object_loop_halt) | 5577 if (cdr_count == mark_object_loop_halt) |
5509 abort (); | 5578 abort (); |
5510 goto loop; | 5579 goto loop; |
5511 } | 5580 } |
5648 int this_free = 0; | 5717 int this_free = 0; |
5649 for (i = 0; i < lim; i++) | 5718 for (i = 0; i < lim; i++) |
5650 if (!CONS_MARKED_P (&cblk->conses[i])) | 5719 if (!CONS_MARKED_P (&cblk->conses[i])) |
5651 { | 5720 { |
5652 this_free++; | 5721 this_free++; |
5653 *(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list; | 5722 cblk->conses[i].u.chain = cons_free_list; |
5654 cons_free_list = &cblk->conses[i]; | 5723 cons_free_list = &cblk->conses[i]; |
5655 #if GC_MARK_STACK | 5724 #if GC_MARK_STACK |
5656 cons_free_list->car = Vdead; | 5725 cons_free_list->car = Vdead; |
5657 #endif | 5726 #endif |
5658 } | 5727 } |
5667 this block. */ | 5736 this block. */ |
5668 if (this_free == CONS_BLOCK_SIZE && num_free > CONS_BLOCK_SIZE) | 5737 if (this_free == CONS_BLOCK_SIZE && num_free > CONS_BLOCK_SIZE) |
5669 { | 5738 { |
5670 *cprev = cblk->next; | 5739 *cprev = cblk->next; |
5671 /* Unhook from the free list. */ | 5740 /* Unhook from the free list. */ |
5672 cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr; | 5741 cons_free_list = cblk->conses[0].u.chain; |
5673 lisp_align_free (cblk); | 5742 lisp_align_free (cblk); |
5674 n_cons_blocks--; | 5743 n_cons_blocks--; |
5675 } | 5744 } |
5676 else | 5745 else |
5677 { | 5746 { |
5698 int this_free = 0; | 5767 int this_free = 0; |
5699 for (i = 0; i < lim; i++) | 5768 for (i = 0; i < lim; i++) |
5700 if (!FLOAT_MARKED_P (&fblk->floats[i])) | 5769 if (!FLOAT_MARKED_P (&fblk->floats[i])) |
5701 { | 5770 { |
5702 this_free++; | 5771 this_free++; |
5703 *(struct Lisp_Float **)&fblk->floats[i].data = float_free_list; | 5772 fblk->floats[i].u.chain = float_free_list; |
5704 float_free_list = &fblk->floats[i]; | 5773 float_free_list = &fblk->floats[i]; |
5705 } | 5774 } |
5706 else | 5775 else |
5707 { | 5776 { |
5708 num_used++; | 5777 num_used++; |
5714 this block. */ | 5783 this block. */ |
5715 if (this_free == FLOAT_BLOCK_SIZE && num_free > FLOAT_BLOCK_SIZE) | 5784 if (this_free == FLOAT_BLOCK_SIZE && num_free > FLOAT_BLOCK_SIZE) |
5716 { | 5785 { |
5717 *fprev = fblk->next; | 5786 *fprev = fblk->next; |
5718 /* Unhook from the free list. */ | 5787 /* Unhook from the free list. */ |
5719 float_free_list = *(struct Lisp_Float **) &fblk->floats[0].data; | 5788 float_free_list = fblk->floats[0].u.chain; |
5720 lisp_align_free (fblk); | 5789 lisp_align_free (fblk); |
5721 n_float_blocks--; | 5790 n_float_blocks--; |
5722 } | 5791 } |
5723 else | 5792 else |
5724 { | 5793 { |
5802 so we conservatively assume that it is live. */ | 5871 so we conservatively assume that it is live. */ |
5803 int pure_p = PURE_POINTER_P (XSTRING (sym->xname)); | 5872 int pure_p = PURE_POINTER_P (XSTRING (sym->xname)); |
5804 | 5873 |
5805 if (!sym->gcmarkbit && !pure_p) | 5874 if (!sym->gcmarkbit && !pure_p) |
5806 { | 5875 { |
5807 *(struct Lisp_Symbol **) &sym->value = symbol_free_list; | 5876 sym->next = symbol_free_list; |
5808 symbol_free_list = sym; | 5877 symbol_free_list = sym; |
5809 #if GC_MARK_STACK | 5878 #if GC_MARK_STACK |
5810 symbol_free_list->function = Vdead; | 5879 symbol_free_list->function = Vdead; |
5811 #endif | 5880 #endif |
5812 ++this_free; | 5881 ++this_free; |
5826 this block. */ | 5895 this block. */ |
5827 if (this_free == SYMBOL_BLOCK_SIZE && num_free > SYMBOL_BLOCK_SIZE) | 5896 if (this_free == SYMBOL_BLOCK_SIZE && num_free > SYMBOL_BLOCK_SIZE) |
5828 { | 5897 { |
5829 *sprev = sblk->next; | 5898 *sprev = sblk->next; |
5830 /* Unhook from the free list. */ | 5899 /* Unhook from the free list. */ |
5831 symbol_free_list = *(struct Lisp_Symbol **)&sblk->symbols[0].value; | 5900 symbol_free_list = sblk->symbols[0].next; |
5832 lisp_free (sblk); | 5901 lisp_free (sblk); |
5833 n_symbol_blocks--; | 5902 n_symbol_blocks--; |
5834 } | 5903 } |
5835 else | 5904 else |
5836 { | 5905 { |