Mercurial > emacs
comparison src/alloc.c @ 9261:e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Fmake_marker, make_uninit_string, make_pure_string, pure_cons,
make_pure_float, make_pure_vector, mark_buffer, gc_sweep, compact_strings,
Fmemory_limit): Use new accessor macros instead of calling XSET directly.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Tue, 04 Oct 1994 11:47:46 +0000 |
parents | 0e29f6a4fe7c |
children | 17d393a8eed6 |
comparison
equal
deleted
inserted
replaced
9260:945ddb4e9e24 | 9261:e5ba7993d378 |
---|---|
40 is the amount of space within which objects can start. */ | 40 is the amount of space within which objects can start. */ |
41 #define VALIDATE_LISP_STORAGE(address, size) \ | 41 #define VALIDATE_LISP_STORAGE(address, size) \ |
42 do \ | 42 do \ |
43 { \ | 43 { \ |
44 Lisp_Object val; \ | 44 Lisp_Object val; \ |
45 XSET (val, Lisp_Cons, (char *) address + size); \ | 45 XSETCONS (val, (char *) address + size); \ |
46 if ((char *) XCONS (val) != (char *) address + size) \ | 46 if ((char *) XCONS (val) != (char *) address + size) \ |
47 { \ | 47 { \ |
48 xfree (address); \ | 48 xfree (address); \ |
49 memory_full (); \ | 49 memory_full (); \ |
50 } \ | 50 } \ |
445 { | 445 { |
446 register Lisp_Object val; | 446 register Lisp_Object val; |
447 | 447 |
448 if (float_free_list) | 448 if (float_free_list) |
449 { | 449 { |
450 XSET (val, Lisp_Float, float_free_list); | 450 XSETFLOAT (val, float_free_list); |
451 float_free_list = (struct Lisp_Float *) XFASTINT (float_free_list->type); | 451 float_free_list = (struct Lisp_Float *) XFASTINT (float_free_list->type); |
452 } | 452 } |
453 else | 453 else |
454 { | 454 { |
455 if (float_block_index == FLOAT_BLOCK_SIZE) | 455 if (float_block_index == FLOAT_BLOCK_SIZE) |
458 VALIDATE_LISP_STORAGE (new, sizeof *new); | 458 VALIDATE_LISP_STORAGE (new, sizeof *new); |
459 new->next = float_block; | 459 new->next = float_block; |
460 float_block = new; | 460 float_block = new; |
461 float_block_index = 0; | 461 float_block_index = 0; |
462 } | 462 } |
463 XSET (val, Lisp_Float, &float_block->floats[float_block_index++]); | 463 XSETFLOAT (val, &float_block->floats[float_block_index++]); |
464 } | 464 } |
465 XFLOAT (val)->data = float_value; | 465 XFLOAT (val)->data = float_value; |
466 XFASTINT (XFLOAT (val)->type) = 0; /* bug chasing -wsr */ | 466 XFASTINT (XFLOAT (val)->type) = 0; /* bug chasing -wsr */ |
467 consing_since_gc += sizeof (struct Lisp_Float); | 467 consing_since_gc += sizeof (struct Lisp_Float); |
468 return val; | 468 return val; |
519 { | 519 { |
520 register Lisp_Object val; | 520 register Lisp_Object val; |
521 | 521 |
522 if (cons_free_list) | 522 if (cons_free_list) |
523 { | 523 { |
524 XSET (val, Lisp_Cons, cons_free_list); | 524 XSETCONS (val, cons_free_list); |
525 cons_free_list = (struct Lisp_Cons *) XFASTINT (cons_free_list->car); | 525 cons_free_list = (struct Lisp_Cons *) XFASTINT (cons_free_list->car); |
526 } | 526 } |
527 else | 527 else |
528 { | 528 { |
529 if (cons_block_index == CONS_BLOCK_SIZE) | 529 if (cons_block_index == CONS_BLOCK_SIZE) |
532 VALIDATE_LISP_STORAGE (new, sizeof *new); | 532 VALIDATE_LISP_STORAGE (new, sizeof *new); |
533 new->next = cons_block; | 533 new->next = cons_block; |
534 cons_block = new; | 534 cons_block = new; |
535 cons_block_index = 0; | 535 cons_block_index = 0; |
536 } | 536 } |
537 XSET (val, Lisp_Cons, &cons_block->conses[cons_block_index++]); | 537 XSETCONS (val, &cons_block->conses[cons_block_index++]); |
538 } | 538 } |
539 XCONS (val)->car = car; | 539 XCONS (val)->car = car; |
540 XCONS (val)->cdr = cdr; | 540 XCONS (val)->cdr = cdr; |
541 consing_since_gc += sizeof (struct Lisp_Cons); | 541 consing_since_gc += sizeof (struct Lisp_Cons); |
542 return val; | 542 return val; |
599 sizei = XINT (length); | 599 sizei = XINT (length); |
600 | 600 |
601 p = (struct Lisp_Vector *) xmalloc (sizeof (struct Lisp_Vector) + (sizei - 1) * sizeof (Lisp_Object)); | 601 p = (struct Lisp_Vector *) xmalloc (sizeof (struct Lisp_Vector) + (sizei - 1) * sizeof (Lisp_Object)); |
602 VALIDATE_LISP_STORAGE (p, 0); | 602 VALIDATE_LISP_STORAGE (p, 0); |
603 | 603 |
604 XSET (vector, Lisp_Vector, p); | 604 XSETVECTOR (vector, p); |
605 consing_since_gc += sizeof (struct Lisp_Vector) + (sizei - 1) * sizeof (Lisp_Object); | 605 consing_since_gc += sizeof (struct Lisp_Vector) + (sizei - 1) * sizeof (Lisp_Object); |
606 | 606 |
607 p->size = sizei; | 607 p->size = sizei; |
608 p->next = all_vectors; | 608 p->next = all_vectors; |
609 all_vectors = p; | 609 all_vectors = p; |
705 | 705 |
706 CHECK_STRING (str, 0); | 706 CHECK_STRING (str, 0); |
707 | 707 |
708 if (symbol_free_list) | 708 if (symbol_free_list) |
709 { | 709 { |
710 XSET (val, Lisp_Symbol, symbol_free_list); | 710 XSETSYMBOL (val, symbol_free_list); |
711 symbol_free_list | 711 symbol_free_list |
712 = (struct Lisp_Symbol *) XFASTINT (symbol_free_list->value); | 712 = (struct Lisp_Symbol *) XFASTINT (symbol_free_list->value); |
713 } | 713 } |
714 else | 714 else |
715 { | 715 { |
719 VALIDATE_LISP_STORAGE (new, sizeof *new); | 719 VALIDATE_LISP_STORAGE (new, sizeof *new); |
720 new->next = symbol_block; | 720 new->next = symbol_block; |
721 symbol_block = new; | 721 symbol_block = new; |
722 symbol_block_index = 0; | 722 symbol_block_index = 0; |
723 } | 723 } |
724 XSET (val, Lisp_Symbol, &symbol_block->symbols[symbol_block_index++]); | 724 XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index++]); |
725 } | 725 } |
726 p = XSYMBOL (val); | 726 p = XSYMBOL (val); |
727 p->name = XSTRING (str); | 727 p->name = XSTRING (str); |
728 p->plist = Qnil; | 728 p->plist = Qnil; |
729 p->value = Qunbound; | 729 p->value = Qunbound; |
767 register Lisp_Object val; | 767 register Lisp_Object val; |
768 register struct Lisp_Marker *p; | 768 register struct Lisp_Marker *p; |
769 | 769 |
770 if (marker_free_list) | 770 if (marker_free_list) |
771 { | 771 { |
772 XSET (val, Lisp_Marker, marker_free_list); | 772 XSETMARKER (val, marker_free_list); |
773 marker_free_list | 773 marker_free_list |
774 = (struct Lisp_Marker *) XFASTINT (marker_free_list->chain); | 774 = (struct Lisp_Marker *) XFASTINT (marker_free_list->chain); |
775 } | 775 } |
776 else | 776 else |
777 { | 777 { |
781 VALIDATE_LISP_STORAGE (new, sizeof *new); | 781 VALIDATE_LISP_STORAGE (new, sizeof *new); |
782 new->next = marker_block; | 782 new->next = marker_block; |
783 marker_block = new; | 783 marker_block = new; |
784 marker_block_index = 0; | 784 marker_block_index = 0; |
785 } | 785 } |
786 XSET (val, Lisp_Marker, &marker_block->markers[marker_block_index++]); | 786 XSETMARKER (val, &marker_block->markers[marker_block_index++]); |
787 } | 787 } |
788 p = XMARKER (val); | 788 p = XMARKER (val); |
789 p->buffer = 0; | 789 p->buffer = 0; |
790 p->bufpos = 0; | 790 p->bufpos = 0; |
791 p->chain = Qnil; | 791 p->chain = Qnil; |
916 if (length < 0) abort (); | 916 if (length < 0) abort (); |
917 | 917 |
918 if (fullsize <= STRING_BLOCK_SIZE - current_string_block->pos) | 918 if (fullsize <= STRING_BLOCK_SIZE - current_string_block->pos) |
919 /* This string can fit in the current string block */ | 919 /* This string can fit in the current string block */ |
920 { | 920 { |
921 XSET (val, Lisp_String, | 921 XSETSTRING (val, |
922 (struct Lisp_String *) (current_string_block->chars + current_string_block->pos)); | 922 ((struct Lisp_String *) |
923 (current_string_block->chars + current_string_block->pos))); | |
923 current_string_block->pos += fullsize; | 924 current_string_block->pos += fullsize; |
924 } | 925 } |
925 else if (fullsize > STRING_BLOCK_OUTSIZE) | 926 else if (fullsize > STRING_BLOCK_OUTSIZE) |
926 /* This string gets its own string block */ | 927 /* This string gets its own string block */ |
927 { | 928 { |
930 VALIDATE_LISP_STORAGE (new, 0); | 931 VALIDATE_LISP_STORAGE (new, 0); |
931 consing_since_gc += sizeof (struct string_block_head) + fullsize; | 932 consing_since_gc += sizeof (struct string_block_head) + fullsize; |
932 new->pos = fullsize; | 933 new->pos = fullsize; |
933 new->next = large_string_blocks; | 934 new->next = large_string_blocks; |
934 large_string_blocks = new; | 935 large_string_blocks = new; |
935 XSET (val, Lisp_String, | 936 XSETSTRING (val, |
936 (struct Lisp_String *) ((struct string_block_head *)new + 1)); | 937 ((struct Lisp_String *) |
938 ((struct string_block_head *)new + 1))); | |
937 } | 939 } |
938 else | 940 else |
939 /* Make a new current string block and start it off with this string */ | 941 /* Make a new current string block and start it off with this string */ |
940 { | 942 { |
941 register struct string_block *new | 943 register struct string_block *new |
945 current_string_block->next = new; | 947 current_string_block->next = new; |
946 new->prev = current_string_block; | 948 new->prev = current_string_block; |
947 new->next = 0; | 949 new->next = 0; |
948 current_string_block = new; | 950 current_string_block = new; |
949 new->pos = fullsize; | 951 new->pos = fullsize; |
950 XSET (val, Lisp_String, | 952 XSETSTRING (val, |
951 (struct Lisp_String *) current_string_block->chars); | 953 (struct Lisp_String *) current_string_block->chars); |
952 } | 954 } |
953 | 955 |
954 XSTRING (val)->size = length; | 956 XSTRING (val)->size = length; |
955 XSTRING (val)->data[length] = 0; | 957 XSTRING (val)->data[length] = 0; |
956 INITIALIZE_INTERVAL (XSTRING (val), NULL_INTERVAL); | 958 INITIALIZE_INTERVAL (XSTRING (val), NULL_INTERVAL); |
1012 register Lisp_Object new; | 1014 register Lisp_Object new; |
1013 register int size = sizeof (EMACS_INT) + INTERVAL_PTR_SIZE + length + 1; | 1015 register int size = sizeof (EMACS_INT) + INTERVAL_PTR_SIZE + length + 1; |
1014 | 1016 |
1015 if (pureptr + size > PURESIZE) | 1017 if (pureptr + size > PURESIZE) |
1016 error ("Pure Lisp storage exhausted"); | 1018 error ("Pure Lisp storage exhausted"); |
1017 XSET (new, Lisp_String, PUREBEG + pureptr); | 1019 XSETSTRING (new, PUREBEG + pureptr); |
1018 XSTRING (new)->size = length; | 1020 XSTRING (new)->size = length; |
1019 bcopy (data, XSTRING (new)->data, length); | 1021 bcopy (data, XSTRING (new)->data, length); |
1020 XSTRING (new)->data[length] = 0; | 1022 XSTRING (new)->data[length] = 0; |
1021 | 1023 |
1022 /* We must give strings in pure storage some kind of interval. So we | 1024 /* We must give strings in pure storage some kind of interval. So we |
1035 { | 1037 { |
1036 register Lisp_Object new; | 1038 register Lisp_Object new; |
1037 | 1039 |
1038 if (pureptr + sizeof (struct Lisp_Cons) > PURESIZE) | 1040 if (pureptr + sizeof (struct Lisp_Cons) > PURESIZE) |
1039 error ("Pure Lisp storage exhausted"); | 1041 error ("Pure Lisp storage exhausted"); |
1040 XSET (new, Lisp_Cons, PUREBEG + pureptr); | 1042 XSETCONS (new, PUREBEG + pureptr); |
1041 pureptr += sizeof (struct Lisp_Cons); | 1043 pureptr += sizeof (struct Lisp_Cons); |
1042 XCONS (new)->car = Fpurecopy (car); | 1044 XCONS (new)->car = Fpurecopy (car); |
1043 XCONS (new)->cdr = Fpurecopy (cdr); | 1045 XCONS (new)->cdr = Fpurecopy (cdr); |
1044 return new; | 1046 return new; |
1045 } | 1047 } |
1073 pureptr = p - PUREBEG; | 1075 pureptr = p - PUREBEG; |
1074 } | 1076 } |
1075 | 1077 |
1076 if (pureptr + sizeof (struct Lisp_Float) > PURESIZE) | 1078 if (pureptr + sizeof (struct Lisp_Float) > PURESIZE) |
1077 error ("Pure Lisp storage exhausted"); | 1079 error ("Pure Lisp storage exhausted"); |
1078 XSET (new, Lisp_Float, PUREBEG + pureptr); | 1080 XSETFLOAT (new, PUREBEG + pureptr); |
1079 pureptr += sizeof (struct Lisp_Float); | 1081 pureptr += sizeof (struct Lisp_Float); |
1080 XFLOAT (new)->data = num; | 1082 XFLOAT (new)->data = num; |
1081 XFASTINT (XFLOAT (new)->type) = 0; /* bug chasing -wsr */ | 1083 XFASTINT (XFLOAT (new)->type) = 0; /* bug chasing -wsr */ |
1082 return new; | 1084 return new; |
1083 } | 1085 } |
1092 register EMACS_INT size = sizeof (struct Lisp_Vector) + (len - 1) * sizeof (Lisp_Object); | 1094 register EMACS_INT size = sizeof (struct Lisp_Vector) + (len - 1) * sizeof (Lisp_Object); |
1093 | 1095 |
1094 if (pureptr + size > PURESIZE) | 1096 if (pureptr + size > PURESIZE) |
1095 error ("Pure Lisp storage exhausted"); | 1097 error ("Pure Lisp storage exhausted"); |
1096 | 1098 |
1097 XSET (new, Lisp_Vector, PUREBEG + pureptr); | 1099 XSETVECTOR (new, PUREBEG + pureptr); |
1098 pureptr += size; | 1100 pureptr += size; |
1099 XVECTOR (new)->size = len; | 1101 XVECTOR (new)->size = len; |
1100 return new; | 1102 return new; |
1101 } | 1103 } |
1102 | 1104 |
1688 | 1690 |
1689 /* Mark the various string-pointers in the buffer object. | 1691 /* Mark the various string-pointers in the buffer object. |
1690 Since the strings may be relocated, we must mark them | 1692 Since the strings may be relocated, we must mark them |
1691 in their actual slots. So gc_sweep must convert each slot | 1693 in their actual slots. So gc_sweep must convert each slot |
1692 back to an ordinary C pointer. */ | 1694 back to an ordinary C pointer. */ |
1693 XSET (*(Lisp_Object *)&buffer->upcase_table, | 1695 XSETSTRING (*(Lisp_Object *)&buffer->upcase_table, buffer->upcase_table); |
1694 Lisp_String, buffer->upcase_table); | |
1695 mark_object ((Lisp_Object *)&buffer->upcase_table); | 1696 mark_object ((Lisp_Object *)&buffer->upcase_table); |
1696 XSET (*(Lisp_Object *)&buffer->downcase_table, | 1697 XSETSTRING (*(Lisp_Object *)&buffer->downcase_table, buffer->downcase_table); |
1697 Lisp_String, buffer->downcase_table); | |
1698 mark_object ((Lisp_Object *)&buffer->downcase_table); | 1698 mark_object ((Lisp_Object *)&buffer->downcase_table); |
1699 | 1699 |
1700 XSET (*(Lisp_Object *)&buffer->sort_table, | 1700 XSETSTRING (*(Lisp_Object *)&buffer->sort_table, buffer->sort_table); |
1701 Lisp_String, buffer->sort_table); | |
1702 mark_object ((Lisp_Object *)&buffer->sort_table); | 1701 mark_object ((Lisp_Object *)&buffer->sort_table); |
1703 XSET (*(Lisp_Object *)&buffer->folding_sort_table, | 1702 XSETSTRING (*(Lisp_Object *)&buffer->folding_sort_table, buffer->folding_sort_table); |
1704 Lisp_String, buffer->folding_sort_table); | |
1705 mark_object ((Lisp_Object *)&buffer->folding_sort_table); | 1703 mark_object ((Lisp_Object *)&buffer->folding_sort_table); |
1706 #endif | 1704 #endif |
1707 | 1705 |
1708 for (ptr = &buffer->name + 1; | 1706 for (ptr = &buffer->name + 1; |
1709 (char *)ptr < (char *)buffer + sizeof (struct buffer); | 1707 (char *)ptr < (char *)buffer + sizeof (struct buffer); |
1861 for (i = 0; i < lim; i++) | 1859 for (i = 0; i < lim; i++) |
1862 if (!XMARKBIT (mblk->markers[i].chain)) | 1860 if (!XMARKBIT (mblk->markers[i].chain)) |
1863 { | 1861 { |
1864 Lisp_Object tem; | 1862 Lisp_Object tem; |
1865 tem1 = &mblk->markers[i]; /* tem1 avoids Sun compiler bug */ | 1863 tem1 = &mblk->markers[i]; /* tem1 avoids Sun compiler bug */ |
1866 XSET (tem, Lisp_Marker, tem1); | 1864 XSETMARKER (tem, tem1); |
1867 unchain_marker (tem); | 1865 unchain_marker (tem); |
1868 XFASTINT (mblk->markers[i].chain) = (EMACS_INT) marker_free_list; | 1866 XFASTINT (mblk->markers[i].chain) = (EMACS_INT) marker_free_list; |
1869 marker_free_list = &mblk->markers[i]; | 1867 marker_free_list = &mblk->markers[i]; |
1870 num_free++; | 1868 num_free++; |
1871 } | 1869 } |
2053 objptr = (Lisp_Object *)size; | 2051 objptr = (Lisp_Object *)size; |
2054 | 2052 |
2055 size = XFASTINT (*objptr) & ~MARKBIT; | 2053 size = XFASTINT (*objptr) & ~MARKBIT; |
2056 if (XMARKBIT (*objptr)) | 2054 if (XMARKBIT (*objptr)) |
2057 { | 2055 { |
2058 XSET (*objptr, Lisp_String, newaddr); | 2056 XSETSTRING (*objptr, newaddr); |
2059 XMARK (*objptr); | 2057 XMARK (*objptr); |
2060 } | 2058 } |
2061 else | 2059 else |
2062 XSET (*objptr, Lisp_String, newaddr); | 2060 XSETSTRING (*objptr, newaddr); |
2063 } | 2061 } |
2064 /* Store the actual size in the size field. */ | 2062 /* Store the actual size in the size field. */ |
2065 newaddr->size = size; | 2063 newaddr->size = size; |
2066 | 2064 |
2067 #ifdef USE_TEXT_PROPERTIES | 2065 #ifdef USE_TEXT_PROPERTIES |
2068 /* Now that the string has been relocated, rebalance its | 2066 /* Now that the string has been relocated, rebalance its |
2069 interval tree, and update the tree's parent pointer. */ | 2067 interval tree, and update the tree's parent pointer. */ |
2070 if (! NULL_INTERVAL_P (newaddr->intervals)) | 2068 if (! NULL_INTERVAL_P (newaddr->intervals)) |
2071 { | 2069 { |
2072 UNMARK_BALANCE_INTERVALS (newaddr->intervals); | 2070 UNMARK_BALANCE_INTERVALS (newaddr->intervals); |
2073 XSET (* (Lisp_Object *) &newaddr->intervals->parent, | 2071 XSETSTRING (* (Lisp_Object *) &newaddr->intervals->parent, |
2074 Lisp_String, | 2072 newaddr); |
2075 newaddr); | |
2076 } | 2073 } |
2077 #endif /* USE_TEXT_PROPERTIES */ | 2074 #endif /* USE_TEXT_PROPERTIES */ |
2078 } | 2075 } |
2079 pos += STRING_FULLSIZE (size); | 2076 pos += STRING_FULLSIZE (size); |
2080 } | 2077 } |
2119 We divide the value by 1024 to make sure it fits in a Lisp integer.") | 2116 We divide the value by 1024 to make sure it fits in a Lisp integer.") |
2120 () | 2117 () |
2121 { | 2118 { |
2122 Lisp_Object end; | 2119 Lisp_Object end; |
2123 | 2120 |
2124 XSET (end, Lisp_Int, (EMACS_INT) sbrk (0) / 1024); | 2121 XSETINT (end, (EMACS_INT) sbrk (0) / 1024); |
2125 | 2122 |
2126 return end; | 2123 return end; |
2127 } | 2124 } |
2128 | 2125 |
2129 | 2126 |