Mercurial > emacs

comparison src/alloc.c @ 9261:e5ba7993d378

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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