diff options
| author | Miles Bader | 2008-02-01 16:01:31 +0000 |
|---|---|---|
| committer | Miles Bader | 2008-02-01 16:01:31 +0000 |
| commit | 6cc41fb06c37234822d5aedf7ce0f77b88bb450a (patch) | |
| tree | a130326faf29d4410ed126e4f0d6a13f11a19df3 /src/alloc.c | |
| parent | b502217bd845bc6280fd2bb1eacce176ed4f7d90 (diff) | |
| parent | dd559368b0db67654f643320b1d84afdabe60e97 (diff) | |
| download | emacs-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.c | 95 |
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 |
| 507 | static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag}; | 507 | static 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 | ||
| 3052 | DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0, | ||
| 3053 | doc: /* Return a newly created char-table, with purpose PURPOSE. | ||
| 3054 | Each element is initialized to INIT, which defaults to nil. | ||
| 3055 | PURPOSE should be a symbol which has a `char-table-extra-slots' property. | ||
| 3056 | The 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 | |||
| 3083 | Lisp_Object | ||
| 3084 | make_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 | |||
| 3097 | DEFUN ("vector", Fvector, Svector, 0, MANY, 0, | 3052 | DEFUN ("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. |
| 3099 | Any number of arguments, even zero arguments, are allowed. | 3054 | Any 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); |