From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: Alex Gramiak Newsgroups: gmane.emacs.devel Subject: Help with adding an auxiliary bytecode table Date: Thu, 18 Apr 2019 09:53:22 -0600 Message-ID: <87pnpj9uod.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="75892"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu Apr 18 17:54:23 2019 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:256) (Exim 4.89) (envelope-from ) id 1hH9Mk-000Jcd-EM for ged-emacs-devel@m.gmane.org; Thu, 18 Apr 2019 17:54:22 +0200 Original-Received: from localhost ([127.0.0.1]:43389 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hH9Mi-0001vA-T2 for ged-emacs-devel@m.gmane.org; Thu, 18 Apr 2019 11:54:20 -0400 Original-Received: from eggs.gnu.org ([209.51.188.92]:48805) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1hH9Lu-0001uk-St for emacs-devel@gnu.org; Thu, 18 Apr 2019 11:53:32 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hH9Ls-0003LO-Tp for emacs-devel@gnu.org; Thu, 18 Apr 2019 11:53:30 -0400 Original-Received: from mail-pl1-x632.google.com ([2607:f8b0:4864:20::632]:33859) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hH9Ls-0003JM-Gc for emacs-devel@gnu.org; Thu, 18 Apr 2019 11:53:28 -0400 Original-Received: by mail-pl1-x632.google.com with SMTP id y6so1377353plt.1 for ; Thu, 18 Apr 2019 08:53:27 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:subject:date:message-id:user-agent:mime-version; bh=F2GFwcNaqVlBbnwUavF7Hr9aaechQfEYdOTAoRKtikk=; b=f4wHdAVuJz7xs7NfnioXP+vaefs8BD9T51QEHvuDztaOLZm0Xtx/0Zr7TQBHZv+1U3 g29Hza0SzmiWZkJ3yNco7OsJg/k6bibLa8GKcnPpQ3Rwg5fcH94VZYystYh0/cg8FK23 NUwOgSjWOfguAwNL8cuBq6QqEIiJdjbyP3S7kn+ztfC3SuYUXserJH7Jcv7GPEeiERm8 VJPZX6ulvS+A6GPqgfXxn/jcjuIr09w2RV4pXpaACUo0H9ZJZSWDHRO7pPEAPEIg2jIl sDGIQHS5GA10Cl0nb1EvRf+b/YB2Xu2FpdisDCFuFhAoLBNhbt9Ym37l5IhcaEvzrmJU OaGg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:date:message-id:user-agent :mime-version; bh=F2GFwcNaqVlBbnwUavF7Hr9aaechQfEYdOTAoRKtikk=; b=Db7KN9EDpIPbL11QCJ0vD5pe8bzdeq2WO3kgSNXdwbDaVHinbiB5qd+E+SGKRZCJSl FIraxiPpuvbq6nlq4YvWW6ueBodyKU8CU+JM/3b+2EYthnODcAGdRkhZDF05qCVRCZ4c 0Y85we9Sx/VgtnSS4t4AmMESmuYDk2X60BJO3ow2GewEYhJiJ5IGgW3ZmCTCCSd/Aq3j aYIp35DBolsiVEwHWckb4BTyIWTnRy8kJtIvxwdAv9xjuUvr9wkdzeNbANI9WaCr8cI/ YayQSXin+0QD2qMBAhvTTID+p25Wn8Qudw6GVe8V8UhDePOobeUmRlcbc5ffY6C3kRo4 VbLQ== X-Gm-Message-State: APjAAAWvr4iTEoXM9lQy0FTwMQLakLUyKikxZPy3xFjadTaE4Krt9gcy ByB00HAfP1nKrhNJb2Pm91R/d1wh X-Google-Smtp-Source: APXvYqxedqbQ8xMRDCyqHLM4Kxwd9UbXpqTrpcCKWJroL7Ok3/CQgDqa4lT3+Er8KGkKaXXfcIOpQQ== X-Received: by 2002:a17:902:28a9:: with SMTP id f38mr76014111plb.295.1555602805906; Thu, 18 Apr 2019 08:53:25 -0700 (PDT) Original-Received: from lylat ([2604:3d09:e37f:1500:1a72:4878:e793:7302]) by smtp.gmail.com with ESMTPSA id a80sm5626771pfj.61.2019.04.18.08.53.24 for (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Thu, 18 Apr 2019 08:53:24 -0700 (PDT) X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2607:f8b0:4864:20::632 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:235621 Archived-At: --=-=-= Content-Type: text/plain 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. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=aux-table.diff Content-Description: bytecode 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) + ;;; 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 +}; + /* 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) } +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); --=-=-=--