Add classes as run-time descriptors of cl-structs.

* lisp/emacs-lisp/cl-preloaded.el (cl--struct-get-class): New function.
(cl--make-slot-desc): New constructor.
(cl--plist-remove, cl--struct-register-child): New functions.
(cl-struct-define): Rewrite.
(cl-structure-class, cl-structure-object, cl-slot-descriptor)
(cl--class): New structs.
(cl--struct-default-parent): Initialize it here.
* lisp/emacs-lisp/cl-macs.el (cl--find-class): New macro.
(cl-defsubst, cl--defsubst-expand, cl--sublis): Move before first use.
(cl--struct-default-parent): New var.
(cl-defstruct): Adjust to new representation of classes; add
default parent.  In accessors, signal `wrong-type-argument' rather than
a generic error.
(cl-struct-sequence-type, cl-struct-slot-info)
(cl-struct-slot-offset): Rewrite.
* lisp/emacs-lisp/cl-generic.el (cl--generic-struct-specializers)
(cl-generic-generalizers): Rewrite.
* src/alloc.c (purecopy): Handle hash-tables.

* lisp/emacs-lisp/debug.el (debug--implement-debug-on-entry):
Bind inhibit-debug-on-entry here...
(debug): Instead of here.

* lisp/emacs-lisp/macroexp.el (macroexp--debug-eager): New var.
(internal-macroexpand-for-load): Use it.

* lwlib/xlwmenu.c (pop_up_menu): Remove debugging code.

1 files changed, 21 insertions, 22 deletions

diff --git a/src/alloc.c b/src/alloc.c
index 022782504f1..1f4b1a4694e 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3423,7 +3423,7 @@ union aligned_Lisp_Misc
 };
 
 /* Allocation of markers and other objects that share that structure.
-   Works like allocation of conses. */
+   Works like allocation of conses.  */
 
 #define MARKER_BLOCK_SIZE \
   ((1020 - sizeof (struct marker_block *)) / sizeof (union aligned_Lisp_Misc))
@@ -4744,7 +4744,7 @@ mark_maybe_pointer (void *p)
 #endif
 
 /* Mark Lisp objects referenced from the address range START+OFFSET..END
-   or END+OFFSET..START. */
+   or END+OFFSET..START.  */
 
 static void ATTRIBUTE_NO_SANITIZE_ADDRESS
 mark_memory (void *start, void *end)
@@ -5356,7 +5356,6 @@ make_pure_vector (ptrdiff_t len)
   return new;
 }
 
-
 DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
        doc: /* Make a copy of object OBJ in pure storage.
 Recursively copies contents of vectors and cons cells.
@@ -5391,28 +5390,26 @@ purecopy (Lisp_Object obj)
   else if (FLOATP (obj))
     obj = make_pure_float (XFLOAT_DATA (obj));
   else if (STRINGP (obj))
-    obj = make_pure_string (SSDATA (obj), SCHARS (obj),
-			    SBYTES (obj),
-			    STRING_MULTIBYTE (obj));
-  else if (COMPILEDP (obj) || VECTORP (obj))
     {
-      register struct Lisp_Vector *vec;
+      if (XSTRING (obj)->intervals)
+	message ("Dropping text-properties when making string pure");
+      obj = make_pure_string (SSDATA (obj), SCHARS (obj),
+			      SBYTES (obj),
+			      STRING_MULTIBYTE (obj));
+    }
+  else if (COMPILEDP (obj) || VECTORP (obj) || HASH_TABLE_P (obj))
+    {
+      struct Lisp_Vector *objp = XVECTOR (obj);
+      ptrdiff_t nbytes = vector_nbytes (objp);
+      struct Lisp_Vector *vec = pure_alloc (nbytes, Lisp_Vectorlike);
       register ptrdiff_t i;
-      ptrdiff_t size;
-
-      size = ASIZE (obj);
+      ptrdiff_t size = ASIZE (obj);
       if (size & PSEUDOVECTOR_FLAG)
 	size &= PSEUDOVECTOR_SIZE_MASK;
-      vec = XVECTOR (make_pure_vector (size));
+      memcpy (vec, objp, nbytes);
       for (i = 0; i < size; i++)
-	vec->contents[i] = purecopy (AREF (obj, i));
-      if (COMPILEDP (obj))
-	{
-	  XSETPVECTYPE (vec, PVEC_COMPILED);
-	  XSETCOMPILED (obj, vec);
-	}
-      else
-	XSETVECTOR (obj, vec);
+	vec->contents[i] = purecopy (vec->contents[i]);
+      XSETVECTOR (obj, vec);
     }
   else if (SYMBOLP (obj))
     {
@@ -5422,6 +5419,7 @@ purecopy (Lisp_Object obj)
 	  XSYMBOL (obj)->pinned = true;
 	  symbol_block_pinned = symbol_block;
 	}
+      /* Don't hash-cons it.  */
       return obj;
     }
   else
@@ -6229,13 +6227,14 @@ mark_discard_killed_buffers (Lisp_Object list)
 void
 mark_object (Lisp_Object arg)
 {
-  register Lisp_Object obj = arg;
+  register Lisp_Object obj;
   void *po;
 #ifdef GC_CHECK_MARKED_OBJECTS
   struct mem_node *m;
 #endif
   ptrdiff_t cdr_count = 0;
 
+  obj = arg;
  loop:
 
   po = XPNTR (obj);
@@ -6870,7 +6869,7 @@ sweep_symbols (void)
   total_free_symbols = num_free;
 }
 
-NO_INLINE /* For better stack traces */
+NO_INLINE /* For better stack traces.  */
 static void
 sweep_misc (void)
 {