mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-04 08:47:11 +00:00
Code Issues Releases Activity

Use switch on pseudovector types; plus cleanups along the way

Browse Source 
* src/lisp.h (PSEUDOVECTOR_TYPE): New function, extracted from mark_object.
(PSEUDOVECTOR_TYPEP): Change type of `code'.

* src/alloc.c (sweep_vectors): Remove out-of-date assertion.
(mark_object): Use PSEUDOVECTOR_TYPE.

* src/data.c (Ftype_of): Use switch on pvec type.

* src/print.c (print_object): Use switch on pvec type.

* lisp/emacs-lisp/cl-generic.el (cl--generic-typeof-types):
Add recently added types.
This commit is contained in:
Stefan Monnier 2017-03-12 17:44:13 -04:00
parent 995be66f0f
commit 1b42453367
5 changed files with 108 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lisp/emacs-lisp/cl-generic.el
View File

@ -1154,7 +1154,8 @@ These match if the argument is `eql' to VAL."
(process atom) (window atom) (subr atom) (compiled-function function atom)
(buffer atom) (char-table array sequence atom)
(bool-vector array sequence atom)
(frame atom) (hash-table atom)
(frame atom) (hash-table atom) (terminal atom)
(thread atom) (mutex atom) (condvar atom)
(font-spec atom) (font-entity atom) (font-object atom)
(vector array sequence atom)
;; Plus, really hand made:

18
src/alloc.c
View File

@ -3276,13 +3276,7 @@ sweep_vectors (void)
VECTOR_UNMARK (vector);
total_vectors++;
if (vector->header.size & PSEUDOVECTOR_FLAG)
{
/* All non-bool pseudovectors are small enough to be allocated
from vector blocks. This code should be redesigned if some
pseudovector type grows beyond VBLOCK_BYTES_MAX. */
eassert (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BOOL_VECTOR));
total_vector_slots += vector_nbytes (vector) / word_size;
}
total_vector_slots += vector_nbytes (vector) / word_size;
else
total_vector_slots
+= header_size / word_size + vector->header.size;
@ -4648,7 +4642,7 @@ live_vector_p (struct mem_node *m, void *p)
&& vector <= (struct Lisp_Vector *) p)
{
if (!PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) && vector == p)
return 1;
return true;
else
vector = ADVANCE (vector, vector_nbytes (vector));
}
@ -6385,7 +6379,6 @@ mark_object (Lisp_Object arg)
case Lisp_Vectorlike:
{
register struct Lisp_Vector *ptr = XVECTOR (obj);
register ptrdiff_t pvectype;
if (VECTOR_MARKED_P (ptr))
break;
@ -6396,11 +6389,8 @@ mark_object (Lisp_Object arg)
emacs_abort ();
#endif /* GC_CHECK_MARKED_OBJECTS */
if (ptr->header.size & PSEUDOVECTOR_FLAG)
pvectype = ((ptr->header.size & PVEC_TYPE_MASK)
>> PSEUDOVECTOR_AREA_BITS);
else
pvectype = PVEC_NORMAL_VECTOR;
enum pvec_type pvectype
= PSEUDOVECTOR_TYPE (ptr);
if (pvectype != PVEC_SUBR
&& pvectype != PVEC_BUFFER

67
src/data.c
View File

@ -241,39 +241,40 @@ for example, (type-of 1) returns `integer'. */)
}
case Lisp_Vectorlike:
if (WINDOW_CONFIGURATIONP (object))
return Qwindow_configuration;
if (PROCESSP (object))
return Qprocess;
if (WINDOWP (object))
return Qwindow;
if (SUBRP (object))
return Qsubr;
if (COMPILEDP (object))
return Qcompiled_function;
if (BUFFERP (object))
return Qbuffer;
if (CHAR_TABLE_P (object))
return Qchar_table;
if (BOOL_VECTOR_P (object))
return Qbool_vector;
if (FRAMEP (object))
return Qframe;
if (HASH_TABLE_P (object))
return Qhash_table;
if (FONT_SPEC_P (object))
return Qfont_spec;
if (FONT_ENTITY_P (object))
return Qfont_entity;
if (FONT_OBJECT_P (object))
return Qfont_object;
if (THREADP (object))
return Qthread;
if (MUTEXP (object))
return Qmutex;
if (CONDVARP (object))
return Qcondition_variable;
return Qvector;
switch (PSEUDOVECTOR_TYPE (XVECTOR (object)))
{
case PVEC_NORMAL_VECTOR: return Qvector;
case PVEC_WINDOW_CONFIGURATION: return Qwindow_configuration;
case PVEC_PROCESS: return Qprocess;
case PVEC_WINDOW: return Qwindow;
case PVEC_SUBR: return Qsubr;
case PVEC_COMPILED: return Qcompiled_function;
case PVEC_BUFFER: return Qbuffer;
case PVEC_CHAR_TABLE: return Qchar_table;
case PVEC_BOOL_VECTOR: return Qbool_vector;
case PVEC_FRAME: return Qframe;
case PVEC_HASH_TABLE: return Qhash_table;
case PVEC_FONT:
if (FONT_SPEC_P (object))
return Qfont_spec;
if (FONT_ENTITY_P (object))
return Qfont_entity;
if (FONT_OBJECT_P (object))
return Qfont_object;
else
emacs_abort (); /* return Qfont? */
case PVEC_THREAD: return Qthread;
case PVEC_MUTEX: return Qmutex;
case PVEC_CONDVAR: return Qcondition_variable;
case PVEC_TERMINAL: return Qterminal;
/* "Impossible" cases. */
case PVEC_XWIDGET:
case PVEC_OTHER:
case PVEC_XWIDGET_VIEW:
case PVEC_SUB_CHAR_TABLE:
case PVEC_FREE: ;
}
emacs_abort ();
case Lisp_Float:
return Qfloat;

18
src/lisp.h
View File

@ -874,7 +874,7 @@ enum pvec_type
PVEC_TERMINAL,
PVEC_WINDOW_CONFIGURATION,
PVEC_SUBR,
PVEC_OTHER,
PVEC_OTHER, /* Should never be visible to Elisp code. */
PVEC_XWIDGET,
PVEC_XWIDGET_VIEW,
PVEC_THREAD,
@ -1410,9 +1410,21 @@ CHECK_VECTOR (Lisp_Object x)
/* A pseudovector is like a vector, but has other non-Lisp components. */
INLINE bool
PSEUDOVECTOR_TYPEP (struct vectorlike_header *a, int code)
INLINE enum pvec_type
PSEUDOVECTOR_TYPE (struct Lisp_Vector *v)
{
ptrdiff_t size = v->header.size;
return (size & PSEUDOVECTOR_FLAG
? (size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS
: PVEC_NORMAL_VECTOR);
}
/* Can't be used with PVEC_NORMAL_VECTOR. */
INLINE bool
PSEUDOVECTOR_TYPEP (struct vectorlike_header *a, enum pvec_type code)
{
/* We don't use PSEUDOVECTOR_TYPE here so as to avoid a shift
* operation when `code' is known. */
return ((a->size & (PSEUDOVECTOR_FLAG | PVEC_TYPE_MASK))
== (PSEUDOVECTOR_FLAG | (code << PSEUDOVECTOR_AREA_BITS)));
}

84
src/print.c
View File

@ -1677,7 +1677,8 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
break;
case Lisp_Vectorlike:
if (PROCESSP (obj))
switch (PSEUDOVECTOR_TYPE (XVECTOR (obj))) {
case PVEC_PROCESS:
{
if (escapeflag)
{
@ -1688,7 +1689,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
else
print_string (XPROCESS (obj)->name, printcharfun);
}
else if (BOOL_VECTOR_P (obj))
break;
case PVEC_BOOL_VECTOR:
{
ptrdiff_t i;
unsigned char c;
@ -1732,18 +1735,24 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
print_c_string (" ...", printcharfun);
printchar ('\"', printcharfun);
}
else if (SUBRP (obj))
break;
case PVEC_SUBR:
{
print_c_string ("#<subr ", printcharfun);
print_c_string (XSUBR (obj)->symbol_name, printcharfun);
printchar ('>', printcharfun);
}
else if (XWIDGETP (obj) || XWIDGET_VIEW_P (obj))
break;
case PVEC_XWIDGET: case PVEC_XWIDGET_VIEW:
{
print_c_string ("#<xwidget ", printcharfun);
printchar ('>', printcharfun);
}
else if (WINDOWP (obj))
break;
case PVEC_WINDOW:
{
int len = sprintf (buf, "#<window %"pI"d",
XWINDOW (obj)->sequence_number);
@ -1756,7 +1765,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
}
printchar ('>', printcharfun);
}
else if (TERMINALP (obj))
break;
case PVEC_TERMINAL:
{
struct terminal *t = XTERMINAL (obj);
int len = sprintf (buf, "#<terminal %d", t->id);
@ -1768,27 +1779,14 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
}
printchar ('>', printcharfun);
}
else if (HASH_TABLE_P (obj))
break;
case PVEC_HASH_TABLE:
{
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
ptrdiff_t i;
ptrdiff_t real_size, size;
int len;
#if 0
void *ptr = h;
print_c_string ("#<hash-table", printcharfun);
if (SYMBOLP (h->test))
{
print_c_string (" '", printcharfun);
print_c_string (SSDATA (SYMBOL_NAME (h->test)), printcharfun);
printchar (' ', printcharfun);
print_c_string (SSDATA (SYMBOL_NAME (h->weak)), printcharfun);
len = sprintf (buf, " %"pD"d/%"pD"d", h->count, ASIZE (h->next));
strout (buf, len, len, printcharfun);
}
len = sprintf (buf, " %p>", ptr);
strout (buf, len, len, printcharfun);
#endif
/* Implement a readable output, e.g.:
#s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
/* Always print the size. */
@ -1846,9 +1844,10 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
print_c_string (" ...", printcharfun);
print_c_string ("))", printcharfun);
}
else if (BUFFERP (obj))
break;
case PVEC_BUFFER:
{
if (!BUFFER_LIVE_P (XBUFFER (obj)))
print_c_string ("#<killed buffer>", printcharfun);
@ -1861,9 +1860,13 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
else
print_string (BVAR (XBUFFER (obj), name), printcharfun);
}
else if (WINDOW_CONFIGURATIONP (obj))
break;
case PVEC_WINDOW_CONFIGURATION:
print_c_string ("#<window-configuration>", printcharfun);
else if (FRAMEP (obj))
break;
case PVEC_FRAME: ;
{
int len;
void *ptr = XFRAME (obj);
@ -1886,7 +1889,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
len = sprintf (buf, " %p>", ptr);
strout (buf, len, len, printcharfun);
}
else if (FONTP (obj))
break;
case PVEC_FONT:
{
int i;
@ -1914,7 +1919,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
}
printchar ('>', printcharfun);
}
else if (THREADP (obj))
break;
case PVEC_THREAD:
{
print_c_string ("#<thread ", printcharfun);
if (STRINGP (XTHREAD (obj)->name))
@ -1926,7 +1933,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
}
printchar ('>', printcharfun);
}
else if (MUTEXP (obj))
break;
case PVEC_MUTEX:
{
print_c_string ("#<mutex ", printcharfun);
if (STRINGP (XMUTEX (obj)->name))
@ -1938,7 +1947,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
}
printchar ('>', printcharfun);
}
else if (CONDVARP (obj))
break;
case PVEC_CONDVAR:
{
print_c_string ("#<condvar ", printcharfun);
if (STRINGP (XCONDVAR (obj)->name))
@ -1950,7 +1961,12 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
}
printchar ('>', printcharfun);
}
else
break;
case PVEC_SUB_CHAR_TABLE:
case PVEC_COMPILED:
case PVEC_CHAR_TABLE:
case PVEC_NORMAL_VECTOR: ;
{
ptrdiff_t size = ASIZE (obj);
if (COMPILEDP (obj))
@ -2007,6 +2023,12 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
print_c_string (" ...", printcharfun);
}
printchar (']', printcharfun);
}
break;
case PVEC_OTHER:
case PVEC_FREE:
emacs_abort ();
}
break;