aboutsummaryrefslogtreecommitdiffstats
path: root/src/alloc.c
diff options
context:
space:
mode:
authorJoakim Verona2010-10-18 22:05:07 +0200
committerJoakim Verona2010-10-18 22:05:07 +0200
commit13cfe8df462ab8da9f0028e16cc84dcaceaca3d1 (patch)
tree723f254768f9e503504ab4c8b68801f80a56591a /src/alloc.c
parent35f4b80a934b299b3b18e62f5db44f64c240e65b (diff)
parente48eb34332dc91de823314090451459ba2ffacbf (diff)
downloademacs-13cfe8df462ab8da9f0028e16cc84dcaceaca3d1.tar.gz
emacs-13cfe8df462ab8da9f0028e16cc84dcaceaca3d1.zip
merge from upstream
Diffstat (limited to 'src/alloc.c')
-rw-r--r--src/alloc.c98
1 files changed, 52 insertions, 46 deletions
diff --git a/src/alloc.c b/src/alloc.c
index 1f615a7d505..fa39c1ee5dc 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -65,15 +65,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
65extern POINTER_TYPE *sbrk (); 65extern POINTER_TYPE *sbrk ();
66#endif 66#endif
67 67
68#ifdef HAVE_FCNTL_H
69#include <fcntl.h> 68#include <fcntl.h>
70#endif
71#ifndef O_WRONLY
72#define O_WRONLY 1
73#endif
74 69
75#ifdef WINDOWSNT 70#ifdef WINDOWSNT
76#include <fcntl.h>
77#include "w32.h" 71#include "w32.h"
78#endif 72#endif
79 73
@@ -1644,7 +1638,7 @@ static int total_strings, total_free_strings;
1644 1638
1645/* Number of bytes used by live strings. */ 1639/* Number of bytes used by live strings. */
1646 1640
1647static int total_string_size; 1641static EMACS_INT total_string_size;
1648 1642
1649/* Given a pointer to a Lisp_String S which is on the free-list 1643/* Given a pointer to a Lisp_String S which is on the free-list
1650 string_free_list, return a pointer to its successor in the 1644 string_free_list, return a pointer to its successor in the
@@ -1739,11 +1733,12 @@ static void check_sblock (struct sblock *);
1739 1733
1740/* Like GC_STRING_BYTES, but with debugging check. */ 1734/* Like GC_STRING_BYTES, but with debugging check. */
1741 1735
1742int 1736EMACS_INT
1743string_bytes (s) 1737string_bytes (struct Lisp_String *s)
1744 struct Lisp_String *s;
1745{ 1738{
1746 int nbytes = (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte); 1739 EMACS_INT nbytes =
1740 (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
1741
1747 if (!PURE_POINTER_P (s) 1742 if (!PURE_POINTER_P (s)
1748 && s->data 1743 && s->data
1749 && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s))) 1744 && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
@@ -1765,7 +1760,7 @@ check_sblock (b)
1765 { 1760 {
1766 /* Compute the next FROM here because copying below may 1761 /* Compute the next FROM here because copying below may
1767 overwrite data we need to compute it. */ 1762 overwrite data we need to compute it. */
1768 int nbytes; 1763 EMACS_INT nbytes;
1769 1764
1770 /* Check that the string size recorded in the string is the 1765 /* Check that the string size recorded in the string is the
1771 same as the one recorded in the sdata structure. */ 1766 same as the one recorded in the sdata structure. */
@@ -1825,7 +1820,7 @@ check_string_free_list ()
1825 s = string_free_list; 1820 s = string_free_list;
1826 while (s != NULL) 1821 while (s != NULL)
1827 { 1822 {
1828 if ((unsigned)s < 1024) 1823 if ((unsigned long)s < 1024)
1829 abort(); 1824 abort();
1830 s = NEXT_FREE_LISP_STRING (s); 1825 s = NEXT_FREE_LISP_STRING (s);
1831 } 1826 }
@@ -1908,11 +1903,12 @@ allocate_string (void)
1908 S->data if it was initially non-null. */ 1903 S->data if it was initially non-null. */
1909 1904
1910void 1905void
1911allocate_string_data (struct Lisp_String *s, int nchars, int nbytes) 1906allocate_string_data (struct Lisp_String *s,
1907 EMACS_INT nchars, EMACS_INT nbytes)
1912{ 1908{
1913 struct sdata *data, *old_data; 1909 struct sdata *data, *old_data;
1914 struct sblock *b; 1910 struct sblock *b;
1915 int needed, old_nbytes; 1911 EMACS_INT needed, old_nbytes;
1916 1912
1917 /* Determine the number of bytes needed to store NBYTES bytes 1913 /* Determine the number of bytes needed to store NBYTES bytes
1918 of string data. */ 1914 of string data. */
@@ -2154,7 +2150,7 @@ compact_small_strings (void)
2154 { 2150 {
2155 /* Compute the next FROM here because copying below may 2151 /* Compute the next FROM here because copying below may
2156 overwrite data we need to compute it. */ 2152 overwrite data we need to compute it. */
2157 int nbytes; 2153 EMACS_INT nbytes;
2158 2154
2159#ifdef GC_CHECK_STRING_BYTES 2155#ifdef GC_CHECK_STRING_BYTES
2160 /* Check that the string size recorded in the string is the 2156 /* Check that the string size recorded in the string is the
@@ -2232,7 +2228,8 @@ INIT must be an integer that represents a character. */)
2232{ 2228{
2233 register Lisp_Object val; 2229 register Lisp_Object val;
2234 register unsigned char *p, *end; 2230 register unsigned char *p, *end;
2235 int c, nbytes; 2231 int c;
2232 EMACS_INT nbytes;
2236 2233
2237 CHECK_NATNUM (length); 2234 CHECK_NATNUM (length);
2238 CHECK_NUMBER (init); 2235 CHECK_NUMBER (init);
@@ -2251,9 +2248,12 @@ INIT must be an integer that represents a character. */)
2251 { 2248 {
2252 unsigned char str[MAX_MULTIBYTE_LENGTH]; 2249 unsigned char str[MAX_MULTIBYTE_LENGTH];
2253 int len = CHAR_STRING (c, str); 2250 int len = CHAR_STRING (c, str);
2251 EMACS_INT string_len = XINT (length);
2254 2252
2255 nbytes = len * XINT (length); 2253 if (string_len > MOST_POSITIVE_FIXNUM / len)
2256 val = make_uninit_multibyte_string (XINT (length), nbytes); 2254 error ("Maximum string size exceeded");
2255 nbytes = len * string_len;
2256 val = make_uninit_multibyte_string (string_len, nbytes);
2257 p = SDATA (val); 2257 p = SDATA (val);
2258 end = p + nbytes; 2258 end = p + nbytes;
2259 while (p != end) 2259 while (p != end)
@@ -2276,7 +2276,8 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
2276 register Lisp_Object val; 2276 register Lisp_Object val;
2277 struct Lisp_Bool_Vector *p; 2277 struct Lisp_Bool_Vector *p;
2278 int real_init, i; 2278 int real_init, i;
2279 int length_in_chars, length_in_elts, bits_per_value; 2279 EMACS_INT length_in_chars, length_in_elts;
2280 int bits_per_value;
2280 2281
2281 CHECK_NATNUM (length); 2282 CHECK_NATNUM (length);
2282 2283
@@ -2316,10 +2317,10 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
2316 multibyte, depending on the contents. */ 2317 multibyte, depending on the contents. */
2317 2318
2318Lisp_Object 2319Lisp_Object
2319make_string (const char *contents, int nbytes) 2320make_string (const char *contents, EMACS_INT nbytes)
2320{ 2321{
2321 register Lisp_Object val; 2322 register Lisp_Object val;
2322 int nchars, multibyte_nbytes; 2323 EMACS_INT nchars, multibyte_nbytes;
2323 2324
2324 parse_str_as_multibyte (contents, nbytes, &nchars, &multibyte_nbytes); 2325 parse_str_as_multibyte (contents, nbytes, &nchars, &multibyte_nbytes);
2325 if (nbytes == nchars || nbytes != multibyte_nbytes) 2326 if (nbytes == nchars || nbytes != multibyte_nbytes)
@@ -2335,7 +2336,7 @@ make_string (const char *contents, int nbytes)
2335/* Make an unibyte string from LENGTH bytes at CONTENTS. */ 2336/* Make an unibyte string from LENGTH bytes at CONTENTS. */
2336 2337
2337Lisp_Object 2338Lisp_Object
2338make_unibyte_string (const char *contents, int length) 2339make_unibyte_string (const char *contents, EMACS_INT length)
2339{ 2340{
2340 register Lisp_Object val; 2341 register Lisp_Object val;
2341 val = make_uninit_string (length); 2342 val = make_uninit_string (length);
@@ -2349,7 +2350,8 @@ make_unibyte_string (const char *contents, int length)
2349 bytes at CONTENTS. */ 2350 bytes at CONTENTS. */
2350 2351
2351Lisp_Object 2352Lisp_Object
2352make_multibyte_string (const char *contents, int nchars, int nbytes) 2353make_multibyte_string (const char *contents,
2354 EMACS_INT nchars, EMACS_INT nbytes)
2353{ 2355{
2354 register Lisp_Object val; 2356 register Lisp_Object val;
2355 val = make_uninit_multibyte_string (nchars, nbytes); 2357 val = make_uninit_multibyte_string (nchars, nbytes);
@@ -2362,7 +2364,8 @@ make_multibyte_string (const char *contents, int nchars, int nbytes)
2362 CONTENTS. It is a multibyte string if NBYTES != NCHARS. */ 2364 CONTENTS. It is a multibyte string if NBYTES != NCHARS. */
2363 2365
2364Lisp_Object 2366Lisp_Object
2365make_string_from_bytes (const char *contents, int nchars, int nbytes) 2367make_string_from_bytes (const char *contents,
2368 EMACS_INT nchars, EMACS_INT nbytes)
2366{ 2369{
2367 register Lisp_Object val; 2370 register Lisp_Object val;
2368 val = make_uninit_multibyte_string (nchars, nbytes); 2371 val = make_uninit_multibyte_string (nchars, nbytes);
@@ -2379,7 +2382,8 @@ make_string_from_bytes (const char *contents, int nchars, int nbytes)
2379 characters by itself. */ 2382 characters by itself. */
2380 2383
2381Lisp_Object 2384Lisp_Object
2382make_specified_string (const char *contents, int nchars, int nbytes, int multibyte) 2385make_specified_string (const char *contents,
2386 EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
2383{ 2387{
2384 register Lisp_Object val; 2388 register Lisp_Object val;
2385 2389
@@ -2412,7 +2416,7 @@ build_string (const char *str)
2412 occupying LENGTH bytes. */ 2416 occupying LENGTH bytes. */
2413 2417
2414Lisp_Object 2418Lisp_Object
2415make_uninit_string (int length) 2419make_uninit_string (EMACS_INT length)
2416{ 2420{
2417 Lisp_Object val; 2421 Lisp_Object val;
2418 2422
@@ -2428,7 +2432,7 @@ make_uninit_string (int length)
2428 which occupy NBYTES bytes. */ 2432 which occupy NBYTES bytes. */
2429 2433
2430Lisp_Object 2434Lisp_Object
2431make_uninit_multibyte_string (int nchars, int nbytes) 2435make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
2432{ 2436{
2433 Lisp_Object string; 2437 Lisp_Object string;
2434 struct Lisp_String *s; 2438 struct Lisp_String *s;
@@ -2767,7 +2771,7 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
2767 (register Lisp_Object length, Lisp_Object init) 2771 (register Lisp_Object length, Lisp_Object init)
2768{ 2772{
2769 register Lisp_Object val; 2773 register Lisp_Object val;
2770 register int size; 2774 register EMACS_INT size;
2771 2775
2772 CHECK_NATNUM (length); 2776 CHECK_NATNUM (length);
2773 size = XFASTINT (length); 2777 size = XFASTINT (length);
@@ -2945,7 +2949,7 @@ See also the function `vector'. */)
2945{ 2949{
2946 Lisp_Object vector; 2950 Lisp_Object vector;
2947 register EMACS_INT sizei; 2951 register EMACS_INT sizei;
2948 register int index; 2952 register EMACS_INT index;
2949 register struct Lisp_Vector *p; 2953 register struct Lisp_Vector *p;
2950 2954
2951 CHECK_NATNUM (length); 2955 CHECK_NATNUM (length);
@@ -3785,7 +3789,7 @@ live_string_p (struct mem_node *m, void *p)
3785 if (m->type == MEM_TYPE_STRING) 3789 if (m->type == MEM_TYPE_STRING)
3786 { 3790 {
3787 struct string_block *b = (struct string_block *) m->start; 3791 struct string_block *b = (struct string_block *) m->start;
3788 int offset = (char *) p - (char *) &b->strings[0]; 3792 ptrdiff_t offset = (char *) p - (char *) &b->strings[0];
3789 3793
3790 /* P must point to the start of a Lisp_String structure, and it 3794 /* P must point to the start of a Lisp_String structure, and it
3791 must not be on the free-list. */ 3795 must not be on the free-list. */
@@ -3808,7 +3812,7 @@ live_cons_p (struct mem_node *m, void *p)
3808 if (m->type == MEM_TYPE_CONS) 3812 if (m->type == MEM_TYPE_CONS)
3809 { 3813 {
3810 struct cons_block *b = (struct cons_block *) m->start; 3814 struct cons_block *b = (struct cons_block *) m->start;
3811 int offset = (char *) p - (char *) &b->conses[0]; 3815 ptrdiff_t offset = (char *) p - (char *) &b->conses[0];
3812 3816
3813 /* P must point to the start of a Lisp_Cons, not be 3817 /* P must point to the start of a Lisp_Cons, not be
3814 one of the unused cells in the current cons block, 3818 one of the unused cells in the current cons block,
@@ -3834,7 +3838,7 @@ live_symbol_p (struct mem_node *m, void *p)
3834 if (m->type == MEM_TYPE_SYMBOL) 3838 if (m->type == MEM_TYPE_SYMBOL)
3835 { 3839 {
3836 struct symbol_block *b = (struct symbol_block *) m->start; 3840 struct symbol_block *b = (struct symbol_block *) m->start;
3837 int offset = (char *) p - (char *) &b->symbols[0]; 3841 ptrdiff_t offset = (char *) p - (char *) &b->symbols[0];
3838 3842
3839 /* P must point to the start of a Lisp_Symbol, not be 3843 /* P must point to the start of a Lisp_Symbol, not be
3840 one of the unused cells in the current symbol block, 3844 one of the unused cells in the current symbol block,
@@ -3860,7 +3864,7 @@ live_float_p (struct mem_node *m, void *p)
3860 if (m->type == MEM_TYPE_FLOAT) 3864 if (m->type == MEM_TYPE_FLOAT)
3861 { 3865 {
3862 struct float_block *b = (struct float_block *) m->start; 3866 struct float_block *b = (struct float_block *) m->start;
3863 int offset = (char *) p - (char *) &b->floats[0]; 3867 ptrdiff_t offset = (char *) p - (char *) &b->floats[0];
3864 3868
3865 /* P must point to the start of a Lisp_Float and not be 3869 /* P must point to the start of a Lisp_Float and not be
3866 one of the unused cells in the current float block. */ 3870 one of the unused cells in the current float block. */
@@ -3884,7 +3888,7 @@ live_misc_p (struct mem_node *m, void *p)
3884 if (m->type == MEM_TYPE_MISC) 3888 if (m->type == MEM_TYPE_MISC)
3885 { 3889 {
3886 struct marker_block *b = (struct marker_block *) m->start; 3890 struct marker_block *b = (struct marker_block *) m->start;
3887 int offset = (char *) p - (char *) &b->markers[0]; 3891 ptrdiff_t offset = (char *) p - (char *) &b->markers[0];
3888 3892
3889 /* P must point to the start of a Lisp_Misc, not be 3893 /* P must point to the start of a Lisp_Misc, not be
3890 one of the unused cells in the current misc block, 3894 one of the unused cells in the current misc block,
@@ -4591,9 +4595,10 @@ check_pure_size (void)
4591 address. Return NULL if not found. */ 4595 address. Return NULL if not found. */
4592 4596
4593static char * 4597static char *
4594find_string_data_in_pure (const char *data, int nbytes) 4598find_string_data_in_pure (const char *data, EMACS_INT nbytes)
4595{ 4599{
4596 int i, skip, bm_skip[256], last_char_skip, infinity, start, start_max; 4600 int i;
4601 EMACS_INT skip, bm_skip[256], last_char_skip, infinity, start, start_max;
4597 const unsigned char *p; 4602 const unsigned char *p;
4598 char *non_lisp_beg; 4603 char *non_lisp_beg;
4599 4604
@@ -4660,7 +4665,8 @@ find_string_data_in_pure (const char *data, int nbytes)
4660 string; then the string is not protected from gc. */ 4665 string; then the string is not protected from gc. */
4661 4666
4662Lisp_Object 4667Lisp_Object
4663make_pure_string (const char *data, int nchars, int nbytes, int multibyte) 4668make_pure_string (const char *data,
4669 EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
4664{ 4670{
4665 Lisp_Object string; 4671 Lisp_Object string;
4666 struct Lisp_String *s; 4672 struct Lisp_String *s;
@@ -4688,7 +4694,7 @@ make_pure_c_string (const char *data)
4688{ 4694{
4689 Lisp_Object string; 4695 Lisp_Object string;
4690 struct Lisp_String *s; 4696 struct Lisp_String *s;
4691 int nchars = strlen (data); 4697 EMACS_INT nchars = strlen (data);
4692 4698
4693 s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String); 4699 s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
4694 s->size = nchars; 4700 s->size = nchars;
@@ -4778,7 +4784,7 @@ Does not copy symbols. Copies strings without text properties. */)
4778 else if (COMPILEDP (obj) || VECTORP (obj)) 4784 else if (COMPILEDP (obj) || VECTORP (obj))
4779 { 4785 {
4780 register struct Lisp_Vector *vec; 4786 register struct Lisp_Vector *vec;
4781 register int i; 4787 register EMACS_INT i;
4782 EMACS_INT size; 4788 EMACS_INT size;
4783 4789
4784 size = XVECTOR (obj)->size; 4790 size = XVECTOR (obj)->size;
@@ -5227,8 +5233,8 @@ static int mark_object_loop_halt;
5227static void 5233static void
5228mark_vectorlike (struct Lisp_Vector *ptr) 5234mark_vectorlike (struct Lisp_Vector *ptr)
5229{ 5235{
5230 register EMACS_INT size = ptr->size; 5236 register EMACS_UINT size = ptr->size;
5231 register int i; 5237 register EMACS_UINT i;
5232 5238
5233 eassert (!VECTOR_MARKED_P (ptr)); 5239 eassert (!VECTOR_MARKED_P (ptr));
5234 VECTOR_MARK (ptr); /* Else mark it */ 5240 VECTOR_MARK (ptr); /* Else mark it */
@@ -5250,8 +5256,8 @@ mark_vectorlike (struct Lisp_Vector *ptr)
5250static void 5256static void
5251mark_char_table (struct Lisp_Vector *ptr) 5257mark_char_table (struct Lisp_Vector *ptr)
5252{ 5258{
5253 register EMACS_INT size = ptr->size & PSEUDOVECTOR_SIZE_MASK; 5259 register EMACS_UINT size = ptr->size & PSEUDOVECTOR_SIZE_MASK;
5254 register int i; 5260 register EMACS_UINT i;
5255 5261
5256 eassert (!VECTOR_MARKED_P (ptr)); 5262 eassert (!VECTOR_MARKED_P (ptr));
5257 VECTOR_MARK (ptr); 5263 VECTOR_MARK (ptr);
@@ -5380,8 +5386,8 @@ mark_object (Lisp_Object arg)
5380 recursion there. */ 5386 recursion there. */
5381 { 5387 {
5382 register struct Lisp_Vector *ptr = XVECTOR (obj); 5388 register struct Lisp_Vector *ptr = XVECTOR (obj);
5383 register EMACS_INT size = ptr->size; 5389 register EMACS_UINT size = ptr->size;
5384 register int i; 5390 register EMACS_UINT i;
5385 5391
5386 CHECK_LIVE (live_vector_p); 5392 CHECK_LIVE (live_vector_p);
5387 VECTOR_MARK (ptr); /* Else mark it */ 5393 VECTOR_MARK (ptr); /* Else mark it */