aboutsummaryrefslogtreecommitdiffstats
path: root/src/alloc.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/alloc.c')
-rw-r--r--src/alloc.c92
1 files changed, 52 insertions, 40 deletions
diff --git a/src/alloc.c b/src/alloc.c
index 1f615a7d505..5cbc7cfe411 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1644,7 +1644,7 @@ static int total_strings, total_free_strings;
1644 1644
1645/* Number of bytes used by live strings. */ 1645/* Number of bytes used by live strings. */
1646 1646
1647static int total_string_size; 1647static EMACS_INT total_string_size;
1648 1648
1649/* Given a pointer to a Lisp_String S which is on the free-list 1649/* 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 1650 string_free_list, return a pointer to its successor in the
@@ -1739,11 +1739,12 @@ static void check_sblock (struct sblock *);
1739 1739
1740/* Like GC_STRING_BYTES, but with debugging check. */ 1740/* Like GC_STRING_BYTES, but with debugging check. */
1741 1741
1742int 1742EMACS_INT
1743string_bytes (s) 1743string_bytes (struct Lisp_String *s)
1744 struct Lisp_String *s;
1745{ 1744{
1746 int nbytes = (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte); 1745 EMACS_INT nbytes =
1746 (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
1747
1747 if (!PURE_POINTER_P (s) 1748 if (!PURE_POINTER_P (s)
1748 && s->data 1749 && s->data
1749 && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s))) 1750 && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
@@ -1765,7 +1766,7 @@ check_sblock (b)
1765 { 1766 {
1766 /* Compute the next FROM here because copying below may 1767 /* Compute the next FROM here because copying below may
1767 overwrite data we need to compute it. */ 1768 overwrite data we need to compute it. */
1768 int nbytes; 1769 EMACS_INT nbytes;
1769 1770
1770 /* Check that the string size recorded in the string is the 1771 /* Check that the string size recorded in the string is the
1771 same as the one recorded in the sdata structure. */ 1772 same as the one recorded in the sdata structure. */
@@ -1825,7 +1826,7 @@ check_string_free_list ()
1825 s = string_free_list; 1826 s = string_free_list;
1826 while (s != NULL) 1827 while (s != NULL)
1827 { 1828 {
1828 if ((unsigned)s < 1024) 1829 if ((unsigned long)s < 1024)
1829 abort(); 1830 abort();
1830 s = NEXT_FREE_LISP_STRING (s); 1831 s = NEXT_FREE_LISP_STRING (s);
1831 } 1832 }
@@ -1908,11 +1909,12 @@ allocate_string (void)
1908 S->data if it was initially non-null. */ 1909 S->data if it was initially non-null. */
1909 1910
1910void 1911void
1911allocate_string_data (struct Lisp_String *s, int nchars, int nbytes) 1912allocate_string_data (struct Lisp_String *s,
1913 EMACS_INT nchars, EMACS_INT nbytes)
1912{ 1914{
1913 struct sdata *data, *old_data; 1915 struct sdata *data, *old_data;
1914 struct sblock *b; 1916 struct sblock *b;
1915 int needed, old_nbytes; 1917 EMACS_INT needed, old_nbytes;
1916 1918
1917 /* Determine the number of bytes needed to store NBYTES bytes 1919 /* Determine the number of bytes needed to store NBYTES bytes
1918 of string data. */ 1920 of string data. */
@@ -2154,7 +2156,7 @@ compact_small_strings (void)
2154 { 2156 {
2155 /* Compute the next FROM here because copying below may 2157 /* Compute the next FROM here because copying below may
2156 overwrite data we need to compute it. */ 2158 overwrite data we need to compute it. */
2157 int nbytes; 2159 EMACS_INT nbytes;
2158 2160
2159#ifdef GC_CHECK_STRING_BYTES 2161#ifdef GC_CHECK_STRING_BYTES
2160 /* Check that the string size recorded in the string is the 2162 /* Check that the string size recorded in the string is the
@@ -2232,7 +2234,8 @@ INIT must be an integer that represents a character. */)
2232{ 2234{
2233 register Lisp_Object val; 2235 register Lisp_Object val;
2234 register unsigned char *p, *end; 2236 register unsigned char *p, *end;
2235 int c, nbytes; 2237 int c;
2238 EMACS_INT nbytes;
2236 2239
2237 CHECK_NATNUM (length); 2240 CHECK_NATNUM (length);
2238 CHECK_NUMBER (init); 2241 CHECK_NUMBER (init);
@@ -2251,9 +2254,12 @@ INIT must be an integer that represents a character. */)
2251 { 2254 {
2252 unsigned char str[MAX_MULTIBYTE_LENGTH]; 2255 unsigned char str[MAX_MULTIBYTE_LENGTH];
2253 int len = CHAR_STRING (c, str); 2256 int len = CHAR_STRING (c, str);
2257 EMACS_INT string_len = XINT (length);
2254 2258
2255 nbytes = len * XINT (length); 2259 if (string_len > MOST_POSITIVE_FIXNUM / len)
2256 val = make_uninit_multibyte_string (XINT (length), nbytes); 2260 error ("Maximum string size exceeded");
2261 nbytes = len * string_len;
2262 val = make_uninit_multibyte_string (string_len, nbytes);
2257 p = SDATA (val); 2263 p = SDATA (val);
2258 end = p + nbytes; 2264 end = p + nbytes;
2259 while (p != end) 2265 while (p != end)
@@ -2276,7 +2282,8 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
2276 register Lisp_Object val; 2282 register Lisp_Object val;
2277 struct Lisp_Bool_Vector *p; 2283 struct Lisp_Bool_Vector *p;
2278 int real_init, i; 2284 int real_init, i;
2279 int length_in_chars, length_in_elts, bits_per_value; 2285 EMACS_INT length_in_chars, length_in_elts;
2286 int bits_per_value;
2280 2287
2281 CHECK_NATNUM (length); 2288 CHECK_NATNUM (length);
2282 2289
@@ -2316,10 +2323,10 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
2316 multibyte, depending on the contents. */ 2323 multibyte, depending on the contents. */
2317 2324
2318Lisp_Object 2325Lisp_Object
2319make_string (const char *contents, int nbytes) 2326make_string (const char *contents, EMACS_INT nbytes)
2320{ 2327{
2321 register Lisp_Object val; 2328 register Lisp_Object val;
2322 int nchars, multibyte_nbytes; 2329 EMACS_INT nchars, multibyte_nbytes;
2323 2330
2324 parse_str_as_multibyte (contents, nbytes, &nchars, &multibyte_nbytes); 2331 parse_str_as_multibyte (contents, nbytes, &nchars, &multibyte_nbytes);
2325 if (nbytes == nchars || nbytes != multibyte_nbytes) 2332 if (nbytes == nchars || nbytes != multibyte_nbytes)
@@ -2335,7 +2342,7 @@ make_string (const char *contents, int nbytes)
2335/* Make an unibyte string from LENGTH bytes at CONTENTS. */ 2342/* Make an unibyte string from LENGTH bytes at CONTENTS. */
2336 2343
2337Lisp_Object 2344Lisp_Object
2338make_unibyte_string (const char *contents, int length) 2345make_unibyte_string (const char *contents, EMACS_INT length)
2339{ 2346{
2340 register Lisp_Object val; 2347 register Lisp_Object val;
2341 val = make_uninit_string (length); 2348 val = make_uninit_string (length);
@@ -2349,7 +2356,8 @@ make_unibyte_string (const char *contents, int length)
2349 bytes at CONTENTS. */ 2356 bytes at CONTENTS. */
2350 2357
2351Lisp_Object 2358Lisp_Object
2352make_multibyte_string (const char *contents, int nchars, int nbytes) 2359make_multibyte_string (const char *contents,
2360 EMACS_INT nchars, EMACS_INT nbytes)
2353{ 2361{
2354 register Lisp_Object val; 2362 register Lisp_Object val;
2355 val = make_uninit_multibyte_string (nchars, nbytes); 2363 val = make_uninit_multibyte_string (nchars, nbytes);
@@ -2362,7 +2370,8 @@ make_multibyte_string (const char *contents, int nchars, int nbytes)
2362 CONTENTS. It is a multibyte string if NBYTES != NCHARS. */ 2370 CONTENTS. It is a multibyte string if NBYTES != NCHARS. */
2363 2371
2364Lisp_Object 2372Lisp_Object
2365make_string_from_bytes (const char *contents, int nchars, int nbytes) 2373make_string_from_bytes (const char *contents,
2374 EMACS_INT nchars, EMACS_INT nbytes)
2366{ 2375{
2367 register Lisp_Object val; 2376 register Lisp_Object val;
2368 val = make_uninit_multibyte_string (nchars, nbytes); 2377 val = make_uninit_multibyte_string (nchars, nbytes);
@@ -2379,7 +2388,8 @@ make_string_from_bytes (const char *contents, int nchars, int nbytes)
2379 characters by itself. */ 2388 characters by itself. */
2380 2389
2381Lisp_Object 2390Lisp_Object
2382make_specified_string (const char *contents, int nchars, int nbytes, int multibyte) 2391make_specified_string (const char *contents,
2392 EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
2383{ 2393{
2384 register Lisp_Object val; 2394 register Lisp_Object val;
2385 2395
@@ -2412,7 +2422,7 @@ build_string (const char *str)
2412 occupying LENGTH bytes. */ 2422 occupying LENGTH bytes. */
2413 2423
2414Lisp_Object 2424Lisp_Object
2415make_uninit_string (int length) 2425make_uninit_string (EMACS_INT length)
2416{ 2426{
2417 Lisp_Object val; 2427 Lisp_Object val;
2418 2428
@@ -2428,7 +2438,7 @@ make_uninit_string (int length)
2428 which occupy NBYTES bytes. */ 2438 which occupy NBYTES bytes. */
2429 2439
2430Lisp_Object 2440Lisp_Object
2431make_uninit_multibyte_string (int nchars, int nbytes) 2441make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
2432{ 2442{
2433 Lisp_Object string; 2443 Lisp_Object string;
2434 struct Lisp_String *s; 2444 struct Lisp_String *s;
@@ -2767,7 +2777,7 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
2767 (register Lisp_Object length, Lisp_Object init) 2777 (register Lisp_Object length, Lisp_Object init)
2768{ 2778{
2769 register Lisp_Object val; 2779 register Lisp_Object val;
2770 register int size; 2780 register EMACS_INT size;
2771 2781
2772 CHECK_NATNUM (length); 2782 CHECK_NATNUM (length);
2773 size = XFASTINT (length); 2783 size = XFASTINT (length);
@@ -2945,7 +2955,7 @@ See also the function `vector'. */)
2945{ 2955{
2946 Lisp_Object vector; 2956 Lisp_Object vector;
2947 register EMACS_INT sizei; 2957 register EMACS_INT sizei;
2948 register int index; 2958 register EMACS_INT index;
2949 register struct Lisp_Vector *p; 2959 register struct Lisp_Vector *p;
2950 2960
2951 CHECK_NATNUM (length); 2961 CHECK_NATNUM (length);
@@ -3785,7 +3795,7 @@ live_string_p (struct mem_node *m, void *p)
3785 if (m->type == MEM_TYPE_STRING) 3795 if (m->type == MEM_TYPE_STRING)
3786 { 3796 {
3787 struct string_block *b = (struct string_block *) m->start; 3797 struct string_block *b = (struct string_block *) m->start;
3788 int offset = (char *) p - (char *) &b->strings[0]; 3798 ptrdiff_t offset = (char *) p - (char *) &b->strings[0];
3789 3799
3790 /* P must point to the start of a Lisp_String structure, and it 3800 /* P must point to the start of a Lisp_String structure, and it
3791 must not be on the free-list. */ 3801 must not be on the free-list. */
@@ -3808,7 +3818,7 @@ live_cons_p (struct mem_node *m, void *p)
3808 if (m->type == MEM_TYPE_CONS) 3818 if (m->type == MEM_TYPE_CONS)
3809 { 3819 {
3810 struct cons_block *b = (struct cons_block *) m->start; 3820 struct cons_block *b = (struct cons_block *) m->start;
3811 int offset = (char *) p - (char *) &b->conses[0]; 3821 ptrdiff_t offset = (char *) p - (char *) &b->conses[0];
3812 3822
3813 /* P must point to the start of a Lisp_Cons, not be 3823 /* P must point to the start of a Lisp_Cons, not be
3814 one of the unused cells in the current cons block, 3824 one of the unused cells in the current cons block,
@@ -3834,7 +3844,7 @@ live_symbol_p (struct mem_node *m, void *p)
3834 if (m->type == MEM_TYPE_SYMBOL) 3844 if (m->type == MEM_TYPE_SYMBOL)
3835 { 3845 {
3836 struct symbol_block *b = (struct symbol_block *) m->start; 3846 struct symbol_block *b = (struct symbol_block *) m->start;
3837 int offset = (char *) p - (char *) &b->symbols[0]; 3847 ptrdiff_t offset = (char *) p - (char *) &b->symbols[0];
3838 3848
3839 /* P must point to the start of a Lisp_Symbol, not be 3849 /* P must point to the start of a Lisp_Symbol, not be
3840 one of the unused cells in the current symbol block, 3850 one of the unused cells in the current symbol block,
@@ -3860,7 +3870,7 @@ live_float_p (struct mem_node *m, void *p)
3860 if (m->type == MEM_TYPE_FLOAT) 3870 if (m->type == MEM_TYPE_FLOAT)
3861 { 3871 {
3862 struct float_block *b = (struct float_block *) m->start; 3872 struct float_block *b = (struct float_block *) m->start;
3863 int offset = (char *) p - (char *) &b->floats[0]; 3873 ptrdiff_t offset = (char *) p - (char *) &b->floats[0];
3864 3874
3865 /* P must point to the start of a Lisp_Float and not be 3875 /* P must point to the start of a Lisp_Float and not be
3866 one of the unused cells in the current float block. */ 3876 one of the unused cells in the current float block. */
@@ -3884,7 +3894,7 @@ live_misc_p (struct mem_node *m, void *p)
3884 if (m->type == MEM_TYPE_MISC) 3894 if (m->type == MEM_TYPE_MISC)
3885 { 3895 {
3886 struct marker_block *b = (struct marker_block *) m->start; 3896 struct marker_block *b = (struct marker_block *) m->start;
3887 int offset = (char *) p - (char *) &b->markers[0]; 3897 ptrdiff_t offset = (char *) p - (char *) &b->markers[0];
3888 3898
3889 /* P must point to the start of a Lisp_Misc, not be 3899 /* P must point to the start of a Lisp_Misc, not be
3890 one of the unused cells in the current misc block, 3900 one of the unused cells in the current misc block,
@@ -4591,9 +4601,10 @@ check_pure_size (void)
4591 address. Return NULL if not found. */ 4601 address. Return NULL if not found. */
4592 4602
4593static char * 4603static char *
4594find_string_data_in_pure (const char *data, int nbytes) 4604find_string_data_in_pure (const char *data, EMACS_INT nbytes)
4595{ 4605{
4596 int i, skip, bm_skip[256], last_char_skip, infinity, start, start_max; 4606 int i;
4607 EMACS_INT skip, bm_skip[256], last_char_skip, infinity, start, start_max;
4597 const unsigned char *p; 4608 const unsigned char *p;
4598 char *non_lisp_beg; 4609 char *non_lisp_beg;
4599 4610
@@ -4660,7 +4671,8 @@ find_string_data_in_pure (const char *data, int nbytes)
4660 string; then the string is not protected from gc. */ 4671 string; then the string is not protected from gc. */
4661 4672
4662Lisp_Object 4673Lisp_Object
4663make_pure_string (const char *data, int nchars, int nbytes, int multibyte) 4674make_pure_string (const char *data,
4675 EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
4664{ 4676{
4665 Lisp_Object string; 4677 Lisp_Object string;
4666 struct Lisp_String *s; 4678 struct Lisp_String *s;
@@ -4688,7 +4700,7 @@ make_pure_c_string (const char *data)
4688{ 4700{
4689 Lisp_Object string; 4701 Lisp_Object string;
4690 struct Lisp_String *s; 4702 struct Lisp_String *s;
4691 int nchars = strlen (data); 4703 EMACS_INT nchars = strlen (data);
4692 4704
4693 s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String); 4705 s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
4694 s->size = nchars; 4706 s->size = nchars;
@@ -4778,7 +4790,7 @@ Does not copy symbols. Copies strings without text properties. */)
4778 else if (COMPILEDP (obj) || VECTORP (obj)) 4790 else if (COMPILEDP (obj) || VECTORP (obj))
4779 { 4791 {
4780 register struct Lisp_Vector *vec; 4792 register struct Lisp_Vector *vec;
4781 register int i; 4793 register EMACS_INT i;
4782 EMACS_INT size; 4794 EMACS_INT size;
4783 4795
4784 size = XVECTOR (obj)->size; 4796 size = XVECTOR (obj)->size;
@@ -5227,8 +5239,8 @@ static int mark_object_loop_halt;
5227static void 5239static void
5228mark_vectorlike (struct Lisp_Vector *ptr) 5240mark_vectorlike (struct Lisp_Vector *ptr)
5229{ 5241{
5230 register EMACS_INT size = ptr->size; 5242 register EMACS_UINT size = ptr->size;
5231 register int i; 5243 register EMACS_UINT i;
5232 5244
5233 eassert (!VECTOR_MARKED_P (ptr)); 5245 eassert (!VECTOR_MARKED_P (ptr));
5234 VECTOR_MARK (ptr); /* Else mark it */ 5246 VECTOR_MARK (ptr); /* Else mark it */
@@ -5250,8 +5262,8 @@ mark_vectorlike (struct Lisp_Vector *ptr)
5250static void 5262static void
5251mark_char_table (struct Lisp_Vector *ptr) 5263mark_char_table (struct Lisp_Vector *ptr)
5252{ 5264{
5253 register EMACS_INT size = ptr->size & PSEUDOVECTOR_SIZE_MASK; 5265 register EMACS_UINT size = ptr->size & PSEUDOVECTOR_SIZE_MASK;
5254 register int i; 5266 register EMACS_UINT i;
5255 5267
5256 eassert (!VECTOR_MARKED_P (ptr)); 5268 eassert (!VECTOR_MARKED_P (ptr));
5257 VECTOR_MARK (ptr); 5269 VECTOR_MARK (ptr);
@@ -5380,8 +5392,8 @@ mark_object (Lisp_Object arg)
5380 recursion there. */ 5392 recursion there. */
5381 { 5393 {
5382 register struct Lisp_Vector *ptr = XVECTOR (obj); 5394 register struct Lisp_Vector *ptr = XVECTOR (obj);
5383 register EMACS_INT size = ptr->size; 5395 register EMACS_UINT size = ptr->size;
5384 register int i; 5396 register EMACS_UINT i;
5385 5397
5386 CHECK_LIVE (live_vector_p); 5398 CHECK_LIVE (live_vector_p);
5387 VECTOR_MARK (ptr); /* Else mark it */ 5399 VECTOR_MARK (ptr); /* Else mark it */