From 2376ca2baed8d1bc06265c432f4afbe353adc3e0 Mon Sep 17 00:00:00 2001 From: Graham Dobbins Date: Sun, 12 Mar 2017 22:22:19 -0400 Subject: [PATCH] Optimize bytecode interpeter for numeric comparisons of list length When the bytecode interpreter encounters a length bytecode with a list argument followed by a comparison bytecode it defers to the new special purpose length comparison functions. * src/bytecode.c (exec_byte_code): Change the Blength bytecode case and add the new functions. * lisp/emacs-lisp/byte-opt.el (byte-optimize-binary-predicate, byte-optimize-predicate): Make the byte-compiler put the length and comparison bytecodes next to each other when possible. * src/lisp.h (length_Beqlsign, length_Bgtr, length_Blss, length_Bleq, length_Bgeq, length_Beq): Declare new C functions. --- lisp/emacs-lisp/byte-opt.el | 37 +++++-- src/bytecode.c | 233 +++++++++++++++++++++++++++++++++++++++++++- src/lisp.h | 6 ++ 3 files changed, 265 insertions(+), 11 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 004f2e2865..f3a24d9d26 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -862,15 +862,23 @@ byte-optimize-logmumble (defun byte-optimize-binary-predicate (form) (cond - ((or (not (macroexp-const-p (nth 1 form))) - (nthcdr 3 form)) ;; In case there are more than 2 args. - form) - ((macroexp-const-p (nth 2 form)) - (condition-case () - (list 'quote (eval form)) - (error form))) - (t ;; This can enable some lapcode optimizations. - (list (car form) (nth 2 form) (nth 1 form))))) + ((nthcdr 3 form) form) + ((not (macroexp-const-p (nth 1 form))) + (if (and + (memq (car form) '(= eq equal)) + (eq (car-safe (cadr form)) 'length) + (macroexp-const-p (nth 2 form))) + (list (car form) (nth 2 form) (nth 1 form)) + form)) + ((macroexp-const-p (nth 2 form)) + (condition-case () + (list 'quote (eval form)) + (error form))) + ((and (memq (car form) '(= eq equal)) + (eq (car-safe (caddr form)) 'length)) + form) + (t ;; This can enable some lapcode optimizations. + (list (car form) (nth 2 form) (nth 1 form))))) (defun byte-optimize-predicate (form) (let ((ok t) @@ -882,7 +890,16 @@ byte-optimize-predicate (condition-case () (list 'quote (eval form)) (error form)) - form))) + (let ((swap (assoc (car form) + '((< . >) (> . <) + (<= . >=) (>= . <=) + (= . =))))) + (if (and swap + (= 3 (length form)) + (eq (car-safe (cadr form)) 'length) + (macroexp-const-p (nth 2 form))) + (list (cdr swap) (nth 2 form) (nth 1 form)) + form))))) (defun byte-optimize-identity (form) (if (and (cdr form) (null (cdr (cdr form)))) diff --git a/src/bytecode.c b/src/bytecode.c index e781a87d16..b00ac4d096 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -310,6 +310,10 @@ enum byte_code_op #define TOP (*top) +/* Look at the next byte of the bytecode stream. */ + +#define PEEK (*pc) + DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0, doc: /* Function used internally in byte-compiled code. The first argument, BYTESTR, is a string of byte code; @@ -907,7 +911,54 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Blength): - TOP = Flength (TOP); + if (CONSP (TOP)) + { + Lisp_Object v1; + switch (PEEK) + { + case Beqlsign: + op = FETCH; + v1 = POP; + TOP = length_Beqlsign (TOP, v1); + break; + + case Bgtr: + op = FETCH; + v1 = POP; + TOP = length_Bgtr (TOP, v1); + break; + + case Blss: + op = FETCH; + v1 = POP; + TOP = length_Blss (TOP, v1); + break; + + case Bleq: + op = FETCH; + v1 = POP; + TOP = length_Bleq (TOP, v1); + break; + + case Bgeq: + op = FETCH; + v1 = POP; + TOP = length_Bgeq (TOP, v1); + break; + + case Beq: + case Bequal: + op = FETCH; + v1 = POP; + TOP = length_Beq (TOP, v1); + break; + + default: + TOP = Flength (TOP); + } + } + else + TOP = Flength (TOP); NEXT; CASE (Baref): @@ -1522,3 +1573,183 @@ integer, it is incremented each time that symbol's function is called. */); } #endif } + +/* The following are used above in the Blength case. Each assumes s1 + is a number or marker and s2 is a list. */ + +Lisp_Object +length_Beqlsign (Lisp_Object s1, Lisp_Object s2) +{ + Lisp_Object val = Qnil; + + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s1); + + if (__builtin_expect (FLOATP (s1), 0)) + { + s2 = Flength(s2); + val = arithcompare (s1, s2, ARITH_EQUAL); + } + else + { + intptr_t n = XINT (s1); + intptr_t i = 0; + FOR_EACH_TAIL (s2) + { + i++; + if (i > n) + return val; + } + CHECK_LIST_END (s2, s2); + if (i == n) + val = Qt; + } + + return val; +} + +Lisp_Object +length_Bgtr (Lisp_Object s1, Lisp_Object s2) +{ + Lisp_Object val = Qnil; + + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s1); + + if (__builtin_expect (FLOATP (s1), 0)) + { + s2 = Flength(s2); + val = arithcompare (s1, s2, ARITH_GRTR); + } + else + { + intptr_t n = XINT (s1); + intptr_t i = 0; + FOR_EACH_TAIL (s2) + { + i++; + if (i >= n) + return val; + } + CHECK_LIST_END (s2, s2); + if (i < n) + val = Qt; + } + + return val; +} + +Lisp_Object +length_Blss (Lisp_Object s1, Lisp_Object s2) +{ + Lisp_Object val = Qnil; + + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s1); + + if (__builtin_expect (FLOATP (s1), 0)) + { + s2 = Flength(s2); + val = arithcompare (s1, s2, ARITH_LESS); + } + else + { + intptr_t n = XINT (s1); + intptr_t i = 0; + FOR_EACH_TAIL (s2) + { + i++; + if (i > n) + { + if (! CONSP (s2)) + CHECK_LIST_END (s2, s2); + return Qt; + } + } + CHECK_LIST_END (s2, s2); + } + + return val; +} + +Lisp_Object +length_Bleq (Lisp_Object s1, Lisp_Object s2) +{ + Lisp_Object val = Qnil; + + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s1); + + if (__builtin_expect (FLOATP (s1), 0)) + { + s2 = Flength(s2); + val = arithcompare (s1, s2, ARITH_LESS_OR_EQUAL); + } + else + { + intptr_t n = XINT (s1); + intptr_t i = 0; + FOR_EACH_TAIL (s2) + { + i++; + if (i >= n) + { + if (! CONSP (s2)) + CHECK_LIST_END (s2, s2); + return Qt; + } + } + CHECK_LIST_END (s2, s2); + } + + return val; +} + +Lisp_Object +length_Bgeq (Lisp_Object s1, Lisp_Object s2) +{ + Lisp_Object val = Qnil; + + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (s1); + + if (__builtin_expect (FLOATP (s1), 0)) + { + s2 = Flength(s2); + val = arithcompare (s1, s2, ARITH_GRTR_OR_EQUAL); + } + else + { + intptr_t n = XINT (s1); + intptr_t i = 0; + FOR_EACH_TAIL (s2) + { + i++; + if (i > n) + return val; + } + CHECK_LIST_END (s2, s2); + if (i <= n) + val = Qt; + } + + return val; +} + +Lisp_Object +length_Beq (Lisp_Object s1, Lisp_Object s2) +{ + Lisp_Object val = Qnil; + + if (INTEGERP (s1)) + { + intptr_t n = XINT (s1); + intptr_t i = 0; + FOR_EACH_TAIL (s2) + { + i++; + if (i > n) + return val; + } + CHECK_LIST_END (s2, s2); + if (i == n) + val = Qt; + } + + return val; +} diff --git a/src/lisp.h b/src/lisp.h index ab4db4cac0..cbda641acd 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4151,6 +4151,12 @@ extern void syms_of_bytecode (void); extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, ptrdiff_t, Lisp_Object *); extern Lisp_Object get_byte_code_arity (Lisp_Object); +Lisp_Object length_Beqlsign (Lisp_Object, Lisp_Object); +Lisp_Object length_Bgtr (Lisp_Object, Lisp_Object); +Lisp_Object length_Blss (Lisp_Object, Lisp_Object); +Lisp_Object length_Bleq (Lisp_Object, Lisp_Object); +Lisp_Object length_Bgeq (Lisp_Object, Lisp_Object); +Lisp_Object length_Beq (Lisp_Object, Lisp_Object); /* Defined in macros.c. */ extern void init_macros (void); -- 2.12.0