Mercurial > emacs
comparison src/alloc.c @ 83461:9b150bc96d33
Merged from miles@gnu.org--gnu-2005 (patch 187, 704)
Patches applied:
* emacs@sv.gnu.org/emacs--devo--0--base-0
tag of miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-704
* emacs@sv.gnu.org/emacs--devo--0--patch-1
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-2
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-3
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-4
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-5
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-6
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-7
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-8
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-9
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-10
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-11
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-12
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-13
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-14
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-15
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-16
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-17
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-18
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-19
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-20
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-21
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-22
Install ERC.
* emacs@sv.gnu.org/emacs--devo--0--patch-23
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-24
Fix ERC compiler warnings.
* emacs@sv.gnu.org/emacs--devo--0--patch-25
Use utf-8 encoding in ERC ChangeLogs.
* emacs@sv.gnu.org/emacs--devo--0--patch-26
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-27
Merge ERC-related Viper hacks into Viper.
* emacs@sv.gnu.org/emacs--devo--0--patch-28
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-29
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-30
Merge from erc--main--0
* emacs@sv.gnu.org/gnus--rel--5.10--base-0
tag of miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-187
* emacs@sv.gnu.org/gnus--rel--5.10--patch-1
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-2
Merge from emacs--devo--0
* emacs@sv.gnu.org/gnus--rel--5.10--patch-3
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-4
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-5
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-6
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-7
Update from CVS
* miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-704
Update from CVS
* miles@gnu.org--gnu-2005/gnus--rel--5.10--patch-187
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-501
author | Karoly Lorentey <lorentey@elte.hu> |
---|---|
date | Mon, 30 Jan 2006 18:06:22 +0000 |
parents | 76396de7f50a 47782d80f30b |
children | b98066f4aa10 |
comparison
equal
deleted
inserted
replaced
83460:dbd791ef90a1 | 83461:9b150bc96d33 |
---|---|
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 |
7 GNU Emacs is free software; you can redistribute it and/or modify | 7 GNU Emacs is free software; you can redistribute it and/or modify |
8 it under the terms of the GNU General Public License as published by | 8 it under the terms of the GNU General Public License as published by |
1105 else | 1105 else |
1106 tem = &(*tem)->x.next_free; | 1106 tem = &(*tem)->x.next_free; |
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; |
1113 } | 1116 } |
1114 | 1117 |
1419 INTERVAL | 1422 INTERVAL |
1420 make_interval () | 1423 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; |
1427 interval_free_list = INTERVAL_PARENT (interval_free_list); | 1436 interval_free_list = INTERVAL_PARENT (interval_free_list); |
1428 } | 1437 } |
1440 interval_block_index = 0; | 1449 interval_block_index = 0; |
1441 n_interval_blocks++; | 1450 n_interval_blocks++; |
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); |
1448 val->gcmarkbit = 0; | 1462 val->gcmarkbit = 0; |
1449 return val; | 1463 return val; |
1837 static struct Lisp_String * | 1851 static struct Lisp_String * |
1838 allocate_string () | 1852 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) |
1845 { | 1865 { |
1846 struct string_block *b; | 1866 struct string_block *b; |
1865 check_string_free_list (); | 1885 check_string_free_list (); |
1866 | 1886 |
1867 /* Pop a Lisp_String off the free-list. */ | 1887 /* Pop a Lisp_String off the free-list. */ |
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); |
1890 | |
1891 #ifndef SYNC_INPUT | |
1892 UNBLOCK_INPUT; | |
1893 #endif | |
1870 | 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 |
1874 --total_free_strings; | 1898 --total_free_strings; |
1913 int needed, old_nbytes; | 1937 int needed, old_nbytes; |
1914 | 1938 |
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 { |
1921 size_t size = sizeof *b - sizeof (struct sdata) + needed; | 1951 size_t size = sizeof *b - sizeof (struct sdata) + needed; |
1922 | 1952 |
1967 current_sblock = b; | 1997 current_sblock = b; |
1968 } | 1998 } |
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 |
1979 SDATA_NBYTES (data) = nbytes; | 2012 SDATA_NBYTES (data) = nbytes; |
1980 #endif | 2013 #endif |
1983 s->data[nbytes] = '\0'; | 2016 s->data[nbytes] = '\0'; |
1984 #ifdef GC_CHECK_STRING_OVERRUN | 2017 #ifdef GC_CHECK_STRING_OVERRUN |
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 |
1992 in it. */ | 2024 in it. */ |
1993 if (old_data) | 2025 if (old_data) |
2552 make_float (float_value) | 2584 make_float (float_value) |
2553 double float_value; | 2585 double 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 |
2560 so that we won't use the same field that has the mark bit. */ | 2598 so that we won't use the same field that has the mark bit. */ |
2561 XSETFLOAT (val, float_free_list); | 2599 XSETFLOAT (val, float_free_list); |
2577 } | 2615 } |
2578 XSETFLOAT (val, &float_block->floats[float_block_index]); | 2616 XSETFLOAT (val, &float_block->floats[float_block_index]); |
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); |
2585 floats_consed++; | 2627 floats_consed++; |
2586 return val; | 2628 return val; |
2670 doc: /* Create a new cons, give it CAR and CDR as components, and return it. */) | 2712 doc: /* Create a new cons, give it CAR and CDR as components, and return it. */) |
2671 (car, cdr) | 2713 (car, cdr) |
2672 Lisp_Object car, cdr; | 2714 Lisp_Object car, cdr; |
2673 { | 2715 { |
2674 register Lisp_Object val; | 2716 register Lisp_Object val; |
2717 | |
2718 /* eassert (!handling_signal); */ | |
2719 | |
2720 #ifndef SYNC_INPUT | |
2721 BLOCK_INPUT; | |
2722 #endif | |
2675 | 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 |
2679 so that we won't use the same field that has the mark bit. */ | 2727 so that we won't use the same field that has the mark bit. */ |
2695 } | 2743 } |
2696 XSETCONS (val, &cons_block->conses[cons_block_index]); | 2744 XSETCONS (val, &cons_block->conses[cons_block_index]); |
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))); |
2703 consing_since_gc += sizeof (struct Lisp_Cons); | 2755 consing_since_gc += sizeof (struct Lisp_Cons); |
2704 cons_cells_consed++; | 2756 cons_cells_consed++; |
2852 BLOCK_INPUT; | 2904 BLOCK_INPUT; |
2853 mallopt (M_MMAP_MAX, 0); | 2905 mallopt (M_MMAP_MAX, 0); |
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 |
2860 #ifdef DOUG_LEA_MALLOC | 2915 #ifdef DOUG_LEA_MALLOC |
2861 /* Back to a reasonable maximum of mmap'ed areas. */ | 2916 /* Back to a reasonable maximum of mmap'ed areas. */ |
2865 #endif | 2920 #endif |
2866 | 2921 |
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 } |
2875 | 2939 |
2876 | 2940 |
3145 register Lisp_Object val; | 3209 register Lisp_Object val; |
3146 register struct Lisp_Symbol *p; | 3210 register struct Lisp_Symbol *p; |
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); |
3153 symbol_free_list = symbol_free_list->next; | 3223 symbol_free_list = symbol_free_list->next; |
3154 } | 3224 } |
3165 n_symbol_blocks++; | 3235 n_symbol_blocks++; |
3166 } | 3236 } |
3167 XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]); | 3237 XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]); |
3168 symbol_block_index++; | 3238 symbol_block_index++; |
3169 } | 3239 } |
3240 | |
3241 #ifndef SYNC_INPUT | |
3242 UNBLOCK_INPUT; | |
3243 #endif | |
3170 | 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; |
3174 p->value = Qunbound; | 3248 p->value = Qunbound; |
3225 Lisp_Object | 3299 Lisp_Object |
3226 allocate_misc () | 3300 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); |
3233 marker_free_list = marker_free_list->u_free.chain; | 3313 marker_free_list = marker_free_list->u_free.chain; |
3234 } | 3314 } |
3246 total_free_markers += MARKER_BLOCK_SIZE; | 3326 total_free_markers += MARKER_BLOCK_SIZE; |
3247 } | 3327 } |
3248 XSETMISC (val, &marker_block->markers[marker_block_index]); | 3328 XSETMISC (val, &marker_block->markers[marker_block_index]); |
3249 marker_block_index++; | 3329 marker_block_index++; |
3250 } | 3330 } |
3331 | |
3332 #ifndef SYNC_INPUT | |
3333 UNBLOCK_INPUT; | |
3334 #endif | |
3251 | 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++; |
3255 XMARKER (val)->gcmarkbit = 0; | 3339 XMARKER (val)->gcmarkbit = 0; |
4640 | 4724 |
4641 void | 4725 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 |
4649 | 4733 |
4650 /* Return a string allocated in pure space. DATA is a buffer holding | 4734 /* Return a string allocated in pure space. DATA is a buffer holding |