Mercurial > emacs
comparison src/alloc.c @ 9437:c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
superset type, not just markers.
(allocate_misc): New function, extracted from Fmake_marker.
(Fpurecopy): Check the substructure.
(clear_marks, mark_object, gc_sweep): Likewise.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Tue, 11 Oct 1994 07:46:01 +0000 |
parents | 86e52a4d8d87 |
children | a40af805e036 |
comparison
equal
deleted
inserted
replaced
9436:907353876b8b | 9437:c7d7fb56b42d |
---|---|
731 p->next = 0; | 731 p->next = 0; |
732 consing_since_gc += sizeof (struct Lisp_Symbol); | 732 consing_since_gc += sizeof (struct Lisp_Symbol); |
733 return val; | 733 return val; |
734 } | 734 } |
735 | 735 |
736 /* Allocation of markers. | 736 /* Allocation of markers and other objects that share that structure. |
737 Works like allocation of conses. */ | 737 Works like allocation of conses. */ |
738 | 738 |
739 #define MARKER_BLOCK_SIZE \ | 739 #define MARKER_BLOCK_SIZE \ |
740 ((1020 - sizeof (struct marker_block *)) / sizeof (struct Lisp_Marker)) | 740 ((1020 - sizeof (struct marker_block *)) / sizeof (union Lisp_Misc)) |
741 | 741 |
742 struct marker_block | 742 struct marker_block |
743 { | 743 { |
744 struct marker_block *next; | 744 struct marker_block *next; |
745 struct Lisp_Marker markers[MARKER_BLOCK_SIZE]; | 745 union Lisp_Misc markers[MARKER_BLOCK_SIZE]; |
746 }; | 746 }; |
747 | 747 |
748 struct marker_block *marker_block; | 748 struct marker_block *marker_block; |
749 int marker_block_index; | 749 int marker_block_index; |
750 | 750 |
751 struct Lisp_Marker *marker_free_list; | 751 union Lisp_Misc *marker_free_list; |
752 | 752 |
753 void | 753 void |
754 init_marker () | 754 init_marker () |
755 { | 755 { |
756 marker_block = (struct marker_block *) malloc (sizeof (struct marker_block)); | 756 marker_block = (struct marker_block *) malloc (sizeof (struct marker_block)); |
758 bzero (marker_block->markers, sizeof marker_block->markers); | 758 bzero (marker_block->markers, sizeof marker_block->markers); |
759 marker_block_index = 0; | 759 marker_block_index = 0; |
760 marker_free_list = 0; | 760 marker_free_list = 0; |
761 } | 761 } |
762 | 762 |
763 DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, | 763 /* Return a newly allocated Lisp_Misc object, with no substructure. */ |
764 "Return a newly allocated marker which does not point at any place.") | 764 Lisp_Object |
765 () | 765 allocate_misc () |
766 { | 766 { |
767 register Lisp_Object val; | 767 Lisp_Object val; |
768 register struct Lisp_Marker *p; | |
769 | 768 |
770 if (marker_free_list) | 769 if (marker_free_list) |
771 { | 770 { |
772 XSETMARKER (val, marker_free_list); | 771 XSETMISC (val, marker_free_list); |
773 marker_free_list | 772 marker_free_list = marker_free_list->u_free.chain; |
774 = (struct Lisp_Marker *) XFASTINT (marker_free_list->chain); | |
775 } | 773 } |
776 else | 774 else |
777 { | 775 { |
778 if (marker_block_index == MARKER_BLOCK_SIZE) | 776 if (marker_block_index == MARKER_BLOCK_SIZE) |
779 { | 777 { |
780 struct marker_block *new = (struct marker_block *) xmalloc (sizeof (struct marker_block)); | 778 struct marker_block *new |
779 = (struct marker_block *) xmalloc (sizeof (struct marker_block)); | |
781 VALIDATE_LISP_STORAGE (new, sizeof *new); | 780 VALIDATE_LISP_STORAGE (new, sizeof *new); |
782 new->next = marker_block; | 781 new->next = marker_block; |
783 marker_block = new; | 782 marker_block = new; |
784 marker_block_index = 0; | 783 marker_block_index = 0; |
785 } | 784 } |
786 XSETMARKER (val, &marker_block->markers[marker_block_index++]); | 785 XSETMISC (val, &marker_block->markers[marker_block_index++]); |
787 } | 786 } |
787 consing_since_gc += sizeof (union Lisp_Misc); | |
788 return val; | |
789 } | |
790 | |
791 DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, | |
792 "Return a newly allocated marker which does not point at any place.") | |
793 () | |
794 { | |
795 register Lisp_Object val; | |
796 register struct Lisp_Marker *p; | |
797 | |
798 val = allocate_misc (); | |
799 XMISC (val)->type = Lisp_Misc_Marker; | |
788 p = XMARKER (val); | 800 p = XMARKER (val); |
789 p->buffer = 0; | 801 p->buffer = 0; |
790 p->bufpos = 0; | 802 p->bufpos = 0; |
791 p->chain = Qnil; | 803 p->chain = Qnil; |
792 consing_since_gc += sizeof (struct Lisp_Marker); | |
793 return val; | 804 return val; |
794 } | 805 } |
795 | 806 |
796 /* Allocation of strings */ | 807 /* Allocation of strings */ |
797 | 808 |
1123 switch ((int) XTYPE (obj)) | 1134 switch ((int) XTYPE (obj)) |
1124 #else | 1135 #else |
1125 switch (XTYPE (obj)) | 1136 switch (XTYPE (obj)) |
1126 #endif | 1137 #endif |
1127 { | 1138 { |
1128 case Lisp_Marker: | 1139 case Lisp_Misc: |
1129 error ("Attempt to copy a marker to pure storage"); | 1140 switch (XMISC (obj)->type) |
1141 { | |
1142 case Lisp_Misc_Marker: | |
1143 error ("Attempt to copy a marker to pure storage"); | |
1144 | |
1145 default: | |
1146 abort (); | |
1147 } | |
1130 | 1148 |
1131 case Lisp_Cons: | 1149 case Lisp_Cons: |
1132 return pure_cons (XCONS (obj)->car, XCONS (obj)->cdr); | 1150 return pure_cons (XCONS (obj)->car, XCONS (obj)->cdr); |
1133 | 1151 |
1134 #ifdef LISP_FLOAT_TYPE | 1152 #ifdef LISP_FLOAT_TYPE |
1424 | 1442 |
1425 for (sblk = marker_block; sblk; sblk = sblk->next) | 1443 for (sblk = marker_block; sblk; sblk = sblk->next) |
1426 { | 1444 { |
1427 register int i; | 1445 register int i; |
1428 for (i = 0; i < lim; i++) | 1446 for (i = 0; i < lim; i++) |
1429 XUNMARK (sblk->markers[i].chain); | 1447 if (sblk->markers[i].type == Lisp_Misc_Marker) |
1448 XUNMARK (sblk->markers[i].u_marker.chain); | |
1430 lim = MARKER_BLOCK_SIZE; | 1449 lim = MARKER_BLOCK_SIZE; |
1431 } | 1450 } |
1432 } | 1451 } |
1433 /* Clear mark bits on all buffers */ | 1452 /* Clear mark bits on all buffers */ |
1434 { | 1453 { |
1611 goto loop2; | 1630 goto loop2; |
1612 } | 1631 } |
1613 } | 1632 } |
1614 break; | 1633 break; |
1615 | 1634 |
1616 case Lisp_Marker: | 1635 case Lisp_Misc: |
1617 XMARK (XMARKER (obj)->chain); | 1636 switch (XMISC (obj)->type) |
1618 /* DO NOT mark thru the marker's chain. | 1637 { |
1619 The buffer's markers chain does not preserve markers from gc; | 1638 case Lisp_Misc_Marker: |
1620 instead, markers are removed from the chain when freed by gc. */ | 1639 XMARK (XMARKER (obj)->chain); |
1640 /* DO NOT mark thru the marker's chain. | |
1641 The buffer's markers chain does not preserve markers from gc; | |
1642 instead, markers are removed from the chain when freed by gc. */ | |
1643 break; | |
1644 | |
1645 default: | |
1646 abort (); | |
1647 } | |
1621 break; | 1648 break; |
1622 | 1649 |
1623 case Lisp_Cons: | 1650 case Lisp_Cons: |
1624 case Lisp_Buffer_Local_Value: | 1651 case Lisp_Buffer_Local_Value: |
1625 case Lisp_Some_Buffer_Local_Value: | 1652 case Lisp_Some_Buffer_Local_Value: |
1853 | 1880 |
1854 for (mblk = marker_block; mblk; mblk = mblk->next) | 1881 for (mblk = marker_block; mblk; mblk = mblk->next) |
1855 { | 1882 { |
1856 register int i; | 1883 register int i; |
1857 for (i = 0; i < lim; i++) | 1884 for (i = 0; i < lim; i++) |
1858 if (!XMARKBIT (mblk->markers[i].chain)) | 1885 if (mblk->markers[i].type == Lisp_Misc_Marker) |
1859 { | 1886 { |
1860 Lisp_Object tem; | 1887 if (!XMARKBIT (mblk->markers[i].u_marker.chain)) |
1861 tem1 = &mblk->markers[i]; /* tem1 avoids Sun compiler bug */ | 1888 { |
1862 XSETMARKER (tem, tem1); | 1889 Lisp_Object tem; |
1863 unchain_marker (tem); | 1890 tem1 = &mblk->markers[i].u_marker; /* tem1 avoids Sun compiler bug */ |
1864 XSETFASTINT (mblk->markers[i].chain, (EMACS_INT) marker_free_list); | 1891 XSETMARKER (tem, tem1); |
1865 marker_free_list = &mblk->markers[i]; | 1892 unchain_marker (tem); |
1866 num_free++; | 1893 /* We could leave the type alone, since nobody checks it, |
1867 } | 1894 but this might catch bugs faster. */ |
1868 else | 1895 mblk->markers[i].type = Lisp_Misc_Free; |
1869 { | 1896 mblk->markers[i].u_free.chain = marker_free_list; |
1870 num_used++; | 1897 marker_free_list = &mblk->markers[i]; |
1871 XUNMARK (mblk->markers[i].chain); | 1898 num_free++; |
1899 } | |
1900 else | |
1901 { | |
1902 num_used++; | |
1903 XUNMARK (mblk->markers[i].u_marker.chain); | |
1904 } | |
1872 } | 1905 } |
1873 lim = MARKER_BLOCK_SIZE; | 1906 lim = MARKER_BLOCK_SIZE; |
1874 } | 1907 } |
1875 | 1908 |
1876 total_markers = num_used; | 1909 total_markers = num_used; |