aboutsummaryrefslogtreecommitdiffstats
path: root/src/alloc.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/alloc.c')
-rw-r--r--src/alloc.c206
1 files changed, 171 insertions, 35 deletions
diff --git a/src/alloc.c b/src/alloc.c
index e4b54aba864..c3e02c20f85 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2321,13 +2321,13 @@ a multibyte string even if INIT is an ASCII character. */)
2321 int c; 2321 int c;
2322 EMACS_INT nbytes; 2322 EMACS_INT nbytes;
2323 2323
2324 CHECK_NATNUM (length); 2324 CHECK_FIXNAT (length);
2325 CHECK_CHARACTER (init); 2325 CHECK_CHARACTER (init);
2326 2326
2327 c = XFASTINT (init); 2327 c = XFIXNAT (init);
2328 if (ASCII_CHAR_P (c) && NILP (multibyte)) 2328 if (ASCII_CHAR_P (c) && NILP (multibyte))
2329 { 2329 {
2330 nbytes = XINT (length); 2330 nbytes = XFIXNUM (length);
2331 val = make_uninit_string (nbytes); 2331 val = make_uninit_string (nbytes);
2332 if (nbytes) 2332 if (nbytes)
2333 { 2333 {
@@ -2339,7 +2339,7 @@ a multibyte string even if INIT is an ASCII character. */)
2339 { 2339 {
2340 unsigned char str[MAX_MULTIBYTE_LENGTH]; 2340 unsigned char str[MAX_MULTIBYTE_LENGTH];
2341 ptrdiff_t len = CHAR_STRING (c, str); 2341 ptrdiff_t len = CHAR_STRING (c, str);
2342 EMACS_INT string_len = XINT (length); 2342 EMACS_INT string_len = XFIXNUM (length);
2343 unsigned char *p, *beg, *end; 2343 unsigned char *p, *beg, *end;
2344 2344
2345 if (INT_MULTIPLY_WRAPV (len, string_len, &nbytes)) 2345 if (INT_MULTIPLY_WRAPV (len, string_len, &nbytes))
@@ -2415,8 +2415,8 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
2415{ 2415{
2416 Lisp_Object val; 2416 Lisp_Object val;
2417 2417
2418 CHECK_NATNUM (length); 2418 CHECK_FIXNAT (length);
2419 val = make_uninit_bool_vector (XFASTINT (length)); 2419 val = make_uninit_bool_vector (XFIXNAT (length));
2420 return bool_vector_fill (val, init); 2420 return bool_vector_fill (val, init);
2421} 2421}
2422 2422
@@ -2894,9 +2894,9 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
2894 (Lisp_Object length, Lisp_Object init) 2894 (Lisp_Object length, Lisp_Object init)
2895{ 2895{
2896 Lisp_Object val = Qnil; 2896 Lisp_Object val = Qnil;
2897 CHECK_NATNUM (length); 2897 CHECK_FIXNAT (length);
2898 2898
2899 for (EMACS_INT size = XFASTINT (length); 0 < size; size--) 2899 for (EMACS_INT size = XFIXNAT (length); 0 < size; size--)
2900 { 2900 {
2901 val = Fcons (init, val); 2901 val = Fcons (init, val);
2902 rarely_quit (size); 2902 rarely_quit (size);
@@ -3448,8 +3448,8 @@ symbol or a type descriptor. SLOTS is the number of non-type slots,
3448each initialized to INIT. */) 3448each initialized to INIT. */)
3449 (Lisp_Object type, Lisp_Object slots, Lisp_Object init) 3449 (Lisp_Object type, Lisp_Object slots, Lisp_Object init)
3450{ 3450{
3451 CHECK_NATNUM (slots); 3451 CHECK_FIXNAT (slots);
3452 EMACS_INT size = XFASTINT (slots) + 1; 3452 EMACS_INT size = XFIXNAT (slots) + 1;
3453 struct Lisp_Vector *p = allocate_record (size); 3453 struct Lisp_Vector *p = allocate_record (size);
3454 p->contents[0] = type; 3454 p->contents[0] = type;
3455 for (ptrdiff_t i = 1; i < size; i++) 3455 for (ptrdiff_t i = 1; i < size; i++)
@@ -3477,9 +3477,9 @@ DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
3477See also the function `vector'. */) 3477See also the function `vector'. */)
3478 (Lisp_Object length, Lisp_Object init) 3478 (Lisp_Object length, Lisp_Object init)
3479{ 3479{
3480 CHECK_NATNUM (length); 3480 CHECK_FIXNAT (length);
3481 struct Lisp_Vector *p = allocate_vector (XFASTINT (length)); 3481 struct Lisp_Vector *p = allocate_vector (XFIXNAT (length));
3482 for (ptrdiff_t i = 0; i < XFASTINT (length); i++) 3482 for (ptrdiff_t i = 0; i < XFIXNAT (length); i++)
3483 p->contents[i] = init; 3483 p->contents[i] = init;
3484 return make_lisp_ptr (p, Lisp_Vectorlike); 3484 return make_lisp_ptr (p, Lisp_Vectorlike);
3485} 3485}
@@ -3789,6 +3789,109 @@ build_marker (struct buffer *buf, ptrdiff_t charpos, ptrdiff_t bytepos)
3789} 3789}
3790 3790
3791 3791
3792
3793Lisp_Object
3794make_bignum_str (const char *num, int base)
3795{
3796 Lisp_Object obj;
3797 struct Lisp_Bignum *b;
3798 int check;
3799
3800 obj = allocate_misc (Lisp_Misc_Bignum);
3801 b = XBIGNUM (obj);
3802 mpz_init (b->value);
3803 check = mpz_set_str (b->value, num, base);
3804 eassert (check == 0);
3805 return obj;
3806}
3807
3808/* Given an mpz_t, make a number. This may return a bignum or a
3809 fixnum depending on VALUE. */
3810
3811Lisp_Object
3812make_number (mpz_t value)
3813{
3814 Lisp_Object obj;
3815 struct Lisp_Bignum *b;
3816
3817 if (mpz_fits_slong_p (value))
3818 {
3819 long l = mpz_get_si (value);
3820 if (!FIXNUM_OVERFLOW_P (l))
3821 {
3822 XSETINT (obj, l);
3823 return obj;
3824 }
3825 }
3826
3827 /* Check if fixnum can be larger than long. */
3828 if (sizeof (EMACS_INT) > sizeof (long))
3829 {
3830 size_t bits = mpz_sizeinbase (value, 2);
3831 int sign = mpz_sgn (value);
3832
3833 if (bits < FIXNUM_BITS + (sign < 0))
3834 {
3835 EMACS_INT v = 0;
3836 size_t limbs = mpz_size (value);
3837 mp_size_t i;
3838
3839 for (i = 0; i < limbs; i++)
3840 {
3841 mp_limb_t limb = mpz_getlimbn (value, i);
3842 v |= (EMACS_INT) ((EMACS_UINT) limb << (i * mp_bits_per_limb));
3843 }
3844 if (sign < 0)
3845 v = -v;
3846
3847 if (!FIXNUM_OVERFLOW_P (v))
3848 {
3849 XSETINT (obj, v);
3850 return obj;
3851 }
3852 }
3853 }
3854
3855 obj = allocate_misc (Lisp_Misc_Bignum);
3856 b = XBIGNUM (obj);
3857 /* We could mpz_init + mpz_swap here, to avoid a copy, but the
3858 resulting API seemed possibly confusing. */
3859 mpz_init_set (b->value, value);
3860
3861 return obj;
3862}
3863
3864void
3865mpz_set_intmax_slow (mpz_t result, intmax_t v)
3866{
3867 /* If long is larger then a faster path is taken. */
3868 eassert (sizeof (intmax_t) > sizeof (long));
3869
3870 bool negate = false;
3871 if (v < 0)
3872 {
3873 v = -v;
3874 negate = true;
3875 }
3876 mpz_set_uintmax_slow (result, (uintmax_t) v);
3877 if (negate)
3878 mpz_neg (result, result);
3879}
3880
3881void
3882mpz_set_uintmax_slow (mpz_t result, uintmax_t v)
3883{
3884 /* If long is larger then a faster path is taken. */
3885 eassert (sizeof (uintmax_t) > sizeof (unsigned long));
3886
3887 /* COUNT = 1 means just a single word of the given size. ORDER = -1
3888 is arbitrary since there's only a single word. ENDIAN = 0 means
3889 use the native endian-ness. NAILS = 0 means use the whole
3890 word. */
3891 mpz_import (result, 1, -1, sizeof (uintmax_t), 0, 0, &v);
3892}
3893
3894
3792/* Return a newly created vector or string with specified arguments as 3895/* Return a newly created vector or string with specified arguments as
3793 elements. If all the arguments are characters that can fit 3896 elements. If all the arguments are characters that can fit
3794 in a string of events, make a string; otherwise, make a vector. 3897 in a string of events, make a string; otherwise, make a vector.
@@ -3804,8 +3907,8 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args)
3804 /* The things that fit in a string 3907 /* The things that fit in a string
3805 are characters that are in 0...127, 3908 are characters that are in 0...127,
3806 after discarding the meta bit and all the bits above it. */ 3909 after discarding the meta bit and all the bits above it. */
3807 if (!INTEGERP (args[i]) 3910 if (!FIXNUMP (args[i])
3808 || (XINT (args[i]) & ~(-CHAR_META)) >= 0200) 3911 || (XFIXNUM (args[i]) & ~(-CHAR_META)) >= 0200)
3809 return Fvector (nargs, args); 3912 return Fvector (nargs, args);
3810 3913
3811 /* Since the loop exited, we know that all the things in it are 3914 /* Since the loop exited, we know that all the things in it are
@@ -3813,12 +3916,12 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args)
3813 { 3916 {
3814 Lisp_Object result; 3917 Lisp_Object result;
3815 3918
3816 result = Fmake_string (make_number (nargs), make_number (0), Qnil); 3919 result = Fmake_string (make_fixnum (nargs), make_fixnum (0), Qnil);
3817 for (i = 0; i < nargs; i++) 3920 for (i = 0; i < nargs; i++)
3818 { 3921 {
3819 SSET (result, i, XINT (args[i])); 3922 SSET (result, i, XFIXNUM (args[i]));
3820 /* Move the meta bit to the right place for a string char. */ 3923 /* Move the meta bit to the right place for a string char. */
3821 if (XINT (args[i]) & CHAR_META) 3924 if (XFIXNUM (args[i]) & CHAR_META)
3822 SSET (result, i, SREF (result, i) | 0x80); 3925 SSET (result, i, SREF (result, i) | 0x80);
3823 } 3926 }
3824 3927
@@ -4700,7 +4803,7 @@ mark_maybe_object (Lisp_Object obj)
4700 VALGRIND_MAKE_MEM_DEFINED (&obj, sizeof (obj)); 4803 VALGRIND_MAKE_MEM_DEFINED (&obj, sizeof (obj));
4701#endif 4804#endif
4702 4805
4703 if (INTEGERP (obj)) 4806 if (FIXNUMP (obj))
4704 return; 4807 return;
4705 4808
4706 void *po = XPNTR (obj); 4809 void *po = XPNTR (obj);
@@ -5180,7 +5283,7 @@ valid_pointer_p (void *p)
5180int 5283int
5181valid_lisp_object_p (Lisp_Object obj) 5284valid_lisp_object_p (Lisp_Object obj)
5182{ 5285{
5183 if (INTEGERP (obj)) 5286 if (FIXNUMP (obj))
5184 return 1; 5287 return 1;
5185 5288
5186 void *p = XPNTR (obj); 5289 void *p = XPNTR (obj);
@@ -5441,6 +5544,34 @@ make_pure_float (double num)
5441 return new; 5544 return new;
5442} 5545}
5443 5546
5547/* Value is a bignum object with value VALUE allocated from pure
5548 space. */
5549
5550static Lisp_Object
5551make_pure_bignum (struct Lisp_Bignum *value)
5552{
5553 Lisp_Object new;
5554 size_t i, nlimbs = mpz_size (value->value);
5555 size_t nbytes = nlimbs * sizeof (mp_limb_t);
5556 mp_limb_t *pure_limbs;
5557 mp_size_t new_size;
5558
5559 struct Lisp_Bignum *b = pure_alloc (sizeof (struct Lisp_Bignum), Lisp_Misc);
5560 b->type = Lisp_Misc_Bignum;
5561
5562 pure_limbs = pure_alloc (nbytes, -1);
5563 for (i = 0; i < nlimbs; ++i)
5564 pure_limbs[i] = mpz_getlimbn (value->value, i);
5565
5566 new_size = nlimbs;
5567 if (mpz_sgn (value->value) < 0)
5568 new_size = -new_size;
5569
5570 mpz_roinit_n (b->value, pure_limbs, new_size);
5571
5572 XSETMISC (new, b);
5573 return new;
5574}
5444 5575
5445/* Return a vector with room for LEN Lisp_Objects allocated from 5576/* Return a vector with room for LEN Lisp_Objects allocated from
5446 pure space. */ 5577 pure space. */
@@ -5513,7 +5644,7 @@ static struct pinned_object
5513static Lisp_Object 5644static Lisp_Object
5514purecopy (Lisp_Object obj) 5645purecopy (Lisp_Object obj)
5515{ 5646{
5516 if (INTEGERP (obj) 5647 if (FIXNUMP (obj)
5517 || (! SYMBOLP (obj) && PURE_P (XPNTR (obj))) 5648 || (! SYMBOLP (obj) && PURE_P (XPNTR (obj)))
5518 || SUBRP (obj)) 5649 || SUBRP (obj))
5519 return obj; /* Already pure. */ 5650 return obj; /* Already pure. */
@@ -5582,6 +5713,8 @@ purecopy (Lisp_Object obj)
5582 /* Don't hash-cons it. */ 5713 /* Don't hash-cons it. */
5583 return obj; 5714 return obj;
5584 } 5715 }
5716 else if (BIGNUMP (obj))
5717 obj = make_pure_bignum (XBIGNUM (obj));
5585 else 5718 else
5586 { 5719 {
5587 AUTO_STRING (fmt, "Don't know how to purify: %S"); 5720 AUTO_STRING (fmt, "Don't know how to purify: %S");
@@ -5623,7 +5756,7 @@ inhibit_garbage_collection (void)
5623{ 5756{
5624 ptrdiff_t count = SPECPDL_INDEX (); 5757 ptrdiff_t count = SPECPDL_INDEX ();
5625 5758
5626 specbind (Qgc_cons_threshold, make_number (MOST_POSITIVE_FIXNUM)); 5759 specbind (Qgc_cons_threshold, make_fixnum (MOST_POSITIVE_FIXNUM));
5627 return count; 5760 return count;
5628} 5761}
5629 5762
@@ -5633,7 +5766,7 @@ inhibit_garbage_collection (void)
5633static Lisp_Object 5766static Lisp_Object
5634bounded_number (EMACS_INT number) 5767bounded_number (EMACS_INT number)
5635{ 5768{
5636 return make_number (min (MOST_POSITIVE_FIXNUM, number)); 5769 return make_fixnum (min (MOST_POSITIVE_FIXNUM, number));
5637} 5770}
5638 5771
5639/* Calculate total bytes of live objects. */ 5772/* Calculate total bytes of live objects. */
@@ -5986,37 +6119,37 @@ garbage_collect_1 (void *end)
5986 unbind_to (count, Qnil); 6119 unbind_to (count, Qnil);
5987 6120
5988 Lisp_Object total[] = { 6121 Lisp_Object total[] = {
5989 list4 (Qconses, make_number (sizeof (struct Lisp_Cons)), 6122 list4 (Qconses, make_fixnum (sizeof (struct Lisp_Cons)),
5990 bounded_number (total_conses), 6123 bounded_number (total_conses),
5991 bounded_number (total_free_conses)), 6124 bounded_number (total_free_conses)),
5992 list4 (Qsymbols, make_number (sizeof (struct Lisp_Symbol)), 6125 list4 (Qsymbols, make_fixnum (sizeof (struct Lisp_Symbol)),
5993 bounded_number (total_symbols), 6126 bounded_number (total_symbols),
5994 bounded_number (total_free_symbols)), 6127 bounded_number (total_free_symbols)),
5995 list4 (Qmiscs, make_number (sizeof (union Lisp_Misc)), 6128 list4 (Qmiscs, make_fixnum (sizeof (union Lisp_Misc)),
5996 bounded_number (total_markers), 6129 bounded_number (total_markers),
5997 bounded_number (total_free_markers)), 6130 bounded_number (total_free_markers)),
5998 list4 (Qstrings, make_number (sizeof (struct Lisp_String)), 6131 list4 (Qstrings, make_fixnum (sizeof (struct Lisp_String)),
5999 bounded_number (total_strings), 6132 bounded_number (total_strings),
6000 bounded_number (total_free_strings)), 6133 bounded_number (total_free_strings)),
6001 list3 (Qstring_bytes, make_number (1), 6134 list3 (Qstring_bytes, make_fixnum (1),
6002 bounded_number (total_string_bytes)), 6135 bounded_number (total_string_bytes)),
6003 list3 (Qvectors, 6136 list3 (Qvectors,
6004 make_number (header_size + sizeof (Lisp_Object)), 6137 make_fixnum (header_size + sizeof (Lisp_Object)),
6005 bounded_number (total_vectors)), 6138 bounded_number (total_vectors)),
6006 list4 (Qvector_slots, make_number (word_size), 6139 list4 (Qvector_slots, make_fixnum (word_size),
6007 bounded_number (total_vector_slots), 6140 bounded_number (total_vector_slots),
6008 bounded_number (total_free_vector_slots)), 6141 bounded_number (total_free_vector_slots)),
6009 list4 (Qfloats, make_number (sizeof (struct Lisp_Float)), 6142 list4 (Qfloats, make_fixnum (sizeof (struct Lisp_Float)),
6010 bounded_number (total_floats), 6143 bounded_number (total_floats),
6011 bounded_number (total_free_floats)), 6144 bounded_number (total_free_floats)),
6012 list4 (Qintervals, make_number (sizeof (struct interval)), 6145 list4 (Qintervals, make_fixnum (sizeof (struct interval)),
6013 bounded_number (total_intervals), 6146 bounded_number (total_intervals),
6014 bounded_number (total_free_intervals)), 6147 bounded_number (total_free_intervals)),
6015 list3 (Qbuffers, make_number (sizeof (struct buffer)), 6148 list3 (Qbuffers, make_fixnum (sizeof (struct buffer)),
6016 bounded_number (total_buffers)), 6149 bounded_number (total_buffers)),
6017 6150
6018#ifdef DOUG_LEA_MALLOC 6151#ifdef DOUG_LEA_MALLOC
6019 list4 (Qheap, make_number (1024), 6152 list4 (Qheap, make_fixnum (1024),
6020 bounded_number ((mallinfo ().uordblks + 1023) >> 10), 6153 bounded_number ((mallinfo ().uordblks + 1023) >> 10),
6021 bounded_number ((mallinfo ().fordblks + 1023) >> 10)), 6154 bounded_number ((mallinfo ().fordblks + 1023) >> 10)),
6022#endif 6155#endif
@@ -6151,7 +6284,7 @@ mark_char_table (struct Lisp_Vector *ptr, enum pvec_type pvectype)
6151 { 6284 {
6152 Lisp_Object val = ptr->contents[i]; 6285 Lisp_Object val = ptr->contents[i];
6153 6286
6154 if (INTEGERP (val) || (SYMBOLP (val) && XSYMBOL (val)->u.s.gcmarkbit)) 6287 if (FIXNUMP (val) || (SYMBOLP (val) && XSYMBOL (val)->u.s.gcmarkbit))
6155 continue; 6288 continue;
6156 if (SUB_CHAR_TABLE_P (val)) 6289 if (SUB_CHAR_TABLE_P (val))
6157 { 6290 {
@@ -6563,6 +6696,7 @@ mark_object (Lisp_Object arg)
6563 break; 6696 break;
6564 6697
6565 case Lisp_Misc_Ptr: 6698 case Lisp_Misc_Ptr:
6699 case Lisp_Misc_Bignum:
6566 XMISCANY (obj)->gcmarkbit = true; 6700 XMISCANY (obj)->gcmarkbit = true;
6567 break; 6701 break;
6568 6702
@@ -6982,6 +7116,8 @@ sweep_misc (void)
6982 uptr->finalizer (uptr->p); 7116 uptr->finalizer (uptr->p);
6983 } 7117 }
6984#endif 7118#endif
7119 else if (mblk->markers[i].m.u_any.type == Lisp_Misc_Bignum)
7120 mpz_clear (mblk->markers[i].m.u_bignum.value);
6985 /* Set the type of the freed object to Lisp_Misc_Free. 7121 /* Set the type of the freed object to Lisp_Misc_Free.
6986 We could leave the type alone, since nobody checks it, 7122 We could leave the type alone, since nobody checks it,
6987 but this might catch bugs faster. */ 7123 but this might catch bugs faster. */