diff options
Diffstat (limited to 'src/alloc.c')
| -rw-r--r-- | src/alloc.c | 274 |
1 files changed, 133 insertions, 141 deletions
diff --git a/src/alloc.c b/src/alloc.c index 2d5149a6772..1d484d4a322 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -19,6 +19,9 @@ You should have received a copy of the GNU General Public License | |||
| 19 | along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ | 19 | along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 20 | 20 | ||
| 21 | #include <config.h> | 21 | #include <config.h> |
| 22 | |||
| 23 | #define LISP_INLINE EXTERN_INLINE | ||
| 24 | |||
| 22 | #include <stdio.h> | 25 | #include <stdio.h> |
| 23 | #include <limits.h> /* For CHAR_BIT. */ | 26 | #include <limits.h> /* For CHAR_BIT. */ |
| 24 | #include <setjmp.h> | 27 | #include <setjmp.h> |
| @@ -152,7 +155,7 @@ static pthread_mutex_t alloc_mutex; | |||
| 152 | 155 | ||
| 153 | /* Default value of gc_cons_threshold (see below). */ | 156 | /* Default value of gc_cons_threshold (see below). */ |
| 154 | 157 | ||
| 155 | #define GC_DEFAULT_THRESHOLD (100000 * sizeof (Lisp_Object)) | 158 | #define GC_DEFAULT_THRESHOLD (100000 * word_size) |
| 156 | 159 | ||
| 157 | /* Global variables. */ | 160 | /* Global variables. */ |
| 158 | struct emacs_globals globals; | 161 | struct emacs_globals globals; |
| @@ -225,7 +228,7 @@ static ptrdiff_t pure_bytes_used_before_overflow; | |||
| 225 | #define PURE_POINTER_P(P) \ | 228 | #define PURE_POINTER_P(P) \ |
| 226 | ((uintptr_t) (P) - (uintptr_t) purebeg <= pure_size) | 229 | ((uintptr_t) (P) - (uintptr_t) purebeg <= pure_size) |
| 227 | 230 | ||
| 228 | /* Index in pure at which next pure Lisp object will be allocated.. */ | 231 | /* Index in pure at which next pure Lisp object will be allocated.. */ |
| 229 | 232 | ||
| 230 | static ptrdiff_t pure_bytes_used_lisp; | 233 | static ptrdiff_t pure_bytes_used_lisp; |
| 231 | 234 | ||
| @@ -251,6 +254,14 @@ static char *stack_copy; | |||
| 251 | static ptrdiff_t stack_copy_size; | 254 | static ptrdiff_t stack_copy_size; |
| 252 | #endif | 255 | #endif |
| 253 | 256 | ||
| 257 | static Lisp_Object Qconses; | ||
| 258 | static Lisp_Object Qsymbols; | ||
| 259 | static Lisp_Object Qmiscs; | ||
| 260 | static Lisp_Object Qstrings; | ||
| 261 | static Lisp_Object Qvectors; | ||
| 262 | static Lisp_Object Qfloats; | ||
| 263 | static Lisp_Object Qintervals; | ||
| 264 | static Lisp_Object Qbuffers; | ||
| 254 | static Lisp_Object Qstring_bytes, Qvector_slots, Qheap; | 265 | static Lisp_Object Qstring_bytes, Qvector_slots, Qheap; |
| 255 | static Lisp_Object Qgc_cons_threshold; | 266 | static Lisp_Object Qgc_cons_threshold; |
| 256 | Lisp_Object Qchar_table_extra_slots; | 267 | Lisp_Object Qchar_table_extra_slots; |
| @@ -275,14 +286,6 @@ static void sweep_strings (void); | |||
| 275 | static void free_misc (Lisp_Object); | 286 | static void free_misc (Lisp_Object); |
| 276 | extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE; | 287 | extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE; |
| 277 | 288 | ||
| 278 | /* Handy constants for vectorlike objects. */ | ||
| 279 | enum | ||
| 280 | { | ||
| 281 | header_size = offsetof (struct Lisp_Vector, contents), | ||
| 282 | bool_header_size = offsetof (struct Lisp_Bool_Vector, data), | ||
| 283 | word_size = sizeof (Lisp_Object) | ||
| 284 | }; | ||
| 285 | |||
| 286 | /* When scanning the C stack for live Lisp objects, Emacs keeps track | 289 | /* When scanning the C stack for live Lisp objects, Emacs keeps track |
| 287 | of what memory allocated via lisp_malloc is intended for what | 290 | of what memory allocated via lisp_malloc is intended for what |
| 288 | purpose. This enumeration specifies the type of memory. */ | 291 | purpose. This enumeration specifies the type of memory. */ |
| @@ -526,7 +529,7 @@ buffer_memory_full (ptrdiff_t nbytes) | |||
| 526 | 529 | ||
| 527 | #if USE_LSB_TAG | 530 | #if USE_LSB_TAG |
| 528 | # define XMALLOC_HEADER_ALIGNMENT \ | 531 | # define XMALLOC_HEADER_ALIGNMENT \ |
| 529 | COMMON_MULTIPLE (1 << GCTYPEBITS, XMALLOC_BASE_ALIGNMENT) | 532 | COMMON_MULTIPLE (GCALIGNMENT, XMALLOC_BASE_ALIGNMENT) |
| 530 | #else | 533 | #else |
| 531 | # define XMALLOC_HEADER_ALIGNMENT XMALLOC_BASE_ALIGNMENT | 534 | # define XMALLOC_HEADER_ALIGNMENT XMALLOC_BASE_ALIGNMENT |
| 532 | #endif | 535 | #endif |
| @@ -895,6 +898,16 @@ safe_alloca_unwind (Lisp_Object arg) | |||
| 895 | return Qnil; | 898 | return Qnil; |
| 896 | } | 899 | } |
| 897 | 900 | ||
| 901 | /* Return a newly allocated memory block of SIZE bytes, remembering | ||
| 902 | to free it when unwinding. */ | ||
| 903 | void * | ||
| 904 | record_xmalloc (size_t size) | ||
| 905 | { | ||
| 906 | void *p = xmalloc (size); | ||
| 907 | record_unwind_protect (safe_alloca_unwind, make_save_value (p, 0)); | ||
| 908 | return p; | ||
| 909 | } | ||
| 910 | |||
| 898 | 911 | ||
| 899 | /* Like malloc but used for allocating Lisp data. NBYTES is the | 912 | /* Like malloc but used for allocating Lisp data. NBYTES is the |
| 900 | number of bytes to allocate, TYPE describes the intended use of the | 913 | number of bytes to allocate, TYPE describes the intended use of the |
| @@ -1537,36 +1550,14 @@ mark_interval (register INTERVAL i, Lisp_Object dummy) | |||
| 1537 | mark_object (i->plist); | 1550 | mark_object (i->plist); |
| 1538 | } | 1551 | } |
| 1539 | 1552 | ||
| 1540 | |||
| 1541 | /* Mark the interval tree rooted in TREE. Don't call this directly; | ||
| 1542 | use the macro MARK_INTERVAL_TREE instead. */ | ||
| 1543 | |||
| 1544 | static void | ||
| 1545 | mark_interval_tree (register INTERVAL tree) | ||
| 1546 | { | ||
| 1547 | /* No need to test if this tree has been marked already; this | ||
| 1548 | function is always called through the MARK_INTERVAL_TREE macro, | ||
| 1549 | which takes care of that. */ | ||
| 1550 | |||
| 1551 | traverse_intervals_noorder (tree, mark_interval, Qnil); | ||
| 1552 | } | ||
| 1553 | |||
| 1554 | |||
| 1555 | /* Mark the interval tree rooted in I. */ | 1553 | /* Mark the interval tree rooted in I. */ |
| 1556 | 1554 | ||
| 1557 | #define MARK_INTERVAL_TREE(i) \ | 1555 | #define MARK_INTERVAL_TREE(i) \ |
| 1558 | do { \ | 1556 | do { \ |
| 1559 | if (!NULL_INTERVAL_P (i) && !i->gcmarkbit) \ | 1557 | if (i && !i->gcmarkbit) \ |
| 1560 | mark_interval_tree (i); \ | 1558 | traverse_intervals_noorder (i, mark_interval, Qnil); \ |
| 1561 | } while (0) | 1559 | } while (0) |
| 1562 | 1560 | ||
| 1563 | |||
| 1564 | #define UNMARK_BALANCE_INTERVALS(i) \ | ||
| 1565 | do { \ | ||
| 1566 | if (! NULL_INTERVAL_P (i)) \ | ||
| 1567 | (i) = balance_intervals (i); \ | ||
| 1568 | } while (0) | ||
| 1569 | |||
| 1570 | /*********************************************************************** | 1561 | /*********************************************************************** |
| 1571 | String Allocation | 1562 | String Allocation |
| 1572 | ***********************************************************************/ | 1563 | ***********************************************************************/ |
| @@ -2095,8 +2086,8 @@ sweep_strings (void) | |||
| 2095 | /* String is live; unmark it and its intervals. */ | 2086 | /* String is live; unmark it and its intervals. */ |
| 2096 | UNMARK_STRING (s); | 2087 | UNMARK_STRING (s); |
| 2097 | 2088 | ||
| 2098 | if (!NULL_INTERVAL_P (s->intervals)) | 2089 | /* Do not use string_(set|get)_intervals here. */ |
| 2099 | UNMARK_BALANCE_INTERVALS (s->intervals); | 2090 | s->intervals = balance_intervals (s->intervals); |
| 2100 | 2091 | ||
| 2101 | ++total_strings; | 2092 | ++total_strings; |
| 2102 | total_string_bytes += STRING_BYTES (s); | 2093 | total_string_bytes += STRING_BYTES (s); |
| @@ -2497,7 +2488,7 @@ make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes) | |||
| 2497 | return empty_multibyte_string; | 2488 | return empty_multibyte_string; |
| 2498 | 2489 | ||
| 2499 | s = allocate_string (); | 2490 | s = allocate_string (); |
| 2500 | s->intervals = NULL_INTERVAL; | 2491 | s->intervals = NULL; |
| 2501 | allocate_string_data (s, nchars, nbytes); | 2492 | allocate_string_data (s, nchars, nbytes); |
| 2502 | XSETSTRING (string, s); | 2493 | XSETSTRING (string, s); |
| 2503 | string_chars_consed += nbytes; | 2494 | string_chars_consed += nbytes; |
| @@ -2686,7 +2677,7 @@ free_cons (struct Lisp_Cons *ptr) | |||
| 2686 | { | 2677 | { |
| 2687 | ptr->u.chain = cons_free_list; | 2678 | ptr->u.chain = cons_free_list; |
| 2688 | #if GC_MARK_STACK | 2679 | #if GC_MARK_STACK |
| 2689 | CVAR (ptr, car) = Vdead; | 2680 | ptr->car = Vdead; |
| 2690 | #endif | 2681 | #endif |
| 2691 | cons_free_list = ptr; | 2682 | cons_free_list = ptr; |
| 2692 | consing_since_gc -= sizeof *ptr; | 2683 | consing_since_gc -= sizeof *ptr; |
| @@ -2797,9 +2788,9 @@ listn (enum constype type, ptrdiff_t count, Lisp_Object arg, ...) | |||
| 2797 | Lisp_Object val, *objp; | 2788 | Lisp_Object val, *objp; |
| 2798 | 2789 | ||
| 2799 | /* Change to SAFE_ALLOCA if you hit this eassert. */ | 2790 | /* Change to SAFE_ALLOCA if you hit this eassert. */ |
| 2800 | eassert (count <= MAX_ALLOCA / sizeof (Lisp_Object)); | 2791 | eassert (count <= MAX_ALLOCA / word_size); |
| 2801 | 2792 | ||
| 2802 | objp = alloca (count * sizeof (Lisp_Object)); | 2793 | objp = alloca (count * word_size); |
| 2803 | objp[0] = arg; | 2794 | objp[0] = arg; |
| 2804 | va_start (ap, arg); | 2795 | va_start (ap, arg); |
| 2805 | for (i = 1; i < count; i++) | 2796 | for (i = 1; i < count; i++) |
| @@ -2897,8 +2888,7 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, | |||
| 2897 | /* Align allocation request sizes to be a multiple of ROUNDUP_SIZE. */ | 2888 | /* Align allocation request sizes to be a multiple of ROUNDUP_SIZE. */ |
| 2898 | enum | 2889 | enum |
| 2899 | { | 2890 | { |
| 2900 | roundup_size = COMMON_MULTIPLE (word_size, | 2891 | roundup_size = COMMON_MULTIPLE (word_size, USE_LSB_TAG ? GCALIGNMENT : 1) |
| 2901 | USE_LSB_TAG ? 1 << GCTYPEBITS : 1) | ||
| 2902 | }; | 2892 | }; |
| 2903 | 2893 | ||
| 2904 | /* ROUNDUP_SIZE must be a power of 2. */ | 2894 | /* ROUNDUP_SIZE must be a power of 2. */ |
| @@ -3452,8 +3442,8 @@ union aligned_Lisp_Symbol | |||
| 3452 | { | 3442 | { |
| 3453 | struct Lisp_Symbol s; | 3443 | struct Lisp_Symbol s; |
| 3454 | #if USE_LSB_TAG | 3444 | #if USE_LSB_TAG |
| 3455 | unsigned char c[(sizeof (struct Lisp_Symbol) + (1 << GCTYPEBITS) - 1) | 3445 | unsigned char c[(sizeof (struct Lisp_Symbol) + GCALIGNMENT - 1) |
| 3456 | & -(1 << GCTYPEBITS)]; | 3446 | & -GCALIGNMENT]; |
| 3457 | #endif | 3447 | #endif |
| 3458 | }; | 3448 | }; |
| 3459 | 3449 | ||
| @@ -3518,12 +3508,12 @@ Its value and function definition are void, and its property list is nil. */) | |||
| 3518 | MALLOC_UNBLOCK_INPUT; | 3508 | MALLOC_UNBLOCK_INPUT; |
| 3519 | 3509 | ||
| 3520 | p = XSYMBOL (val); | 3510 | p = XSYMBOL (val); |
| 3521 | SVAR (p, xname) = name; | 3511 | set_symbol_name (val, name); |
| 3522 | SVAR (p, plist) = Qnil; | 3512 | set_symbol_plist (val, Qnil); |
| 3523 | p->redirect = SYMBOL_PLAINVAL; | 3513 | p->redirect = SYMBOL_PLAINVAL; |
| 3524 | SET_SYMBOL_VAL (p, Qunbound); | 3514 | SET_SYMBOL_VAL (p, Qunbound); |
| 3525 | SVAR (p, function) = Qunbound; | 3515 | set_symbol_function (val, Qunbound); |
| 3526 | p->next = NULL; | 3516 | set_symbol_next (val, NULL); |
| 3527 | p->gcmarkbit = 0; | 3517 | p->gcmarkbit = 0; |
| 3528 | p->interned = SYMBOL_UNINTERNED; | 3518 | p->interned = SYMBOL_UNINTERNED; |
| 3529 | p->constant = 0; | 3519 | p->constant = 0; |
| @@ -3547,8 +3537,8 @@ union aligned_Lisp_Misc | |||
| 3547 | { | 3537 | { |
| 3548 | union Lisp_Misc m; | 3538 | union Lisp_Misc m; |
| 3549 | #if USE_LSB_TAG | 3539 | #if USE_LSB_TAG |
| 3550 | unsigned char c[(sizeof (union Lisp_Misc) + (1 << GCTYPEBITS) - 1) | 3540 | unsigned char c[(sizeof (union Lisp_Misc) + GCALIGNMENT - 1) |
| 3551 | & -(1 << GCTYPEBITS)]; | 3541 | & -GCALIGNMENT]; |
| 3552 | #endif | 3542 | #endif |
| 3553 | }; | 3543 | }; |
| 3554 | 3544 | ||
| @@ -3650,7 +3640,7 @@ build_overlay (Lisp_Object start, Lisp_Object end, Lisp_Object plist) | |||
| 3650 | overlay = allocate_misc (Lisp_Misc_Overlay); | 3640 | overlay = allocate_misc (Lisp_Misc_Overlay); |
| 3651 | OVERLAY_START (overlay) = start; | 3641 | OVERLAY_START (overlay) = start; |
| 3652 | OVERLAY_END (overlay) = end; | 3642 | OVERLAY_END (overlay) = end; |
| 3653 | OVERLAY_PLIST (overlay) = plist; | 3643 | set_overlay_plist (overlay, plist); |
| 3654 | XOVERLAY (overlay)->next = NULL; | 3644 | XOVERLAY (overlay)->next = NULL; |
| 3655 | return overlay; | 3645 | return overlay; |
| 3656 | } | 3646 | } |
| @@ -4295,7 +4285,7 @@ live_cons_p (struct mem_node *m, void *p) | |||
| 4295 | && offset < (CONS_BLOCK_SIZE * sizeof b->conses[0]) | 4285 | && offset < (CONS_BLOCK_SIZE * sizeof b->conses[0]) |
| 4296 | && (b != cons_block | 4286 | && (b != cons_block |
| 4297 | || offset / sizeof b->conses[0] < cons_block_index) | 4287 | || offset / sizeof b->conses[0] < cons_block_index) |
| 4298 | && !EQ (CVAR ((struct Lisp_Cons *) p, car), Vdead)); | 4288 | && !EQ (((struct Lisp_Cons *) p)->car, Vdead)); |
| 4299 | } | 4289 | } |
| 4300 | else | 4290 | else |
| 4301 | return 0; | 4291 | return 0; |
| @@ -4321,7 +4311,7 @@ live_symbol_p (struct mem_node *m, void *p) | |||
| 4321 | && offset < (SYMBOL_BLOCK_SIZE * sizeof b->symbols[0]) | 4311 | && offset < (SYMBOL_BLOCK_SIZE * sizeof b->symbols[0]) |
| 4322 | && (b != symbol_block | 4312 | && (b != symbol_block |
| 4323 | || offset / sizeof b->symbols[0] < symbol_block_index) | 4313 | || offset / sizeof b->symbols[0] < symbol_block_index) |
| 4324 | && !EQ (SVAR (((struct Lisp_Symbol *)p), function), Vdead)); | 4314 | && !EQ (((struct Lisp_Symbol *)p)->function, Vdead)); |
| 4325 | } | 4315 | } |
| 4326 | else | 4316 | else |
| 4327 | return 0; | 4317 | return 0; |
| @@ -4558,9 +4548,9 @@ mark_maybe_pointer (void *p) | |||
| 4558 | struct mem_node *m; | 4548 | struct mem_node *m; |
| 4559 | 4549 | ||
| 4560 | /* Quickly rule out some values which can't point to Lisp data. | 4550 | /* Quickly rule out some values which can't point to Lisp data. |
| 4561 | USE_LSB_TAG needs Lisp data to be aligned on multiples of 1 << GCTYPEBITS. | 4551 | USE_LSB_TAG needs Lisp data to be aligned on multiples of GCALIGNMENT. |
| 4562 | Otherwise, assume that Lisp data is aligned on even addresses. */ | 4552 | Otherwise, assume that Lisp data is aligned on even addresses. */ |
| 4563 | if ((intptr_t) p % (USE_LSB_TAG ? 1 << GCTYPEBITS : 2)) | 4553 | if ((intptr_t) p % (USE_LSB_TAG ? GCALIGNMENT : 2)) |
| 4564 | return; | 4554 | return; |
| 4565 | 4555 | ||
| 4566 | m = mem_find (p); | 4556 | m = mem_find (p); |
| @@ -5075,7 +5065,7 @@ pure_alloc (size_t size, int type) | |||
| 5075 | { | 5065 | { |
| 5076 | void *result; | 5066 | void *result; |
| 5077 | #if USE_LSB_TAG | 5067 | #if USE_LSB_TAG |
| 5078 | size_t alignment = (1 << GCTYPEBITS); | 5068 | size_t alignment = GCALIGNMENT; |
| 5079 | #else | 5069 | #else |
| 5080 | size_t alignment = alignof (EMACS_INT); | 5070 | size_t alignment = alignof (EMACS_INT); |
| 5081 | 5071 | ||
| @@ -5207,19 +5197,17 @@ make_pure_string (const char *data, | |||
| 5207 | ptrdiff_t nchars, ptrdiff_t nbytes, int multibyte) | 5197 | ptrdiff_t nchars, ptrdiff_t nbytes, int multibyte) |
| 5208 | { | 5198 | { |
| 5209 | Lisp_Object string; | 5199 | Lisp_Object string; |
| 5210 | struct Lisp_String *s; | 5200 | struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String); |
| 5211 | |||
| 5212 | s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String); | ||
| 5213 | s->data = (unsigned char *) find_string_data_in_pure (data, nbytes); | 5201 | s->data = (unsigned char *) find_string_data_in_pure (data, nbytes); |
| 5214 | if (s->data == NULL) | 5202 | if (s->data == NULL) |
| 5215 | { | 5203 | { |
| 5216 | s->data = (unsigned char *) pure_alloc (nbytes + 1, -1); | 5204 | s->data = pure_alloc (nbytes + 1, -1); |
| 5217 | memcpy (s->data, data, nbytes); | 5205 | memcpy (s->data, data, nbytes); |
| 5218 | s->data[nbytes] = '\0'; | 5206 | s->data[nbytes] = '\0'; |
| 5219 | } | 5207 | } |
| 5220 | s->size = nchars; | 5208 | s->size = nchars; |
| 5221 | s->size_byte = multibyte ? nbytes : -1; | 5209 | s->size_byte = multibyte ? nbytes : -1; |
| 5222 | s->intervals = NULL_INTERVAL; | 5210 | s->intervals = NULL; |
| 5223 | XSETSTRING (string, s); | 5211 | XSETSTRING (string, s); |
| 5224 | return string; | 5212 | return string; |
| 5225 | } | 5213 | } |
| @@ -5231,13 +5219,11 @@ Lisp_Object | |||
| 5231 | make_pure_c_string (const char *data, ptrdiff_t nchars) | 5219 | make_pure_c_string (const char *data, ptrdiff_t nchars) |
| 5232 | { | 5220 | { |
| 5233 | Lisp_Object string; | 5221 | Lisp_Object string; |
| 5234 | struct Lisp_String *s; | 5222 | struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String); |
| 5235 | |||
| 5236 | s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String); | ||
| 5237 | s->size = nchars; | 5223 | s->size = nchars; |
| 5238 | s->size_byte = -1; | 5224 | s->size_byte = -1; |
| 5239 | s->data = (unsigned char *) data; | 5225 | s->data = (unsigned char *) data; |
| 5240 | s->intervals = NULL_INTERVAL; | 5226 | s->intervals = NULL; |
| 5241 | XSETSTRING (string, s); | 5227 | XSETSTRING (string, s); |
| 5242 | return string; | 5228 | return string; |
| 5243 | } | 5229 | } |
| @@ -5248,10 +5234,8 @@ make_pure_c_string (const char *data, ptrdiff_t nchars) | |||
| 5248 | Lisp_Object | 5234 | Lisp_Object |
| 5249 | pure_cons (Lisp_Object car, Lisp_Object cdr) | 5235 | pure_cons (Lisp_Object car, Lisp_Object cdr) |
| 5250 | { | 5236 | { |
| 5251 | register Lisp_Object new; | 5237 | Lisp_Object new; |
| 5252 | struct Lisp_Cons *p; | 5238 | struct Lisp_Cons *p = pure_alloc (sizeof *p, Lisp_Cons); |
| 5253 | |||
| 5254 | p = (struct Lisp_Cons *) pure_alloc (sizeof *p, Lisp_Cons); | ||
| 5255 | XSETCONS (new, p); | 5239 | XSETCONS (new, p); |
| 5256 | XSETCAR (new, Fpurecopy (car)); | 5240 | XSETCAR (new, Fpurecopy (car)); |
| 5257 | XSETCDR (new, Fpurecopy (cdr)); | 5241 | XSETCDR (new, Fpurecopy (cdr)); |
| @@ -5264,10 +5248,8 @@ pure_cons (Lisp_Object car, Lisp_Object cdr) | |||
| 5264 | static Lisp_Object | 5248 | static Lisp_Object |
| 5265 | make_pure_float (double num) | 5249 | make_pure_float (double num) |
| 5266 | { | 5250 | { |
| 5267 | register Lisp_Object new; | 5251 | Lisp_Object new; |
| 5268 | struct Lisp_Float *p; | 5252 | struct Lisp_Float *p = pure_alloc (sizeof *p, Lisp_Float); |
| 5269 | |||
| 5270 | p = (struct Lisp_Float *) pure_alloc (sizeof *p, Lisp_Float); | ||
| 5271 | XSETFLOAT (new, p); | 5253 | XSETFLOAT (new, p); |
| 5272 | XFLOAT_INIT (new, num); | 5254 | XFLOAT_INIT (new, num); |
| 5273 | return new; | 5255 | return new; |
| @@ -5281,10 +5263,8 @@ static Lisp_Object | |||
| 5281 | make_pure_vector (ptrdiff_t len) | 5263 | make_pure_vector (ptrdiff_t len) |
| 5282 | { | 5264 | { |
| 5283 | Lisp_Object new; | 5265 | Lisp_Object new; |
| 5284 | struct Lisp_Vector *p; | ||
| 5285 | size_t size = header_size + len * word_size; | 5266 | size_t size = header_size + len * word_size; |
| 5286 | 5267 | struct Lisp_Vector *p = pure_alloc (size, Lisp_Vectorlike); | |
| 5287 | p = (struct Lisp_Vector *) pure_alloc (size, Lisp_Vectorlike); | ||
| 5288 | XSETVECTOR (new, p); | 5268 | XSETVECTOR (new, p); |
| 5289 | XVECTOR (new)->header.size = len; | 5269 | XVECTOR (new)->header.size = len; |
| 5290 | return new; | 5270 | return new; |
| @@ -5414,9 +5394,9 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5414 | char stack_top_variable; | 5394 | char stack_top_variable; |
| 5415 | ptrdiff_t i; | 5395 | ptrdiff_t i; |
| 5416 | int message_p; | 5396 | int message_p; |
| 5417 | Lisp_Object total[11]; | ||
| 5418 | ptrdiff_t count = SPECPDL_INDEX (); | 5397 | ptrdiff_t count = SPECPDL_INDEX (); |
| 5419 | EMACS_TIME start; | 5398 | EMACS_TIME start; |
| 5399 | Lisp_Object retval = Qnil; | ||
| 5420 | 5400 | ||
| 5421 | if (abort_on_gc) | 5401 | if (abort_on_gc) |
| 5422 | abort (); | 5402 | abort (); |
| @@ -5635,59 +5615,62 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5635 | } | 5615 | } |
| 5636 | 5616 | ||
| 5637 | unbind_to (count, Qnil); | 5617 | unbind_to (count, Qnil); |
| 5618 | { | ||
| 5619 | Lisp_Object total[11]; | ||
| 5620 | int total_size = 10; | ||
| 5638 | 5621 | ||
| 5639 | total[0] = list4 (Qcons, make_number (sizeof (struct Lisp_Cons)), | 5622 | total[0] = list4 (Qconses, make_number (sizeof (struct Lisp_Cons)), |
| 5640 | bounded_number (total_conses), | 5623 | bounded_number (total_conses), |
| 5641 | bounded_number (total_free_conses)); | 5624 | bounded_number (total_free_conses)); |
| 5642 | 5625 | ||
| 5643 | total[1] = list4 (Qsymbol, make_number (sizeof (struct Lisp_Symbol)), | 5626 | total[1] = list4 (Qsymbols, make_number (sizeof (struct Lisp_Symbol)), |
| 5644 | bounded_number (total_symbols), | 5627 | bounded_number (total_symbols), |
| 5645 | bounded_number (total_free_symbols)); | 5628 | bounded_number (total_free_symbols)); |
| 5646 | 5629 | ||
| 5647 | total[2] = list4 (Qmisc, make_number (sizeof (union Lisp_Misc)), | 5630 | total[2] = list4 (Qmiscs, make_number (sizeof (union Lisp_Misc)), |
| 5648 | bounded_number (total_markers), | 5631 | bounded_number (total_markers), |
| 5649 | bounded_number (total_free_markers)); | 5632 | bounded_number (total_free_markers)); |
| 5650 | 5633 | ||
| 5651 | total[3] = list4 (Qstring, make_number (sizeof (struct Lisp_String)), | 5634 | total[3] = list4 (Qstrings, make_number (sizeof (struct Lisp_String)), |
| 5652 | bounded_number (total_strings), | 5635 | bounded_number (total_strings), |
| 5653 | bounded_number (total_free_strings)); | 5636 | bounded_number (total_free_strings)); |
| 5654 | 5637 | ||
| 5655 | total[4] = list3 (Qstring_bytes, make_number (1), | 5638 | total[4] = list3 (Qstring_bytes, make_number (1), |
| 5656 | bounded_number (total_string_bytes)); | 5639 | bounded_number (total_string_bytes)); |
| 5657 | 5640 | ||
| 5658 | total[5] = list3 (Qvector, make_number (sizeof (struct Lisp_Vector)), | 5641 | total[5] = list3 (Qvectors, make_number (sizeof (struct Lisp_Vector)), |
| 5659 | bounded_number (total_vectors)); | 5642 | bounded_number (total_vectors)); |
| 5660 | 5643 | ||
| 5661 | total[6] = list4 (Qvector_slots, make_number (word_size), | 5644 | total[6] = list4 (Qvector_slots, make_number (word_size), |
| 5662 | bounded_number (total_vector_slots), | 5645 | bounded_number (total_vector_slots), |
| 5663 | bounded_number (total_free_vector_slots)); | 5646 | bounded_number (total_free_vector_slots)); |
| 5664 | 5647 | ||
| 5665 | total[7] = list4 (Qfloat, make_number (sizeof (struct Lisp_Float)), | 5648 | total[7] = list4 (Qfloats, make_number (sizeof (struct Lisp_Float)), |
| 5666 | bounded_number (total_floats), | 5649 | bounded_number (total_floats), |
| 5667 | bounded_number (total_free_floats)); | 5650 | bounded_number (total_free_floats)); |
| 5668 | 5651 | ||
| 5669 | total[8] = list4 (Qinterval, make_number (sizeof (struct interval)), | 5652 | total[8] = list4 (Qintervals, make_number (sizeof (struct interval)), |
| 5670 | bounded_number (total_intervals), | 5653 | bounded_number (total_intervals), |
| 5671 | bounded_number (total_free_intervals)); | 5654 | bounded_number (total_free_intervals)); |
| 5672 | 5655 | ||
| 5673 | total[9] = list3 (Qbuffer, make_number (sizeof (struct buffer)), | 5656 | total[9] = list3 (Qbuffers, make_number (sizeof (struct buffer)), |
| 5674 | bounded_number (total_buffers)); | 5657 | bounded_number (total_buffers)); |
| 5675 | 5658 | ||
| 5676 | total[10] = list4 (Qheap, make_number (1024), | ||
| 5677 | #ifdef DOUG_LEA_MALLOC | 5659 | #ifdef DOUG_LEA_MALLOC |
| 5678 | bounded_number ((mallinfo ().uordblks + 1023) >> 10), | 5660 | total_size++; |
| 5679 | bounded_number ((mallinfo ().fordblks + 1023) >> 10) | 5661 | total[10] = list4 (Qheap, make_number (1024), |
| 5680 | #else | 5662 | bounded_number ((mallinfo ().uordblks + 1023) >> 10), |
| 5681 | Qnil, Qnil | 5663 | bounded_number ((mallinfo ().fordblks + 1023) >> 10)); |
| 5682 | #endif | 5664 | #endif |
| 5683 | ); | 5665 | retval = Flist (total_size, total); |
| 5666 | } | ||
| 5684 | 5667 | ||
| 5685 | #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES | 5668 | #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES |
| 5686 | { | 5669 | { |
| 5687 | /* Compute average percentage of zombies. */ | 5670 | /* Compute average percentage of zombies. */ |
| 5688 | double nlive = | 5671 | double nlive |
| 5689 | (total_conses + total_symbols + total_markers + total_strings | 5672 | = (total_conses + total_symbols + total_markers + total_strings |
| 5690 | + total_vectors + total_floats + total_intervals + total_buffers); | 5673 | + total_vectors + total_floats + total_intervals + total_buffers); |
| 5691 | 5674 | ||
| 5692 | avg_live = (avg_live * ngcs + nlive) / (ngcs + 1); | 5675 | avg_live = (avg_live * ngcs + nlive) / (ngcs + 1); |
| 5693 | max_live = max (nlive, max_live); | 5676 | max_live = max (nlive, max_live); |
| @@ -5714,7 +5697,7 @@ See Info node `(elisp)Garbage Collection'. */) | |||
| 5714 | 5697 | ||
| 5715 | gcs_done++; | 5698 | gcs_done++; |
| 5716 | 5699 | ||
| 5717 | return Flist (sizeof total / sizeof *total, total); | 5700 | return retval; |
| 5718 | } | 5701 | } |
| 5719 | 5702 | ||
| 5720 | 5703 | ||
| @@ -5837,9 +5820,9 @@ mark_overlay (struct Lisp_Overlay *ptr) | |||
| 5837 | for (; ptr && !ptr->gcmarkbit; ptr = ptr->next) | 5820 | for (; ptr && !ptr->gcmarkbit; ptr = ptr->next) |
| 5838 | { | 5821 | { |
| 5839 | ptr->gcmarkbit = 1; | 5822 | ptr->gcmarkbit = 1; |
| 5840 | mark_object (MVAR (ptr, start)); | 5823 | mark_object (ptr->start); |
| 5841 | mark_object (MVAR (ptr, end)); | 5824 | mark_object (ptr->end); |
| 5842 | mark_object (MVAR (ptr, plist)); | 5825 | mark_object (ptr->plist); |
| 5843 | } | 5826 | } |
| 5844 | } | 5827 | } |
| 5845 | 5828 | ||
| @@ -5853,7 +5836,7 @@ mark_buffer (struct buffer *buffer) | |||
| 5853 | 5836 | ||
| 5854 | /* ...but there are some buffer-specific things. */ | 5837 | /* ...but there are some buffer-specific things. */ |
| 5855 | 5838 | ||
| 5856 | MARK_INTERVAL_TREE (BUF_INTERVALS (buffer)); | 5839 | MARK_INTERVAL_TREE (buffer_get_intervals (buffer)); |
| 5857 | 5840 | ||
| 5858 | /* For now, we just don't mark the undo_list. It's done later in | 5841 | /* For now, we just don't mark the undo_list. It's done later in |
| 5859 | a special way just before the sweep phase, and after stripping | 5842 | a special way just before the sweep phase, and after stripping |
| @@ -6020,7 +6003,7 @@ mark_object (Lisp_Object arg) | |||
| 6020 | /* Mark glyphs for leaf windows. Marking window | 6003 | /* Mark glyphs for leaf windows. Marking window |
| 6021 | matrices is sufficient because frame matrices | 6004 | matrices is sufficient because frame matrices |
| 6022 | use the same glyph memory. */ | 6005 | use the same glyph memory. */ |
| 6023 | if (NILP (WVAR (w, hchild)) && NILP (WVAR (w, vchild)) | 6006 | if (NILP (w->hchild) && NILP (w->vchild) |
| 6024 | && w->current_matrix) | 6007 | && w->current_matrix) |
| 6025 | { | 6008 | { |
| 6026 | mark_glyph_matrix (w->current_matrix); | 6009 | mark_glyph_matrix (w->current_matrix); |
| @@ -6073,8 +6056,8 @@ mark_object (Lisp_Object arg) | |||
| 6073 | break; | 6056 | break; |
| 6074 | CHECK_ALLOCATED_AND_LIVE (live_symbol_p); | 6057 | CHECK_ALLOCATED_AND_LIVE (live_symbol_p); |
| 6075 | ptr->gcmarkbit = 1; | 6058 | ptr->gcmarkbit = 1; |
| 6076 | mark_object (SVAR (ptr, function)); | 6059 | mark_object (ptr->function); |
| 6077 | mark_object (SVAR (ptr, plist)); | 6060 | mark_object (ptr->plist); |
| 6078 | switch (ptr->redirect) | 6061 | switch (ptr->redirect) |
| 6079 | { | 6062 | { |
| 6080 | case SYMBOL_PLAINVAL: mark_object (SYMBOL_VAL (ptr)); break; | 6063 | case SYMBOL_PLAINVAL: mark_object (SYMBOL_VAL (ptr)); break; |
| @@ -6105,9 +6088,9 @@ mark_object (Lisp_Object arg) | |||
| 6105 | break; | 6088 | break; |
| 6106 | default: abort (); | 6089 | default: abort (); |
| 6107 | } | 6090 | } |
| 6108 | if (!PURE_POINTER_P (XSTRING (SVAR (ptr, xname)))) | 6091 | if (!PURE_POINTER_P (XSTRING (ptr->name))) |
| 6109 | MARK_STRING (XSTRING (SVAR (ptr, xname))); | 6092 | MARK_STRING (XSTRING (ptr->name)); |
| 6110 | MARK_INTERVAL_TREE (STRING_INTERVALS (SVAR (ptr, xname))); | 6093 | MARK_INTERVAL_TREE (string_get_intervals (ptr->name)); |
| 6111 | 6094 | ||
| 6112 | ptr = ptr->next; | 6095 | ptr = ptr->next; |
| 6113 | if (ptr) | 6096 | if (ptr) |
| @@ -6169,14 +6152,14 @@ mark_object (Lisp_Object arg) | |||
| 6169 | CHECK_ALLOCATED_AND_LIVE (live_cons_p); | 6152 | CHECK_ALLOCATED_AND_LIVE (live_cons_p); |
| 6170 | CONS_MARK (ptr); | 6153 | CONS_MARK (ptr); |
| 6171 | /* If the cdr is nil, avoid recursion for the car. */ | 6154 | /* If the cdr is nil, avoid recursion for the car. */ |
| 6172 | if (EQ (CVAR (ptr, u.cdr), Qnil)) | 6155 | if (EQ (ptr->u.cdr, Qnil)) |
| 6173 | { | 6156 | { |
| 6174 | obj = CVAR (ptr, car); | 6157 | obj = ptr->car; |
| 6175 | cdr_count = 0; | 6158 | cdr_count = 0; |
| 6176 | goto loop; | 6159 | goto loop; |
| 6177 | } | 6160 | } |
| 6178 | mark_object (CVAR (ptr, car)); | 6161 | mark_object (ptr->car); |
| 6179 | obj = CVAR (ptr, u.cdr); | 6162 | obj = ptr->u.cdr; |
| 6180 | cdr_count++; | 6163 | cdr_count++; |
| 6181 | if (cdr_count == mark_object_loop_halt) | 6164 | if (cdr_count == mark_object_loop_halt) |
| 6182 | abort (); | 6165 | abort (); |
| @@ -6325,7 +6308,7 @@ gc_sweep (void) | |||
| 6325 | cblk->conses[pos].u.chain = cons_free_list; | 6308 | cblk->conses[pos].u.chain = cons_free_list; |
| 6326 | cons_free_list = &cblk->conses[pos]; | 6309 | cons_free_list = &cblk->conses[pos]; |
| 6327 | #if GC_MARK_STACK | 6310 | #if GC_MARK_STACK |
| 6328 | CVAR (cons_free_list, car) = Vdead; | 6311 | cons_free_list->car = Vdead; |
| 6329 | #endif | 6312 | #endif |
| 6330 | } | 6313 | } |
| 6331 | else | 6314 | else |
| @@ -6422,7 +6405,7 @@ gc_sweep (void) | |||
| 6422 | { | 6405 | { |
| 6423 | if (!iblk->intervals[i].gcmarkbit) | 6406 | if (!iblk->intervals[i].gcmarkbit) |
| 6424 | { | 6407 | { |
| 6425 | SET_INTERVAL_PARENT (&iblk->intervals[i], interval_free_list); | 6408 | interval_set_parent (&iblk->intervals[i], interval_free_list); |
| 6426 | interval_free_list = &iblk->intervals[i]; | 6409 | interval_free_list = &iblk->intervals[i]; |
| 6427 | this_free++; | 6410 | this_free++; |
| 6428 | } | 6411 | } |
| @@ -6473,7 +6456,7 @@ gc_sweep (void) | |||
| 6473 | /* Check if the symbol was created during loadup. In such a case | 6456 | /* Check if the symbol was created during loadup. In such a case |
| 6474 | it might be pointed to by pure bytecode which we don't trace, | 6457 | it might be pointed to by pure bytecode which we don't trace, |
| 6475 | so we conservatively assume that it is live. */ | 6458 | so we conservatively assume that it is live. */ |
| 6476 | int pure_p = PURE_POINTER_P (XSTRING (sym->s.INTERNAL_FIELD (xname))); | 6459 | int pure_p = PURE_POINTER_P (XSTRING (sym->s.name)); |
| 6477 | 6460 | ||
| 6478 | if (!sym->s.gcmarkbit && !pure_p) | 6461 | if (!sym->s.gcmarkbit && !pure_p) |
| 6479 | { | 6462 | { |
| @@ -6482,7 +6465,7 @@ gc_sweep (void) | |||
| 6482 | sym->s.next = symbol_free_list; | 6465 | sym->s.next = symbol_free_list; |
| 6483 | symbol_free_list = &sym->s; | 6466 | symbol_free_list = &sym->s; |
| 6484 | #if GC_MARK_STACK | 6467 | #if GC_MARK_STACK |
| 6485 | SVAR (symbol_free_list, function) = Vdead; | 6468 | symbol_free_list->function = Vdead; |
| 6486 | #endif | 6469 | #endif |
| 6487 | ++this_free; | 6470 | ++this_free; |
| 6488 | } | 6471 | } |
| @@ -6490,7 +6473,7 @@ gc_sweep (void) | |||
| 6490 | { | 6473 | { |
| 6491 | ++num_used; | 6474 | ++num_used; |
| 6492 | if (!pure_p) | 6475 | if (!pure_p) |
| 6493 | UNMARK_STRING (XSTRING (sym->s.INTERNAL_FIELD (xname))); | 6476 | UNMARK_STRING (XSTRING (sym->s.name)); |
| 6494 | sym->s.gcmarkbit = 0; | 6477 | sym->s.gcmarkbit = 0; |
| 6495 | } | 6478 | } |
| 6496 | } | 6479 | } |
| @@ -6592,7 +6575,8 @@ gc_sweep (void) | |||
| 6592 | else | 6575 | else |
| 6593 | { | 6576 | { |
| 6594 | VECTOR_UNMARK (buffer); | 6577 | VECTOR_UNMARK (buffer); |
| 6595 | UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer)); | 6578 | /* Do not use buffer_(set|get)_intervals here. */ |
| 6579 | buffer->text->intervals = balance_intervals (buffer->text->intervals); | ||
| 6596 | total_buffers++; | 6580 | total_buffers++; |
| 6597 | prev = buffer, buffer = buffer->header.next.buffer; | 6581 | prev = buffer, buffer = buffer->header.next.buffer; |
| 6598 | } | 6582 | } |
| @@ -6675,10 +6659,10 @@ which_symbols (Lisp_Object obj, EMACS_INT find_max) | |||
| 6675 | XSETSYMBOL (tem, sym); | 6659 | XSETSYMBOL (tem, sym); |
| 6676 | val = find_symbol_value (tem); | 6660 | val = find_symbol_value (tem); |
| 6677 | if (EQ (val, obj) | 6661 | if (EQ (val, obj) |
| 6678 | || EQ (SVAR (sym, function), obj) | 6662 | || EQ (sym->function, obj) |
| 6679 | || (!NILP (SVAR (sym, function)) | 6663 | || (!NILP (sym->function) |
| 6680 | && COMPILEDP (SVAR (sym, function)) | 6664 | && COMPILEDP (sym->function) |
| 6681 | && EQ (AREF (SVAR (sym, function), COMPILED_BYTECODE), obj)) | 6665 | && EQ (AREF (sym->function, COMPILED_BYTECODE), obj)) |
| 6682 | || (!NILP (val) | 6666 | || (!NILP (val) |
| 6683 | && COMPILEDP (val) | 6667 | && COMPILEDP (val) |
| 6684 | && EQ (AREF (val, COMPILED_BYTECODE), obj))) | 6668 | && EQ (AREF (val, COMPILED_BYTECODE), obj))) |
| @@ -6831,6 +6815,14 @@ do hash-consing of the objects allocated to pure space. */); | |||
| 6831 | doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); | 6815 | doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); |
| 6832 | Vmemory_full = Qnil; | 6816 | Vmemory_full = Qnil; |
| 6833 | 6817 | ||
| 6818 | DEFSYM (Qconses, "conses"); | ||
| 6819 | DEFSYM (Qsymbols, "symbols"); | ||
| 6820 | DEFSYM (Qmiscs, "miscs"); | ||
| 6821 | DEFSYM (Qstrings, "strings"); | ||
| 6822 | DEFSYM (Qvectors, "vectors"); | ||
| 6823 | DEFSYM (Qfloats, "floats"); | ||
| 6824 | DEFSYM (Qintervals, "intervals"); | ||
| 6825 | DEFSYM (Qbuffers, "buffers"); | ||
| 6834 | DEFSYM (Qstring_bytes, "string-bytes"); | 6826 | DEFSYM (Qstring_bytes, "string-bytes"); |
| 6835 | DEFSYM (Qvector_slots, "vector-slots"); | 6827 | DEFSYM (Qvector_slots, "vector-slots"); |
| 6836 | DEFSYM (Qheap, "heap"); | 6828 | DEFSYM (Qheap, "heap"); |