# HG changeset patch # User Karl Heuer # Date 781861561 0 # Node ID c7d7fb56b42d42288c0cca634eda08ff2bfd2e15 # Parent 907353876b8bb0057ab3d88ae26d6b66f825dc97 (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. diff -r 907353876b8b -r c7d7fb56b42d src/alloc.c --- a/src/alloc.c Tue Oct 11 07:45:41 1994 +0000 +++ b/src/alloc.c Tue Oct 11 07:46:01 1994 +0000 @@ -733,22 +733,22 @@ return val; } -/* Allocation of markers. +/* Allocation of markers and other objects that share that structure. Works like allocation of conses. */ #define MARKER_BLOCK_SIZE \ - ((1020 - sizeof (struct marker_block *)) / sizeof (struct Lisp_Marker)) + ((1020 - sizeof (struct marker_block *)) / sizeof (union Lisp_Misc)) struct marker_block { struct marker_block *next; - struct Lisp_Marker markers[MARKER_BLOCK_SIZE]; + union Lisp_Misc markers[MARKER_BLOCK_SIZE]; }; struct marker_block *marker_block; int marker_block_index; -struct Lisp_Marker *marker_free_list; +union Lisp_Misc *marker_free_list; void init_marker () @@ -760,6 +760,34 @@ marker_free_list = 0; } +/* Return a newly allocated Lisp_Misc object, with no substructure. */ +Lisp_Object +allocate_misc () +{ + Lisp_Object val; + + if (marker_free_list) + { + XSETMISC (val, marker_free_list); + marker_free_list = marker_free_list->u_free.chain; + } + else + { + if (marker_block_index == MARKER_BLOCK_SIZE) + { + struct marker_block *new + = (struct marker_block *) xmalloc (sizeof (struct marker_block)); + VALIDATE_LISP_STORAGE (new, sizeof *new); + new->next = marker_block; + marker_block = new; + marker_block_index = 0; + } + XSETMISC (val, &marker_block->markers[marker_block_index++]); + } + consing_since_gc += sizeof (union Lisp_Misc); + return val; +} + DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, "Return a newly allocated marker which does not point at any place.") () @@ -767,29 +795,12 @@ register Lisp_Object val; register struct Lisp_Marker *p; - if (marker_free_list) - { - XSETMARKER (val, marker_free_list); - marker_free_list - = (struct Lisp_Marker *) XFASTINT (marker_free_list->chain); - } - else - { - if (marker_block_index == MARKER_BLOCK_SIZE) - { - struct marker_block *new = (struct marker_block *) xmalloc (sizeof (struct marker_block)); - VALIDATE_LISP_STORAGE (new, sizeof *new); - new->next = marker_block; - marker_block = new; - marker_block_index = 0; - } - XSETMARKER (val, &marker_block->markers[marker_block_index++]); - } + val = allocate_misc (); + XMISC (val)->type = Lisp_Misc_Marker; p = XMARKER (val); p->buffer = 0; p->bufpos = 0; p->chain = Qnil; - consing_since_gc += sizeof (struct Lisp_Marker); return val; } @@ -1125,8 +1136,15 @@ switch (XTYPE (obj)) #endif { - case Lisp_Marker: - error ("Attempt to copy a marker to pure storage"); + case Lisp_Misc: + switch (XMISC (obj)->type) + { + case Lisp_Misc_Marker: + error ("Attempt to copy a marker to pure storage"); + + default: + abort (); + } case Lisp_Cons: return pure_cons (XCONS (obj)->car, XCONS (obj)->cdr); @@ -1426,7 +1444,8 @@ { register int i; for (i = 0; i < lim; i++) - XUNMARK (sblk->markers[i].chain); + if (sblk->markers[i].type == Lisp_Misc_Marker) + XUNMARK (sblk->markers[i].u_marker.chain); lim = MARKER_BLOCK_SIZE; } } @@ -1613,11 +1632,19 @@ } break; - case Lisp_Marker: - XMARK (XMARKER (obj)->chain); - /* DO NOT mark thru the marker's chain. - The buffer's markers chain does not preserve markers from gc; - instead, markers are removed from the chain when freed by gc. */ + case Lisp_Misc: + switch (XMISC (obj)->type) + { + case Lisp_Misc_Marker: + XMARK (XMARKER (obj)->chain); + /* DO NOT mark thru the marker's chain. + The buffer's markers chain does not preserve markers from gc; + instead, markers are removed from the chain when freed by gc. */ + break; + + default: + abort (); + } break; case Lisp_Cons: @@ -1855,20 +1882,26 @@ { register int i; for (i = 0; i < lim; i++) - if (!XMARKBIT (mblk->markers[i].chain)) + if (mblk->markers[i].type == Lisp_Misc_Marker) { - Lisp_Object tem; - tem1 = &mblk->markers[i]; /* tem1 avoids Sun compiler bug */ - XSETMARKER (tem, tem1); - unchain_marker (tem); - XSETFASTINT (mblk->markers[i].chain, (EMACS_INT) marker_free_list); - marker_free_list = &mblk->markers[i]; - num_free++; - } - else - { - num_used++; - XUNMARK (mblk->markers[i].chain); + if (!XMARKBIT (mblk->markers[i].u_marker.chain)) + { + Lisp_Object tem; + tem1 = &mblk->markers[i].u_marker; /* tem1 avoids Sun compiler bug */ + XSETMARKER (tem, tem1); + unchain_marker (tem); + /* We could leave the type alone, since nobody checks it, + but this might catch bugs faster. */ + mblk->markers[i].type = Lisp_Misc_Free; + mblk->markers[i].u_free.chain = marker_free_list; + marker_free_list = &mblk->markers[i]; + num_free++; + } + else + { + num_used++; + XUNMARK (mblk->markers[i].u_marker.chain); + } } lim = MARKER_BLOCK_SIZE; }