diff options
Diffstat (limited to 'src/alloc.c')
| -rw-r--r-- | src/alloc.c | 96 |
1 files changed, 90 insertions, 6 deletions
diff --git a/src/alloc.c b/src/alloc.c index cf86c80deaf..be03f4ebf7c 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | /* Storage allocation and gc for GNU Emacs Lisp interpreter. | 1 | /* Storage allocation and gc for GNU Emacs Lisp interpreter. |
| 2 | Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999, | 2 | Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999, |
| 3 | 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc. | 3 | 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. |
| 4 | 4 | ||
| 5 | This file is part of GNU Emacs. | 5 | This file is part of GNU Emacs. |
| 6 | 6 | ||
| @@ -1107,6 +1107,9 @@ lisp_align_free (block) | |||
| 1107 | } | 1107 | } |
| 1108 | eassert ((aligned & 1) == aligned); | 1108 | eassert ((aligned & 1) == aligned); |
| 1109 | eassert (i == (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1)); | 1109 | eassert (i == (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1)); |
| 1110 | #ifdef HAVE_POSIX_MEMALIGN | ||
| 1111 | eassert ((unsigned long)ABLOCKS_BASE (abase) % BLOCK_ALIGN == 0); | ||
| 1112 | #endif | ||
| 1110 | free (ABLOCKS_BASE (abase)); | 1113 | free (ABLOCKS_BASE (abase)); |
| 1111 | } | 1114 | } |
| 1112 | UNBLOCK_INPUT; | 1115 | UNBLOCK_INPUT; |
| @@ -1421,6 +1424,12 @@ make_interval () | |||
| 1421 | { | 1424 | { |
| 1422 | INTERVAL val; | 1425 | INTERVAL val; |
| 1423 | 1426 | ||
| 1427 | /* eassert (!handling_signal); */ | ||
| 1428 | |||
| 1429 | #ifndef SYNC_INPUT | ||
| 1430 | BLOCK_INPUT; | ||
| 1431 | #endif | ||
| 1432 | |||
| 1424 | if (interval_free_list) | 1433 | if (interval_free_list) |
| 1425 | { | 1434 | { |
| 1426 | val = interval_free_list; | 1435 | val = interval_free_list; |
| @@ -1442,6 +1451,11 @@ make_interval () | |||
| 1442 | } | 1451 | } |
| 1443 | val = &interval_block->intervals[interval_block_index++]; | 1452 | val = &interval_block->intervals[interval_block_index++]; |
| 1444 | } | 1453 | } |
| 1454 | |||
| 1455 | #ifndef SYNC_INPUT | ||
| 1456 | UNBLOCK_INPUT; | ||
| 1457 | #endif | ||
| 1458 | |||
| 1445 | consing_since_gc += sizeof (struct interval); | 1459 | consing_since_gc += sizeof (struct interval); |
| 1446 | intervals_consed++; | 1460 | intervals_consed++; |
| 1447 | RESET_INTERVAL (val); | 1461 | RESET_INTERVAL (val); |
| @@ -1839,6 +1853,12 @@ allocate_string () | |||
| 1839 | { | 1853 | { |
| 1840 | struct Lisp_String *s; | 1854 | struct Lisp_String *s; |
| 1841 | 1855 | ||
| 1856 | /* eassert (!handling_signal); */ | ||
| 1857 | |||
| 1858 | #ifndef SYNC_INPUT | ||
| 1859 | BLOCK_INPUT; | ||
| 1860 | #endif | ||
| 1861 | |||
| 1842 | /* If the free-list is empty, allocate a new string_block, and | 1862 | /* If the free-list is empty, allocate a new string_block, and |
| 1843 | add all the Lisp_Strings in it to the free-list. */ | 1863 | add all the Lisp_Strings in it to the free-list. */ |
| 1844 | if (string_free_list == NULL) | 1864 | if (string_free_list == NULL) |
| @@ -1868,6 +1888,10 @@ allocate_string () | |||
| 1868 | s = string_free_list; | 1888 | s = string_free_list; |
| 1869 | string_free_list = NEXT_FREE_LISP_STRING (s); | 1889 | string_free_list = NEXT_FREE_LISP_STRING (s); |
| 1870 | 1890 | ||
| 1891 | #ifndef SYNC_INPUT | ||
| 1892 | UNBLOCK_INPUT; | ||
| 1893 | #endif | ||
| 1894 | |||
| 1871 | /* Probably not strictly necessary, but play it safe. */ | 1895 | /* Probably not strictly necessary, but play it safe. */ |
| 1872 | bzero (s, sizeof *s); | 1896 | bzero (s, sizeof *s); |
| 1873 | 1897 | ||
| @@ -1915,6 +1939,12 @@ allocate_string_data (s, nchars, nbytes) | |||
| 1915 | /* Determine the number of bytes needed to store NBYTES bytes | 1939 | /* Determine the number of bytes needed to store NBYTES bytes |
| 1916 | of string data. */ | 1940 | of string data. */ |
| 1917 | needed = SDATA_SIZE (nbytes); | 1941 | needed = SDATA_SIZE (nbytes); |
| 1942 | old_data = s->data ? SDATA_OF_STRING (s) : NULL; | ||
| 1943 | old_nbytes = GC_STRING_BYTES (s); | ||
| 1944 | |||
| 1945 | #ifndef SYNC_INPUT | ||
| 1946 | BLOCK_INPUT; | ||
| 1947 | #endif | ||
| 1918 | 1948 | ||
| 1919 | if (nbytes > LARGE_STRING_BYTES) | 1949 | if (nbytes > LARGE_STRING_BYTES) |
| 1920 | { | 1950 | { |
| @@ -1969,10 +1999,13 @@ allocate_string_data (s, nchars, nbytes) | |||
| 1969 | else | 1999 | else |
| 1970 | b = current_sblock; | 2000 | b = current_sblock; |
| 1971 | 2001 | ||
| 1972 | old_data = s->data ? SDATA_OF_STRING (s) : NULL; | ||
| 1973 | old_nbytes = GC_STRING_BYTES (s); | ||
| 1974 | |||
| 1975 | data = b->next_free; | 2002 | data = b->next_free; |
| 2003 | b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA); | ||
| 2004 | |||
| 2005 | #ifndef SYNC_INPUT | ||
| 2006 | UNBLOCK_INPUT; | ||
| 2007 | #endif | ||
| 2008 | |||
| 1976 | data->string = s; | 2009 | data->string = s; |
| 1977 | s->data = SDATA_DATA (data); | 2010 | s->data = SDATA_DATA (data); |
| 1978 | #ifdef GC_CHECK_STRING_BYTES | 2011 | #ifdef GC_CHECK_STRING_BYTES |
| @@ -1985,7 +2018,6 @@ allocate_string_data (s, nchars, nbytes) | |||
| 1985 | bcopy (string_overrun_cookie, (char *) data + needed, | 2018 | bcopy (string_overrun_cookie, (char *) data + needed, |
| 1986 | GC_STRING_OVERRUN_COOKIE_SIZE); | 2019 | GC_STRING_OVERRUN_COOKIE_SIZE); |
| 1987 | #endif | 2020 | #endif |
| 1988 | b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA); | ||
| 1989 | 2021 | ||
| 1990 | /* If S had already data assigned, mark that as free by setting its | 2022 | /* If S had already data assigned, mark that as free by setting its |
| 1991 | string back-pointer to null, and recording the size of the data | 2023 | string back-pointer to null, and recording the size of the data |
| @@ -2554,6 +2586,12 @@ make_float (float_value) | |||
| 2554 | { | 2586 | { |
| 2555 | register Lisp_Object val; | 2587 | register Lisp_Object val; |
| 2556 | 2588 | ||
| 2589 | /* eassert (!handling_signal); */ | ||
| 2590 | |||
| 2591 | #ifndef SYNC_INPUT | ||
| 2592 | BLOCK_INPUT; | ||
| 2593 | #endif | ||
| 2594 | |||
| 2557 | if (float_free_list) | 2595 | if (float_free_list) |
| 2558 | { | 2596 | { |
| 2559 | /* We use the data field for chaining the free list | 2597 | /* We use the data field for chaining the free list |
| @@ -2579,6 +2617,10 @@ make_float (float_value) | |||
| 2579 | float_block_index++; | 2617 | float_block_index++; |
| 2580 | } | 2618 | } |
| 2581 | 2619 | ||
| 2620 | #ifndef SYNC_INPUT | ||
| 2621 | UNBLOCK_INPUT; | ||
| 2622 | #endif | ||
| 2623 | |||
| 2582 | XFLOAT_DATA (val) = float_value; | 2624 | XFLOAT_DATA (val) = float_value; |
| 2583 | eassert (!FLOAT_MARKED_P (XFLOAT (val))); | 2625 | eassert (!FLOAT_MARKED_P (XFLOAT (val))); |
| 2584 | consing_since_gc += sizeof (struct Lisp_Float); | 2626 | consing_since_gc += sizeof (struct Lisp_Float); |
| @@ -2673,6 +2715,12 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, | |||
| 2673 | { | 2715 | { |
| 2674 | register Lisp_Object val; | 2716 | register Lisp_Object val; |
| 2675 | 2717 | ||
| 2718 | /* eassert (!handling_signal); */ | ||
| 2719 | |||
| 2720 | #ifndef SYNC_INPUT | ||
| 2721 | BLOCK_INPUT; | ||
| 2722 | #endif | ||
| 2723 | |||
| 2676 | if (cons_free_list) | 2724 | if (cons_free_list) |
| 2677 | { | 2725 | { |
| 2678 | /* We use the cdr for chaining the free list | 2726 | /* We use the cdr for chaining the free list |
| @@ -2697,6 +2745,10 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, | |||
| 2697 | cons_block_index++; | 2745 | cons_block_index++; |
| 2698 | } | 2746 | } |
| 2699 | 2747 | ||
| 2748 | #ifndef SYNC_INPUT | ||
| 2749 | UNBLOCK_INPUT; | ||
| 2750 | #endif | ||
| 2751 | |||
| 2700 | XSETCAR (val, car); | 2752 | XSETCAR (val, car); |
| 2701 | XSETCDR (val, cdr); | 2753 | XSETCDR (val, cdr); |
| 2702 | eassert (!CONS_MARKED_P (XCONS (val))); | 2754 | eassert (!CONS_MARKED_P (XCONS (val))); |
| @@ -2854,6 +2906,9 @@ allocate_vectorlike (len, type) | |||
| 2854 | UNBLOCK_INPUT; | 2906 | UNBLOCK_INPUT; |
| 2855 | #endif | 2907 | #endif |
| 2856 | 2908 | ||
| 2909 | /* This gets triggered by code which I haven't bothered to fix. --Stef */ | ||
| 2910 | /* eassert (!handling_signal); */ | ||
| 2911 | |||
| 2857 | nbytes = sizeof *p + (len - 1) * sizeof p->contents[0]; | 2912 | nbytes = sizeof *p + (len - 1) * sizeof p->contents[0]; |
| 2858 | p = (struct Lisp_Vector *) lisp_malloc (nbytes, type); | 2913 | p = (struct Lisp_Vector *) lisp_malloc (nbytes, type); |
| 2859 | 2914 | ||
| @@ -2867,8 +2922,17 @@ allocate_vectorlike (len, type) | |||
| 2867 | consing_since_gc += nbytes; | 2922 | consing_since_gc += nbytes; |
| 2868 | vector_cells_consed += len; | 2923 | vector_cells_consed += len; |
| 2869 | 2924 | ||
| 2925 | #ifndef SYNC_INPUT | ||
| 2926 | BLOCK_INPUT; | ||
| 2927 | #endif | ||
| 2928 | |||
| 2870 | p->next = all_vectors; | 2929 | p->next = all_vectors; |
| 2871 | all_vectors = p; | 2930 | all_vectors = p; |
| 2931 | |||
| 2932 | #ifndef SYNC_INPUT | ||
| 2933 | UNBLOCK_INPUT; | ||
| 2934 | #endif | ||
| 2935 | |||
| 2872 | ++n_vectors; | 2936 | ++n_vectors; |
| 2873 | return p; | 2937 | return p; |
| 2874 | } | 2938 | } |
| @@ -3147,6 +3211,12 @@ Its value and function definition are void, and its property list is nil. */) | |||
| 3147 | 3211 | ||
| 3148 | CHECK_STRING (name); | 3212 | CHECK_STRING (name); |
| 3149 | 3213 | ||
| 3214 | eassert (!handling_signal); | ||
| 3215 | |||
| 3216 | #ifndef SYNC_INPUT | ||
| 3217 | BLOCK_INPUT; | ||
| 3218 | #endif | ||
| 3219 | |||
| 3150 | if (symbol_free_list) | 3220 | if (symbol_free_list) |
| 3151 | { | 3221 | { |
| 3152 | XSETSYMBOL (val, symbol_free_list); | 3222 | XSETSYMBOL (val, symbol_free_list); |
| @@ -3168,6 +3238,10 @@ Its value and function definition are void, and its property list is nil. */) | |||
| 3168 | symbol_block_index++; | 3238 | symbol_block_index++; |
| 3169 | } | 3239 | } |
| 3170 | 3240 | ||
| 3241 | #ifndef SYNC_INPUT | ||
| 3242 | UNBLOCK_INPUT; | ||
| 3243 | #endif | ||
| 3244 | |||
| 3171 | p = XSYMBOL (val); | 3245 | p = XSYMBOL (val); |
| 3172 | p->xname = name; | 3246 | p->xname = name; |
| 3173 | p->plist = Qnil; | 3247 | p->plist = Qnil; |
| @@ -3227,6 +3301,12 @@ allocate_misc () | |||
| 3227 | { | 3301 | { |
| 3228 | Lisp_Object val; | 3302 | Lisp_Object val; |
| 3229 | 3303 | ||
| 3304 | /* eassert (!handling_signal); */ | ||
| 3305 | |||
| 3306 | #ifndef SYNC_INPUT | ||
| 3307 | BLOCK_INPUT; | ||
| 3308 | #endif | ||
| 3309 | |||
| 3230 | if (marker_free_list) | 3310 | if (marker_free_list) |
| 3231 | { | 3311 | { |
| 3232 | XSETMISC (val, marker_free_list); | 3312 | XSETMISC (val, marker_free_list); |
| @@ -3249,6 +3329,10 @@ allocate_misc () | |||
| 3249 | marker_block_index++; | 3329 | marker_block_index++; |
| 3250 | } | 3330 | } |
| 3251 | 3331 | ||
| 3332 | #ifndef SYNC_INPUT | ||
| 3333 | UNBLOCK_INPUT; | ||
| 3334 | #endif | ||
| 3335 | |||
| 3252 | --total_free_markers; | 3336 | --total_free_markers; |
| 3253 | consing_since_gc += sizeof (union Lisp_Misc); | 3337 | consing_since_gc += sizeof (union Lisp_Misc); |
| 3254 | misc_objects_consed++; | 3338 | misc_objects_consed++; |
| @@ -4642,7 +4726,7 @@ void | |||
| 4642 | check_pure_size () | 4726 | check_pure_size () |
| 4643 | { | 4727 | { |
| 4644 | if (pure_bytes_used_before_overflow) | 4728 | if (pure_bytes_used_before_overflow) |
| 4645 | message ("Pure Lisp storage overflow (approx. %d bytes needed)", | 4729 | message ("emacs:0:Pure Lisp storage overflow (approx. %d bytes needed)", |
| 4646 | (int) (pure_bytes_used + pure_bytes_used_before_overflow)); | 4730 | (int) (pure_bytes_used + pure_bytes_used_before_overflow)); |
| 4647 | } | 4731 | } |
| 4648 | 4732 | ||