Help with adding an auxiliary bytecode table

Help with adding an auxiliary bytecode table

[Alex Gramiak]

[-- Attachment #1: Type: text/plain, Size: 1159 bytes --]

I've attached a diff below that adds an auxiliary optable to bytecode.c
and attempts to integrate it into bytecode.el. I can run emacs -Q with
it, but when I run it with my configuration I get the following in
stderr:

  Invalid function: ((bytecomp "Wrong type argument: arrayp, nil" :error
  "*Compile-Log*"))

And then Emacs aborts (--debug-init doesn't change this). Would someone
with experience in the bytecompiler be so kind as to help me fix this?
My initial reaction is that the stale bytecode is somehow incompatible,
but then why does emacs -Q run fine?

Flymake in every elisp buffer is reporting that the first require or
provide in the buffer contains a "Wrong type argument: arrayp, nil".

Background:

I wanted to add a new search procedure for vectors that was faster than
memq, and vector-memq turns out to be. The problem is that since memq is
a bytecode operation, it turns out to be faster than vector-memq for
small input unless I make sure that memq isn't turned into a bytecode
op. So since the current space in the lookup table is limited, I figured
that a prefix command that looks up in a secondary table would be a good
solution.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: bytecode --]
[-- Type: text/x-patch, Size: 11664 bytes --]

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 44cca6136c..7087c5799b 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1324,7 +1324,7 @@ byte-decompile-bytecode
 (defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable)
   (let ((length (length bytes))
         (bytedecomp-ptr 0) optr tags bytedecomp-op offset
-	lap tmp last-constant)
+	lap tmp last-constant auxp)
     (while (not (= bytedecomp-ptr length))
       (or make-spliceable
 	  (push bytedecomp-ptr lap))
@@ -1332,7 +1332,10 @@ byte-decompile-bytecode-1
 	    optr bytedecomp-ptr
             ;; This uses dynamic-scope magic.
             offset (disassemble-offset bytes))
-      (let ((opcode (aref byte-code-vector bytedecomp-op)))
+      (let ((opcode (if auxp
+                        (progn (setq auxp nil)
+                               (aref aux-byte-code-vector bytedecomp-op))
+                      (aref byte-code-vector bytedecomp-op))))
 	(cl-assert opcode)
 	(setq bytedecomp-op opcode))
       (cond ((memq bytedecomp-op byte-goto-ops)
@@ -1390,7 +1393,9 @@ byte-decompile-bytecode-1
                                   (eq (nth 2 el) orig-table))
                         ;; Jump tables are never reused, so do this exactly
                         ;; once.
-                        do (setf (nth 2 el) last-constant) and return nil))))
+                        do (setf (nth 2 el) last-constant) and return nil)))
+            ((eq bytedecomp-op 'byte-aux)
+             (setq auxp t)))
       ;; lap = ( [ (pc . (op . arg)) ]* )
       (push (cons optr (cons bytedecomp-op (or offset 0)))
             lap)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 8bbe6292d9..b81b138522 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -557,7 +557,13 @@ byte-code-vector
 (defvar byte-stack+-info nil
   "An array with the stack adjustment for each byte-code.")
 
-(defmacro byte-defop (opcode stack-adjust opname &optional docstring)
+(defvar aux-byte-code-vector nil
+  "An array containing byte-code names indexed by auxiliary byte-code values.")
+
+(defvar aux-byte-stack+-info nil
+  "An array with the stack adjustment for each auxiliary byte-code.")
+
+(defmacro byte--defop-internal (bcv bsi opcode stack-adjust opname &optional docstring)
   ;; This is a speed-hack for building the byte-code-vector at compile-time.
   ;; We fill in the vector at macroexpand-time, and then after the last call
   ;; to byte-defop, we write the vector out as a constant instead of writing
@@ -565,11 +571,11 @@ byte-defop
   ;; Actually, we don't fill in the vector itself, because that could make
   ;; it problematic to compile big changes to this compiler; we store the
   ;; values on its plist, and remove them later in -extrude.
-  (let ((v1 (or (get 'byte-code-vector 'tmp-compile-time-value)
-		(put 'byte-code-vector 'tmp-compile-time-value
+  (let ((v1 (or (get bcv 'tmp-compile-time-value)
+		(put bcv 'tmp-compile-time-value
 		     (make-vector 256 nil))))
-	(v2 (or (get 'byte-stack+-info 'tmp-compile-time-value)
-		(put 'byte-stack+-info 'tmp-compile-time-value
+	(v2 (or (get bsi 'tmp-compile-time-value)
+		(put bsi 'tmp-compile-time-value
 		     (make-vector 256 nil)))))
     (aset v1 opcode opname)
     (aset v2 opcode stack-adjust))
@@ -577,14 +583,36 @@ byte-defop
       (list 'defconst opname opcode (concat "Byte code opcode " docstring "."))
       (list 'defconst opname opcode)))
 
+(defmacro byte-defop (opcode stack-adjust opname &optional docstring)
+  `(byte--defop-internal byte-code-vector
+                         byte-stack+-info
+                         ,opcode
+                         ,stack-adjust
+                         ,opname
+                         ,docstring))
+
+(defmacro byte-defauxop (opcode stack-adjust opname &optional docstring)
+  `(byte--defop-internal aux-byte-code-vector
+                         aux-byte-stack+-info
+                         ,opcode
+                         ,stack-adjust
+                         ,opname
+                         ,docstring))
+
+(defmacro byte--extrude-byte-code-vectors-internal (bcv bsi)
+  (prog1 (list 'setq bcv
+		     (get bcv 'tmp-compile-time-value)
+		     bsi
+		     (get bsi 'tmp-compile-time-value))
+    (put bcv 'tmp-compile-time-value nil)
+    (put bsi 'tmp-compile-time-value nil)))
+
 (defmacro byte-extrude-byte-code-vectors ()
-  (prog1 (list 'setq 'byte-code-vector
-		     (get 'byte-code-vector 'tmp-compile-time-value)
-		     'byte-stack+-info
-		     (get 'byte-stack+-info 'tmp-compile-time-value))
-    (put 'byte-code-vector 'tmp-compile-time-value nil)
-    (put 'byte-stack+-info 'tmp-compile-time-value nil)))
+  (byte--extrude-byte-code-vectors-internal byte-code-vector byte-stack+-info))
 
+(defmacro byte-extrude-aux-byte-code-vectors ()
+  (byte--extrude-byte-code-vectors-internal aux-byte-code-vector
+                                            aux-byte-stack+-info))
 
 ;; These opcodes are special in that they pack their argument into the
 ;; opcode word.
@@ -770,13 +798,18 @@ byte-discardN-preserve-tos
  "to take a hash table and a value from the stack, and jump to the address
 the value maps to, if any.")
 
-;; unused: 182-191
+;; unused: 182-190
 
+(byte-defop 191  0 byte-aux)            ; New in 27.1
 (byte-defop 192  1 byte-constant	"for reference to a constant")
 ;; codes 193-255 are consumed by byte-constant.
 (defconst byte-constant-limit 64
   "Exclusive maximum index usable in the `byte-constant' opcode.")
 
+;; Auxiliary byteops
+
+(byte-defauxop 56  0 byte-vector-memq)
+
 (defconst byte-goto-ops '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
 			  byte-goto-if-nil-else-pop
 			  byte-goto-if-not-nil-else-pop
@@ -786,6 +819,8 @@ byte-goto-ops
 (defconst byte-goto-always-pop-ops '(byte-goto-if-nil byte-goto-if-not-nil))
 
 (byte-extrude-byte-code-vectors)
+(byte-extrude-aux-byte-code-vectors)
+
 \f
 ;;; lapcode generator
 ;;
@@ -3449,6 +3484,7 @@ byte-defop-compiler
 					(0-1 . byte-compile-zero-or-one-arg)
 					(1-2 . byte-compile-one-or-two-args)
 					(2-3 . byte-compile-two-or-three-args)
+                                        (2-aux . byte-compile-aux-two-args)
 					)))
 			   compile-handler
 			   (intern (concat "byte-compile-"
@@ -3559,6 +3595,8 @@ byte-defop-compiler-1
 (byte-defop-compiler (% byte-rem)	2)
 (byte-defop-compiler aset		3)
 
+(byte-defop-compiler vector-memq	2-aux)
+
 (byte-defop-compiler max		byte-compile-associative)
 (byte-defop-compiler min		byte-compile-associative)
 (byte-defop-compiler (+ byte-plus)	byte-compile-associative)
@@ -3587,11 +3625,13 @@ byte-compile-one-arg
     (byte-compile-form (car (cdr form)))  ;; Push the argument
     (byte-compile-out (get (car form) 'byte-opcode) 0)))
 
-(defun byte-compile-two-args (form)
+(defun byte-compile-two-args (form &optional aux)
   (if (not (= (length form) 3))
       (byte-compile-subr-wrong-args form 2)
     (byte-compile-form (car (cdr form)))  ;; Push the arguments
     (byte-compile-form (nth 2 form))
+    (when aux
+      (byte-compile-out 'byte-aux))
     (byte-compile-out (get (car form) 'byte-opcode) 0)))
 
 (defun byte-compile-and-folded (form)
@@ -3633,6 +3673,9 @@ byte-compile-two-or-three-args
 	  ((= len 4) (byte-compile-three-args form))
 	  (t (byte-compile-subr-wrong-args form "2-3")))))
 
+(defun byte-compile-aux-two-args (form)
+  (byte-compile-two-args form t))
+
 (defun byte-compile-noop (_form)
   (byte-compile-constant nil))
 
diff --git a/src/bytecode.c b/src/bytecode.c
index 40977799bf..81d1ff6a8a 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -270,8 +270,13 @@ DEFINE (BdiscardN,   0266)						\
 									\
 DEFINE (Bswitch, 0267)                                                  \
                                                                         \
+DEFINE (Baux, 0277)                                                     \
 DEFINE (Bconstant, 0300)
 
+#define AUX_BYTE_CODES                                                  \
+DEFINE (Bvector_memq, 070)                                              \
+
+
 enum byte_code_op
 {
 #define DEFINE(name, value) name = value,
@@ -283,6 +288,14 @@ enum byte_code_op
     Bset_mark = 0163, /* this loser is no longer generated as of v18 */
 #endif
 };
+
+enum aux_byte_code_op
+{
+#define DEFINE(name, value) name = value,
+  AUX_BYTE_CODES
+#undef DEFINE
+};
+
 \f
 /* Fetch the next byte from the bytecode stream.  */
 
@@ -429,10 +442,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 	 next instruction.  It is either a computed goto, or a
 	 plain break.  */
 #define NEXT goto *(targets[op = FETCH])
+      /* Same as NEXT, but with auxiliary operations.  */
+#define NEXT_AUX goto *(aux_targets[op = FETCH])
       /* FIRST is like NEXT, but is only used at the start of the
 	 interpreter body.  In the switch-based interpreter it is the
 	 switch, so the threaded definition must include a semicolon.  */
 #define FIRST NEXT;
+#define FIRST_AUX NEXT_AUX;
       /* Most cases are labeled with the CASE macro, above.
 	 CASE_DEFAULT is one exception; it is used if the interpreter
 	 being built requires a default case.  The threaded
@@ -445,7 +461,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
       /* See above for the meaning of the various defines.  */
 #define CASE(OP) case OP
 #define NEXT break
+#define NEXT_AUX NEXT
 #define FIRST switch (op)
+#define FIRST_AUX FIRST
 #define CASE_DEFAULT case 255: default:
 #define CASE_ABORT case 0
 #endif
@@ -464,9 +482,15 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 
 #define DEFINE(name, value) LABEL (name) ,
 	  BYTE_CODES
-#undef DEFINE
 	};
 
+      /* This is the auxiliary dispatch table.  */
+      static const void *const aux_targets[256] =
+        {
+          [0 ... 255] = &&insn_default,
+          AUX_BYTE_CODES
+#undef DEFINE
+        };
 #endif
 
 
@@ -1434,6 +1458,24 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
           }
           NEXT;
 
+        CASE (Baux):
+          {
+            FIRST_AUX
+              {
+              CASE (Bvector_memq):
+                {
+                  Lisp_Object v1 = POP;
+                  TOP = Fvector_memq (TOP, v1);
+                  NEXT;
+                }
+              CASE_DEFAULT
+                if (BYTE_CODE_SAFE)
+                  emacs_abort ();
+              /* Not sure what to do here.  */
+                NEXT;
+              }
+          }
+
 	CASE_DEFAULT
 	CASE (Bconstant):
 	  if (BYTE_CODE_SAFE
diff --git a/src/fns.c b/src/fns.c
index c3202495da..2349c1b169 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2134,6 +2134,20 @@ merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred)
 }
 
 \f
+DEFUN ("vector-memq", Fvector_memq, Svector_memq, 2, 2, 0,
+       doc: /* Return index of ELT is an element of VECTOR.  Comparison done with `eq'.
+The value is nil if ELT is not found in VECTOR.  */)
+  (Lisp_Object elt, Lisp_Object vector)
+{
+  CHECK_VECTOR (vector);
+  ptrdiff_t len = ASIZE (vector);
+
+  for (ptrdiff_t i = 0; i < len; ++i)
+    if (EQ (elt, AREF (vector, i)))
+      return make_fixnum (i);
+
+  return Qnil;
+}
 /* This does not check for quits.  That is safe since it must terminate.  */
 
 DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
@@ -5417,6 +5431,7 @@ this variable.  */);
   defsubr (&Sdelete);
   defsubr (&Snreverse);
   defsubr (&Sreverse);
+  defsubr (&Svector_memq);
   defsubr (&Ssort);
   defsubr (&Splist_get);
   defsubr (&Sget);

Re: Help with adding an auxiliary bytecode table

[Paul Eggert]

On 4/18/19 8:53 AM, Alex Gramiak wrote:
>   Invalid function: ((bytecomp "Wrong type argument: arrayp, nil" :error
>   "*Compile-Log*"))

This kind of symptom often means you just messed up somewhere in the
interpreter and have trashed its data structures somehow. You might try
building with --enable-checking or --enable-checking=all or with the
usual sanitization flags for your compiler.

Re: Help with adding an auxiliary bytecode table

[Alex Gramiak]

Paul Eggert <eggert@cs.ucla.edu> writes:

> On 4/18/19 8:53 AM, Alex Gramiak wrote:
>>   Invalid function: ((bytecomp "Wrong type argument: arrayp, nil" :error
>>   "*Compile-Log*"))
>
> This kind of symptom often means you just messed up somewhere in the
> interpreter and have trashed its data structures somehow. You might try
> building with --enable-checking or --enable-checking=all or with the
> usual sanitization flags for your compiler.

Thanks. Turns out it was due to some interaction between my previous
Emacs build's bytecompiler and the new one, since removing
lisp/emacs-lisp/bytecomp.elc and trying to build gave me the wrong type
argument error at build-time.

I managed to fix the problem (ill-defined macro) and get it working.

Re: Help with adding an auxiliary bytecode table

[Stefan Monnier]

> I've attached a diff below that adds an auxiliary optable to bytecode.c
> and attempts to integrate it into bytecode.el. I can run emacs -Q with
> it, but when I run it with my configuration I get the following in
> stderr:
>
>   Invalid function: ((bytecomp "Wrong type argument: arrayp, nil" :error
>   "*Compile-Log*"))

Use the debugger so you can get a more complete backtrace.

> My initial reaction is that the stale bytecode is somehow incompatible,

What/which stale bytecode?

> The problem is that since memq is a bytecode operation, it turns out
> to be faster than vector-memq for small input

Why is that a problem?

> unless I make sure that memq isn't turned into a bytecode op.
> So since the current space in the lookup table is limited, I figured
> that a prefix command that looks up in a secondary table would be
> a good solution.

We don't have too many bytecodes left, indeed, but there are still some,
IIRC, so it's not indispensable to go a 2-byte bytecodes.


        Stefan

Help with adding new setq-based bytecodes (was: Help with adding an auxiliary bytecode table)

[Alex Gramiak]

[-- Attachment #1: Type: text/plain, Size: 2233 bytes --]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> My initial reaction is that the stale bytecode is somehow incompatible,
>
> What/which stale bytecode?

I meant the bytecode of the previous byte compiler. It turned out not to
be the case (it was a faulty macro that caused this).

>> The problem is that since memq is a bytecode operation, it turns out
>> to be faster than vector-memq for small input
>
> Why is that a problem?

It'd be annoying (to me), since it would mean searching a small vector
of constants would be slower than searching a small list of constants.
Only by a bit, but still.

>> unless I make sure that memq isn't turned into a bytecode op.
>> So since the current space in the lookup table is limited, I figured
>> that a prefix command that looks up in a secondary table would be
>> a good solution.
>
> We don't have too many bytecodes left, indeed, but there are still some,
> IIRC, so it's not indispensable to go a 2-byte bytecodes.

No, but at least for vector-memq, I don't think it warrants taking up
that limited room. Also, I figured that there might be other primitives
that weren't added as a bytecode previously due to the lack of space
that could now be added to this secondary table. Possible candidates:

- append
- assoc
- string-match/match-string
- re-search-forward
- looking-at
- make-byte-code
- fboundp, functionp
- vector/vectorp
- apply
- gethash/puthash


Now I'm having a problem with adding certain bytecodes that (attempt to)
optimize these forms (since they're common in loops):

  (setq X (P X))
  (setq X (cons Y X))

But now when trying to build with the attached patch I get this error:

  make[2]: Entering directory '/home/alex/emacs-test/lisp'
    ELC      ../lisp/emacs-lisp/byte-run.elc

  emacs-lisp/byte-run.el:230:1:Error: Symbol’s value as variable is void: lambda


Is there a way to trigger the lisp debugger here? Calling (debug) before
the error line didn't help, nor did setting debug-on-error non-nil.

Do you have any idea what I did wrong? Making the optimization checks in
byte-compile-setq always fail allows me to build, and I've verified that
the checks don't pass false positives.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: WIP --]
[-- Type: text/x-patch, Size: 18844 bytes --]

From a49cbc7052bf8a1d1ac38d898b2f554ddadbd9b9 Mon Sep 17 00:00:00 2001
From: Alexander Gramiak <agrambot@gmail.com>
Date: Sun, 21 Apr 2019 13:11:57 -0600
Subject: [PATCH] Auxiliary bytecode table WIP

---
 lisp/emacs-lisp/byte-opt.el |  11 ++-
 lisp/emacs-lisp/bytecomp.el | 153 +++++++++++++++++++++++++++---------
 src/bytecode.c              |  80 ++++++++++++++++++-
 src/fns.c                   |  15 ++++
 4 files changed, 220 insertions(+), 39 deletions(-)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 44cca6136c..7087c5799b 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1324,7 +1324,7 @@ byte-decompile-bytecode
 (defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable)
   (let ((length (length bytes))
         (bytedecomp-ptr 0) optr tags bytedecomp-op offset
-	lap tmp last-constant)
+	lap tmp last-constant auxp)
     (while (not (= bytedecomp-ptr length))
       (or make-spliceable
 	  (push bytedecomp-ptr lap))
@@ -1332,7 +1332,10 @@ byte-decompile-bytecode-1
 	    optr bytedecomp-ptr
             ;; This uses dynamic-scope magic.
             offset (disassemble-offset bytes))
-      (let ((opcode (aref byte-code-vector bytedecomp-op)))
+      (let ((opcode (if auxp
+                        (progn (setq auxp nil)
+                               (aref aux-byte-code-vector bytedecomp-op))
+                      (aref byte-code-vector bytedecomp-op))))
 	(cl-assert opcode)
 	(setq bytedecomp-op opcode))
       (cond ((memq bytedecomp-op byte-goto-ops)
@@ -1390,7 +1393,9 @@ byte-decompile-bytecode-1
                                   (eq (nth 2 el) orig-table))
                         ;; Jump tables are never reused, so do this exactly
                         ;; once.
-                        do (setf (nth 2 el) last-constant) and return nil))))
+                        do (setf (nth 2 el) last-constant) and return nil)))
+            ((eq bytedecomp-op 'byte-aux)
+             (setq auxp t)))
       ;; lap = ( [ (pc . (op . arg)) ]* )
       (push (cons optr (cons bytedecomp-op (or offset 0)))
             lap)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 4c61e1a447..89870bf041 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -557,7 +557,13 @@ byte-code-vector
 (defvar byte-stack+-info nil
   "An array with the stack adjustment for each byte-code.")
 
-(defmacro byte-defop (opcode stack-adjust opname &optional docstring)
+(defvar aux-byte-code-vector nil
+  "An array containing byte-code names indexed by auxiliary byte-code values.")
+
+(defvar aux-byte-stack+-info nil
+  "An array with the stack adjustment for each auxiliary byte-code.")
+
+(defmacro byte--defop-internal (bcv bsi opcode stack-adjust opname &optional docstring)
   ;; This is a speed-hack for building the byte-code-vector at compile-time.
   ;; We fill in the vector at macroexpand-time, and then after the last call
   ;; to byte-defop, we write the vector out as a constant instead of writing
@@ -565,11 +571,11 @@ byte-defop
   ;; Actually, we don't fill in the vector itself, because that could make
   ;; it problematic to compile big changes to this compiler; we store the
   ;; values on its plist, and remove them later in -extrude.
-  (let ((v1 (or (get 'byte-code-vector 'tmp-compile-time-value)
-		(put 'byte-code-vector 'tmp-compile-time-value
+  (let ((v1 (or (get bcv 'tmp-compile-time-value)
+		(put bcv 'tmp-compile-time-value
 		     (make-vector 256 nil))))
-	(v2 (or (get 'byte-stack+-info 'tmp-compile-time-value)
-		(put 'byte-stack+-info 'tmp-compile-time-value
+	(v2 (or (get bsi 'tmp-compile-time-value)
+		(put bsi 'tmp-compile-time-value
 		     (make-vector 256 nil)))))
     (aset v1 opcode opname)
     (aset v2 opcode stack-adjust))
@@ -577,14 +583,29 @@ byte-defop
       (list 'defconst opname opcode (concat "Byte code opcode " docstring "."))
       (list 'defconst opname opcode)))
 
-(defmacro byte-extrude-byte-code-vectors ()
-  (prog1 (list 'setq 'byte-code-vector
-		     (get 'byte-code-vector 'tmp-compile-time-value)
-		     'byte-stack+-info
-		     (get 'byte-stack+-info 'tmp-compile-time-value))
-    (put 'byte-code-vector 'tmp-compile-time-value nil)
-    (put 'byte-stack+-info 'tmp-compile-time-value nil)))
-
+(defmacro byte-defop (opcode stack-adjust opname &optional docstring)
+  `(byte--defop-internal byte-code-vector
+                         byte-stack+-info
+                         ,opcode
+                         ,stack-adjust
+                         ,opname
+                         ,docstring))
+
+(defmacro byte-defauxop (opcode stack-adjust opname &optional docstring)
+  `(byte--defop-internal aux-byte-code-vector
+                         aux-byte-stack+-info
+                         ,opcode
+                         ,stack-adjust
+                         ,opname
+                         ,docstring))
+
+(defmacro byte--extrude-byte-code-vectors (bcv bsi)
+  (prog1 (list 'setq bcv
+		     (get bcv 'tmp-compile-time-value)
+		     bsi
+		     (get bsi 'tmp-compile-time-value))
+    (put bcv 'tmp-compile-time-value nil)
+    (put bsi 'tmp-compile-time-value nil)))
 
 ;; These opcodes are special in that they pack their argument into the
 ;; opcode word.
@@ -770,13 +791,21 @@ byte-discardN-preserve-tos
  "to take a hash table and a value from the stack, and jump to the address
 the value maps to, if any.")
 
-;; unused: 182-191
+;; unused: 182-190
 
+(byte-defop 191  0 byte-aux)            ; New in 27.1
 (byte-defop 192  1 byte-constant	"for reference to a constant")
 ;; codes 193-255 are consumed by byte-constant.
 (defconst byte-constant-limit 64
   "Exclusive maximum index usable in the `byte-constant' opcode.")
 
+;; Auxiliary byteops
+(byte-defauxop 10 -1 byte-push)
+(byte-defauxop 11  0 byte-setq-cdr)
+(byte-defauxop 12  0 byte-setq-1+)
+(byte-defauxop 13  0 byte-setq-1-)
+(byte-defauxop 56 -1 byte-vector-memq)
+
 (defconst byte-goto-ops '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
 			  byte-goto-if-nil-else-pop
 			  byte-goto-if-not-nil-else-pop
@@ -785,7 +814,9 @@ byte-goto-ops
 
 (defconst byte-goto-always-pop-ops '(byte-goto-if-nil byte-goto-if-not-nil))
 
-(byte-extrude-byte-code-vectors)
+(byte--extrude-byte-code-vectors byte-code-vector byte-stack+-info)
+(byte--extrude-byte-code-vectors aux-byte-code-vector aux-byte-stack+-info)
+
 \f
 ;;; lapcode generator
 ;;
@@ -3373,21 +3404,29 @@ byte-compile-variable-ref
 	(push var byte-compile-free-references))
       (byte-compile-dynamic-variable-op 'byte-varref var))))
 
-(defun byte-compile-variable-set (var)
-  "Generate code to set the variable VAR from the top-of-stack value."
+(defun byte-compile--handle-free-assignment (var)
+  (unless (or (not (byte-compile-warning-enabled-p 'free-vars))
+	      (boundp var)
+	      (memq var byte-compile-bound-variables)
+	      (memq var byte-compile-free-assignments))
+    (byte-compile-warn "assignment to free variable `%s'" var)
+    (push var byte-compile-free-assignments)))
+
+(defun byte-compile-variable-set (var lex-binding custom-op)
+  "Generate code to set the variable VAR from the top-of-stack value.
+If CUSTOM-OP and LEX-BINDING are non-nil, use CUSTOM-OP instead
+of `byte-stack-set'."
   (byte-compile-check-variable var 'assign)
-  (let ((lex-binding (assq var byte-compile--lexical-environment)))
-    (if lex-binding
-	;; VAR is lexically bound.
-        (byte-compile-stack-set (cdr lex-binding))
-      ;; VAR is dynamically bound.
-      (unless (or (not (byte-compile-warning-enabled-p 'free-vars))
-		  (boundp var)
-		  (memq var byte-compile-bound-variables)
-		  (memq var byte-compile-free-assignments))
-	(byte-compile-warn "assignment to free variable `%s'" var)
-	(push var byte-compile-free-assignments))
-      (byte-compile-dynamic-variable-op 'byte-varset var))))
+  (if lex-binding
+      ;; VAR is lexically bound.
+      (if (not custom-op)
+          (byte-compile-stack-set (cdr lex-binding))
+        (byte-compile-out custom-op
+                          (- byte-compile-depth (1+ (cdr lex-binding)))
+                          t))
+    ;; VAR is dynamically bound.
+    (byte-compile--handle-free-assignment var)
+    (byte-compile-dynamic-variable-op 'byte-varset var)))
 
 (defmacro byte-compile-get-constant (const)
   `(or (if (stringp ,const)
@@ -3444,6 +3483,7 @@ byte-defop-compiler
 					(0-1 . byte-compile-zero-or-one-arg)
 					(1-2 . byte-compile-one-or-two-args)
 					(2-3 . byte-compile-two-or-three-args)
+                                        (2-aux . byte-compile-aux-two-args)
 					)))
 			   compile-handler
 			   (intern (concat "byte-compile-"
@@ -3554,6 +3594,8 @@ byte-defop-compiler-1
 (byte-defop-compiler (% byte-rem)	2)
 (byte-defop-compiler aset		3)
 
+(byte-defop-compiler vector-memq	2-aux)
+
 (byte-defop-compiler max		byte-compile-associative)
 (byte-defop-compiler min		byte-compile-associative)
 (byte-defop-compiler (+ byte-plus)	byte-compile-associative)
@@ -3582,11 +3624,13 @@ byte-compile-one-arg
     (byte-compile-form (car (cdr form)))  ;; Push the argument
     (byte-compile-out (get (car form) 'byte-opcode) 0)))
 
-(defun byte-compile-two-args (form)
+(defun byte-compile-two-args (form &optional aux)
   (if (not (= (length form) 3))
       (byte-compile-subr-wrong-args form 2)
     (byte-compile-form (car (cdr form)))  ;; Push the arguments
     (byte-compile-form (nth 2 form))
+    (when aux
+      (byte-compile-out 'byte-aux))
     (byte-compile-out (get (car form) 'byte-opcode) 0)))
 
 (defun byte-compile-and-folded (form)
@@ -3628,6 +3672,9 @@ byte-compile-two-or-three-args
 	  ((= len 4) (byte-compile-three-args form))
 	  (t (byte-compile-subr-wrong-args form "2-3")))))
 
+(defun byte-compile-aux-two-args (form)
+  (byte-compile-two-args form t))
+
 (defun byte-compile-noop (_form)
   (byte-compile-constant nil))
 
@@ -3908,7 +3955,10 @@ byte-compile-insert
 
 (defun byte-compile-setq (form)
   (let* ((args (cdr form))
-         (len (length args)))
+         (len (length args))
+         var
+         lex-binding
+         custom-op)
     (if (= (logand len 1) 1)
         (progn
           (byte-compile-report-error
@@ -3919,10 +3969,34 @@ byte-compile-setq
            byte-compile--for-effect))
       (if args
           (while args
-            (byte-compile-form (car (cdr args)))
+            (setq var (car args))
+            (setq lex-binding (assq var byte-compile--lexical-environment))
+            ;; Optimize some forms of (setq x (P ... x ...))
+            (if (and byte-optimize
+                     lex-binding
+                     (consp (cadr args)))
+                (cond ((and (eq var
+                                (cadadr args))
+                            ;; (setq x (P x))
+                            (memq (caadr args) '(cdr 1+ 1-))
+                            (eql (length (cadr args)) 2))
+                       (cl-case (caadr args)
+                         (1+   (setq custom-op 'byte-setq-1+))
+                         (1-   (setq custom-op 'byte-setq-1-))
+                         (cdr  (setq custom-op 'byte-setq-cdr))))
+                      ((and (eq var
+                                (car (cddadr args)))
+                            (eq (caadr args) 'cons))
+                       ;; (setq x (cons y x))
+                       (byte-compile-form (cadadr args))
+                       (setq custom-op 'byte-push))
+                      (t
+                       (byte-compile-form (car (cdr args)))))
+              (byte-compile-form (car (cdr args))))
             (or byte-compile--for-effect (cdr (cdr args))
                 (byte-compile-out 'byte-dup 0))
-            (byte-compile-variable-set (car args))
+            (byte-compile-variable-set var lex-binding (prog1 custom-op
+                                                         (setq custom-op nil)))
             (setq args (cdr (cdr args))))
         ;; (setq), with no arguments.
         (byte-compile-form nil byte-compile--for-effect)))
@@ -4841,14 +4915,23 @@ byte-compile-stack-adjustment
 	;; a total of 1 - OPERAND
 	(- 1 operand))))
 
-(defun byte-compile-out (op &optional operand)
+(defun byte-compile-aux-stack-adjustment (op operand)
+  "Return the amount by which an auxiliary operation adjusts the stack.
+OP and OPERAND are as passed to `byte-compile-out'."
+  (or (aref aux-byte-stack+-info (symbol-value op))
+      (- 1 operand)))
+
+(defun byte-compile-out (op &optional operand aux)
   (push (cons op operand) byte-compile-output)
   (if (eq op 'byte-return)
       ;; This is actually an unnecessary case, because there should be no
       ;; more ops behind byte-return.
       (setq byte-compile-depth nil)
     (setq byte-compile-depth
-	  (+ byte-compile-depth (byte-compile-stack-adjustment op operand)))
+	  (+ byte-compile-depth
+             (if (not aux)
+                 (byte-compile-stack-adjustment op operand)
+               (byte-compile-aux-stack-adjustment op operand))))
     (setq byte-compile-maxdepth (max byte-compile-depth byte-compile-maxdepth))
     ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow"))
     ))
diff --git a/src/bytecode.c b/src/bytecode.c
index 40977799bf..5f57d8f278 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -270,8 +270,17 @@ DEFINE (BdiscardN,   0266)						\
 									\
 DEFINE (Bswitch, 0267)                                                  \
                                                                         \
+DEFINE (Baux, 0277)                                                     \
 DEFINE (Bconstant, 0300)
 
+#define AUX_BYTE_CODES                                                  \
+DEFINE (Bpush, 012)                                                     \
+DEFINE (Bsetq_cdr, 013)                                                 \
+DEFINE (Bsetq_add1, 014)                                                \
+DEFINE (Bsetq_sub1, 015)                                                \
+DEFINE (Bvector_memq, 070)                                              \
+
+
 enum byte_code_op
 {
 #define DEFINE(name, value) name = value,
@@ -283,6 +292,14 @@ enum byte_code_op
     Bset_mark = 0163, /* this loser is no longer generated as of v18 */
 #endif
 };
+
+enum aux_byte_code_op
+{
+#define DEFINE(name, value) name = value,
+  AUX_BYTE_CODES
+#undef DEFINE
+};
+
 \f
 /* Fetch the next byte from the bytecode stream.  */
 
@@ -429,10 +446,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 	 next instruction.  It is either a computed goto, or a
 	 plain break.  */
 #define NEXT goto *(targets[op = FETCH])
+      /* Same as NEXT, but with auxiliary operations.  */
+#define NEXT_AUX goto *(aux_targets[op = FETCH])
       /* FIRST is like NEXT, but is only used at the start of the
 	 interpreter body.  In the switch-based interpreter it is the
 	 switch, so the threaded definition must include a semicolon.  */
 #define FIRST NEXT;
+#define FIRST_AUX NEXT_AUX;
       /* Most cases are labeled with the CASE macro, above.
 	 CASE_DEFAULT is one exception; it is used if the interpreter
 	 being built requires a default case.  The threaded
@@ -445,7 +465,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
       /* See above for the meaning of the various defines.  */
 #define CASE(OP) case OP
 #define NEXT break
+#define NEXT_AUX NEXT
 #define FIRST switch (op)
+#define FIRST_AUX FIRST
 #define CASE_DEFAULT case 255: default:
 #define CASE_ABORT case 0
 #endif
@@ -464,9 +486,15 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 
 #define DEFINE(name, value) LABEL (name) ,
 	  BYTE_CODES
-#undef DEFINE
 	};
 
+      /* This is the auxiliary dispatch table.  */
+      static const void *const aux_targets[256] =
+        {
+          [0 ... 255] = &&insn_default,
+          AUX_BYTE_CODES
+#undef DEFINE
+        };
 #endif
 
 
@@ -1434,6 +1462,56 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
           }
           NEXT;
 
+        CASE (Baux):
+          {
+            FIRST_AUX
+              {
+              CASE (Bpush):
+                {
+                  Lisp_Object *ptr = top - FETCH;
+                  *ptr = Fcons (POP, *ptr);
+                  NEXT;
+                }
+                CASE (Bsetq_cdr):
+                {
+                  Lisp_Object *ptr = top - FETCH;
+                  if (CONSP (*ptr))
+                    *ptr = XCDR (*ptr);
+                  else if (!NILP (*ptr))
+                    wrong_type_argument (Qlistp, *ptr);
+                  NEXT;
+                }
+                CASE (Bsetq_add1):
+                {
+                  Lisp_Object *ptr = top - FETCH;
+                  *ptr = (FIXNUMP (*ptr) && XFIXNUM (*ptr) != MOST_POSITIVE_FIXNUM
+                          ? make_fixnum (XFIXNUM (*ptr) + 1)
+                          : Fadd1 (*ptr));
+                  NEXT;
+                }
+                CASE (Bsetq_sub1):
+                {
+                  Lisp_Object *ptr = top - FETCH;
+                  *ptr = (FIXNUMP (*ptr) && XFIXNUM (*ptr) != MOST_NEGATIVE_FIXNUM
+                          ? make_fixnum (XFIXNUM (*ptr) - 1)
+                          : Fsub1 (*ptr));
+                  NEXT;
+                }
+              CASE (Bvector_memq):
+                {
+                  Lisp_Object v1 = POP;
+                  TOP = Fvector_memq (TOP, v1);
+                  NEXT;
+                }
+              CASE_DEFAULT
+                if (BYTE_CODE_SAFE)
+                  emacs_abort ();
+              /* Not sure what to do here.  */
+                NEXT;
+              }
+            NEXT;
+          }
+
 	CASE_DEFAULT
 	CASE (Bconstant):
 	  if (BYTE_CODE_SAFE
diff --git a/src/fns.c b/src/fns.c
index c3202495da..a82bd61ef5 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2134,6 +2134,20 @@ merge (Lisp_Object org_l1, Lisp_Object org_l2, Lisp_Object pred)
 }
 
 \f
+DEFUN ("vector-memq", Fvector_memq, Svector_memq, 2, 2, 0,
+       doc: /* Return index of ELT in VECTOR.  Comparison done with `eq'.
+The value is nil if ELT is not found in VECTOR.  */)
+  (Lisp_Object elt, Lisp_Object vector)
+{
+  CHECK_VECTOR (vector);
+  ptrdiff_t len = ASIZE (vector);
+
+  for (ptrdiff_t i = 0; i < len; ++i)
+    if (EQ (elt, AREF (vector, i)))
+      return make_fixnum (i);
+
+  return Qnil;
+}
 /* This does not check for quits.  That is safe since it must terminate.  */
 
 DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
@@ -5417,6 +5431,7 @@ this variable.  */);
   defsubr (&Sdelete);
   defsubr (&Snreverse);
   defsubr (&Sreverse);
+  defsubr (&Svector_memq);
   defsubr (&Ssort);
   defsubr (&Splist_get);
   defsubr (&Sget);
-- 
2.21.0

Re: Help with adding new setq-based bytecodes

[Stefan Monnier]

>> Why is that a problem?
> It'd be annoying (to me), since it would mean searching a small vector
> of constants would be slower than searching a small list of constants.
> Only by a bit, but still.

I think your level of general happiness will be higher when you can stop
worrying about such pesky details.

> No, but at least for vector-memq, I don't think it warrants taking up
> that limited room. Also, I figured that there might be other primitives
> that weren't added as a bytecode previously due to the lack of space
> that could now be added to this secondary table. Possible candidates:

I think a more promising direction would be to speed up the funcall case
enough such that we aren't pressured to add bytecodes for those cases.

>   emacs-lisp/byte-run.el:230:1:Error: Symbol’s value as variable is void: lambda
>
>
> Is there a way to trigger the lisp debugger here?

(setq byte-compile-debug t) is probably what you're looking for
(together with (setq debug-on-error t) which I assume you're already using).

> Do you have any idea what I did wrong?

My crystal ball is not cooperating here, no, sorry.


        Stefan