[Emacs-diffs] master 1b42453: Use switch on pseudovector types; plus cleanups along the way

[Stefan Monnier]

branch: master
commit 1b424533675341a2090b79a6ffc420ac6b179ce7
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    Use switch on pseudovector types; plus cleanups along the way
    
    * 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.
---
 lisp/emacs-lisp/cl-generic.el |  3 +-
 src/alloc.c                   | 18 +++-------
 src/data.c                    | 67 +++++++++++++++++-----------------
 src/lisp.h                    | 16 +++++++--
 src/print.c                   | 84 +++++++++++++++++++++++++++----------------
 5 files changed, 107 insertions(+), 81 deletions(-)

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 8517e1e..8c6d3d5 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -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:
diff --git a/src/alloc.c b/src/alloc.c
index b44b90e..ae3e151 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -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
diff --git a/src/data.c b/src/data.c
index fb7bf51..ae8dd97 100644
--- a/src/data.c
+++ b/src/data.c
@@ -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;
diff --git a/src/lisp.h b/src/lisp.h
index 5cbb461..ab4db4c 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -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 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, int code)
+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)));
 }
diff --git a/src/print.c b/src/print.c
index 85a6c46..e857761 100644
--- a/src/print.c
+++ b/src/print.c
@@ -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;