aboutsummaryrefslogtreecommitdiffstats
path: root/src/alloc.c
diff options
context:
space:
mode:
authorMiles Bader2008-02-01 16:01:31 +0000
committerMiles Bader2008-02-01 16:01:31 +0000
commit6cc41fb06c37234822d5aedf7ce0f77b88bb450a (patch)
treea130326faf29d4410ed126e4f0d6a13f11a19df3 /src/alloc.c
parentb502217bd845bc6280fd2bb1eacce176ed4f7d90 (diff)
parentdd559368b0db67654f643320b1d84afdabe60e97 (diff)
downloademacs-6cc41fb06c37234822d5aedf7ce0f77b88bb450a.tar.gz
emacs-6cc41fb06c37234822d5aedf7ce0f77b88bb450a.zip
Merge unicode branch
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1037
Diffstat (limited to 'src/alloc.c')
-rw-r--r--src/alloc.c95
1 files changed, 25 insertions, 70 deletions
diff --git a/src/alloc.c b/src/alloc.c
index 86a48e4dd18..c1ebd0cf2a3 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -54,7 +54,7 @@ Boston, MA 02110-1301, USA. */
54#include "keyboard.h" 54#include "keyboard.h"
55#include "frame.h" 55#include "frame.h"
56#include "blockinput.h" 56#include "blockinput.h"
57#include "charset.h" 57#include "character.h"
58#include "syssignal.h" 58#include "syssignal.h"
59#include "termhooks.h" /* For struct terminal. */ 59#include "termhooks.h" /* For struct terminal. */
60#include <setjmp.h> 60#include <setjmp.h>
@@ -503,7 +503,7 @@ struct gcpro *gcprolist;
503/* Addresses of staticpro'd variables. Initialize it to a nonzero 503/* Addresses of staticpro'd variables. Initialize it to a nonzero
504 value; otherwise some compilers put it into BSS. */ 504 value; otherwise some compilers put it into BSS. */
505 505
506#define NSTATICS 1280 506#define NSTATICS 0x600
507static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag}; 507static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
508 508
509/* Index of next unused slot in staticvec. */ 509/* Index of next unused slot in staticvec. */
@@ -2285,7 +2285,7 @@ INIT must be an integer that represents a character. */)
2285 CHECK_NUMBER (init); 2285 CHECK_NUMBER (init);
2286 2286
2287 c = XINT (init); 2287 c = XINT (init);
2288 if (SINGLE_BYTE_CHAR_P (c)) 2288 if (ASCII_CHAR_P (c))
2289 { 2289 {
2290 nbytes = XINT (length); 2290 nbytes = XINT (length);
2291 val = make_uninit_string (nbytes); 2291 val = make_uninit_string (nbytes);
@@ -3049,51 +3049,6 @@ See also the function `vector'. */)
3049} 3049}
3050 3050
3051 3051
3052DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
3053 doc: /* Return a newly created char-table, with purpose PURPOSE.
3054Each element is initialized to INIT, which defaults to nil.
3055PURPOSE should be a symbol which has a `char-table-extra-slots' property.
3056The property's value should be an integer between 0 and 10. */)
3057 (purpose, init)
3058 register Lisp_Object purpose, init;
3059{
3060 Lisp_Object vector;
3061 Lisp_Object n;
3062 CHECK_SYMBOL (purpose);
3063 n = Fget (purpose, Qchar_table_extra_slots);
3064 CHECK_NUMBER (n);
3065 if (XINT (n) < 0 || XINT (n) > 10)
3066 args_out_of_range (n, Qnil);
3067 /* Add 2 to the size for the defalt and parent slots. */
3068 vector = Fmake_vector (make_number (CHAR_TABLE_STANDARD_SLOTS + XINT (n)),
3069 init);
3070 XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE);
3071 XCHAR_TABLE (vector)->top = Qt;
3072 XCHAR_TABLE (vector)->parent = Qnil;
3073 XCHAR_TABLE (vector)->purpose = purpose;
3074 XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
3075 return vector;
3076}
3077
3078
3079/* Return a newly created sub char table with slots initialized by INIT.
3080 Since a sub char table does not appear as a top level Emacs Lisp
3081 object, we don't need a Lisp interface to make it. */
3082
3083Lisp_Object
3084make_sub_char_table (init)
3085 Lisp_Object init;
3086{
3087 Lisp_Object vector
3088 = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), init);
3089 XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE);
3090 XCHAR_TABLE (vector)->top = Qnil;
3091 XCHAR_TABLE (vector)->defalt = Qnil;
3092 XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
3093 return vector;
3094}
3095
3096
3097DEFUN ("vector", Fvector, Svector, 0, MANY, 0, 3052DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
3098 doc: /* Return a newly created vector with specified arguments as elements. 3053 doc: /* Return a newly created vector with specified arguments as elements.
3099Any number of arguments, even zero arguments, are allowed. 3054Any number of arguments, even zero arguments, are allowed.
@@ -4158,7 +4113,7 @@ mark_maybe_object (obj)
4158 { 4113 {
4159 int mark_p = 0; 4114 int mark_p = 0;
4160 4115
4161 switch (XGCTYPE (obj)) 4116 switch (XTYPE (obj))
4162 { 4117 {
4163 case Lisp_String: 4118 case Lisp_String:
4164 mark_p = (live_string_p (m, po) 4119 mark_p = (live_string_p (m, po)
@@ -4178,13 +4133,13 @@ mark_maybe_object (obj)
4178 break; 4133 break;
4179 4134
4180 case Lisp_Vectorlike: 4135 case Lisp_Vectorlike:
4181 /* Note: can't check GC_BUFFERP before we know it's a 4136 /* Note: can't check BUFFERP before we know it's a
4182 buffer because checking that dereferences the pointer 4137 buffer because checking that dereferences the pointer
4183 PO which might point anywhere. */ 4138 PO which might point anywhere. */
4184 if (live_vector_p (m, po)) 4139 if (live_vector_p (m, po))
4185 mark_p = !GC_SUBRP (obj) && !VECTOR_MARKED_P (XVECTOR (obj)); 4140 mark_p = !SUBRP (obj) && !VECTOR_MARKED_P (XVECTOR (obj));
4186 else if (live_buffer_p (m, po)) 4141 else if (live_buffer_p (m, po))
4187 mark_p = GC_BUFFERP (obj) && !VECTOR_MARKED_P (XBUFFER (obj)); 4142 mark_p = BUFFERP (obj) && !VECTOR_MARKED_P (XBUFFER (obj));
4188 break; 4143 break;
4189 4144
4190 case Lisp_Misc: 4145 case Lisp_Misc:
@@ -4275,7 +4230,7 @@ mark_maybe_pointer (p)
4275 { 4230 {
4276 Lisp_Object tem; 4231 Lisp_Object tem;
4277 XSETVECTOR (tem, p); 4232 XSETVECTOR (tem, p);
4278 if (!GC_SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem))) 4233 if (!SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem)))
4279 obj = tem; 4234 obj = tem;
4280 } 4235 }
4281 break; 4236 break;
@@ -4284,7 +4239,7 @@ mark_maybe_pointer (p)
4284 abort (); 4239 abort ();
4285 } 4240 }
4286 4241
4287 if (!GC_NILP (obj)) 4242 if (!NILP (obj))
4288 mark_object (obj); 4243 mark_object (obj);
4289 } 4244 }
4290} 4245}
@@ -5048,7 +5003,8 @@ returns nil, because real GC can't be done. */)
5048 truncate_undo_list (nextb); 5003 truncate_undo_list (nextb);
5049 5004
5050 /* Shrink buffer gaps, but skip indirect and dead buffers. */ 5005 /* Shrink buffer gaps, but skip indirect and dead buffers. */
5051 if (nextb->base_buffer == 0 && !NILP (nextb->name)) 5006 if (nextb->base_buffer == 0 && !NILP (nextb->name)
5007 && ! nextb->text->inhibit_shrinking)
5052 { 5008 {
5053 /* If a buffer's gap size is more than 10% of the buffer 5009 /* If a buffer's gap size is more than 10% of the buffer
5054 size, or larger than 2000 bytes, then shrink it 5010 size, or larger than 2000 bytes, then shrink it
@@ -5187,8 +5143,8 @@ returns nil, because real GC can't be done. */)
5187 prev = Qnil; 5143 prev = Qnil;
5188 while (CONSP (tail)) 5144 while (CONSP (tail))
5189 { 5145 {
5190 if (GC_CONSP (XCAR (tail)) 5146 if (CONSP (XCAR (tail))
5191 && GC_MARKERP (XCAR (XCAR (tail))) 5147 && MARKERP (XCAR (XCAR (tail)))
5192 && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit) 5148 && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
5193 { 5149 {
5194 if (NILP (prev)) 5150 if (NILP (prev))
@@ -5337,7 +5293,7 @@ mark_glyph_matrix (matrix)
5337 struct glyph *end_glyph = glyph + row->used[area]; 5293 struct glyph *end_glyph = glyph + row->used[area];
5338 5294
5339 for (; glyph < end_glyph; ++glyph) 5295 for (; glyph < end_glyph; ++glyph)
5340 if (GC_STRINGP (glyph->object) 5296 if (STRINGP (glyph->object)
5341 && !STRING_MARKED_P (XSTRING (glyph->object))) 5297 && !STRING_MARKED_P (XSTRING (glyph->object)))
5342 mark_object (glyph->object); 5298 mark_object (glyph->object);
5343 } 5299 }
@@ -5493,7 +5449,7 @@ mark_object (arg)
5493 5449
5494#endif /* not GC_CHECK_MARKED_OBJECTS */ 5450#endif /* not GC_CHECK_MARKED_OBJECTS */
5495 5451
5496 switch (SWITCH_ENUM_CAST (XGCTYPE (obj))) 5452 switch (SWITCH_ENUM_CAST (XTYPE (obj)))
5497 { 5453 {
5498 case Lisp_String: 5454 case Lisp_String:
5499 { 5455 {
@@ -5512,13 +5468,13 @@ mark_object (arg)
5512 case Lisp_Vectorlike: 5468 case Lisp_Vectorlike:
5513#ifdef GC_CHECK_MARKED_OBJECTS 5469#ifdef GC_CHECK_MARKED_OBJECTS
5514 m = mem_find (po); 5470 m = mem_find (po);
5515 if (m == MEM_NIL && !GC_SUBRP (obj) 5471 if (m == MEM_NIL && !SUBRP (obj)
5516 && po != &buffer_defaults 5472 && po != &buffer_defaults
5517 && po != &buffer_local_symbols) 5473 && po != &buffer_local_symbols)
5518 abort (); 5474 abort ();
5519#endif /* GC_CHECK_MARKED_OBJECTS */ 5475#endif /* GC_CHECK_MARKED_OBJECTS */
5520 5476
5521 if (GC_BUFFERP (obj)) 5477 if (BUFFERP (obj))
5522 { 5478 {
5523 if (!VECTOR_MARKED_P (XBUFFER (obj))) 5479 if (!VECTOR_MARKED_P (XBUFFER (obj)))
5524 { 5480 {
@@ -5535,9 +5491,9 @@ mark_object (arg)
5535 mark_buffer (obj); 5491 mark_buffer (obj);
5536 } 5492 }
5537 } 5493 }
5538 else if (GC_SUBRP (obj)) 5494 else if (SUBRP (obj))
5539 break; 5495 break;
5540 else if (GC_COMPILEDP (obj)) 5496 else if (COMPILEDP (obj))
5541 /* We could treat this just like a vector, but it is better to 5497 /* We could treat this just like a vector, but it is better to
5542 save the COMPILED_CONSTANTS element for last and avoid 5498 save the COMPILED_CONSTANTS element for last and avoid
5543 recursion there. */ 5499 recursion there. */
@@ -5560,7 +5516,7 @@ mark_object (arg)
5560 obj = ptr->contents[COMPILED_CONSTANTS]; 5516 obj = ptr->contents[COMPILED_CONSTANTS];
5561 goto loop; 5517 goto loop;
5562 } 5518 }
5563 else if (GC_FRAMEP (obj)) 5519 else if (FRAMEP (obj))
5564 { 5520 {
5565 register struct frame *ptr = XFRAME (obj); 5521 register struct frame *ptr = XFRAME (obj);
5566 if (mark_vectorlike (XVECTOR (obj))) 5522 if (mark_vectorlike (XVECTOR (obj)))
@@ -5571,7 +5527,7 @@ mark_object (arg)
5571#endif /* HAVE_WINDOW_SYSTEM */ 5527#endif /* HAVE_WINDOW_SYSTEM */
5572 } 5528 }
5573 } 5529 }
5574 else if (GC_WINDOWP (obj)) 5530 else if (WINDOWP (obj))
5575 { 5531 {
5576 register struct Lisp_Vector *ptr = XVECTOR (obj); 5532 register struct Lisp_Vector *ptr = XVECTOR (obj);
5577 struct window *w = XWINDOW (obj); 5533 struct window *w = XWINDOW (obj);
@@ -5589,13 +5545,13 @@ mark_object (arg)
5589 } 5545 }
5590 } 5546 }
5591 } 5547 }
5592 else if (GC_HASH_TABLE_P (obj)) 5548 else if (HASH_TABLE_P (obj))
5593 { 5549 {
5594 struct Lisp_Hash_Table *h = XHASH_TABLE (obj); 5550 struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
5595 if (mark_vectorlike ((struct Lisp_Vector *)h)) 5551 if (mark_vectorlike ((struct Lisp_Vector *)h))
5596 { /* If hash table is not weak, mark all keys and values. 5552 { /* If hash table is not weak, mark all keys and values.
5597 For weak tables, mark only the vector. */ 5553 For weak tables, mark only the vector. */
5598 if (GC_NILP (h->weak)) 5554 if (NILP (h->weak))
5599 mark_object (h->key_and_value); 5555 mark_object (h->key_and_value);
5600 else 5556 else
5601 VECTOR_MARK (XVECTOR (h->key_and_value)); 5557 VECTOR_MARK (XVECTOR (h->key_and_value));
@@ -5817,7 +5773,7 @@ survives_gc_p (obj)
5817{ 5773{
5818 int survives_p; 5774 int survives_p;
5819 5775
5820 switch (XGCTYPE (obj)) 5776 switch (XTYPE (obj))
5821 { 5777 {
5822 case Lisp_Int: 5778 case Lisp_Int:
5823 survives_p = 1; 5779 survives_p = 1;
@@ -5836,7 +5792,7 @@ survives_gc_p (obj)
5836 break; 5792 break;
5837 5793
5838 case Lisp_Vectorlike: 5794 case Lisp_Vectorlike:
5839 survives_p = GC_SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj)); 5795 survives_p = SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj));
5840 break; 5796 break;
5841 5797
5842 case Lisp_Cons: 5798 case Lisp_Cons:
@@ -6446,7 +6402,6 @@ The time is in seconds as a floating point value. */);
6446 defsubr (&Smake_byte_code); 6402 defsubr (&Smake_byte_code);
6447 defsubr (&Smake_list); 6403 defsubr (&Smake_list);
6448 defsubr (&Smake_vector); 6404 defsubr (&Smake_vector);
6449 defsubr (&Smake_char_table);
6450 defsubr (&Smake_string); 6405 defsubr (&Smake_string);
6451 defsubr (&Smake_bool_vector); 6406 defsubr (&Smake_bool_vector);
6452 defsubr (&Smake_symbol); 6407 defsubr (&Smake_symbol);