From af696dd3e37ea46ee0a59670b02bab5a9f3b37ce Mon Sep 17 00:00:00 2001 From: Graham Dobbins Date: Tue, 14 Mar 2017 01:54:29 -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, length_Beqlsign, length_Bgtr, length_Blss, length_Bleq, length_Bgeq, length_Beq, length_compare): 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. --- lisp/emacs-lisp/byte-opt.el | 37 +++++++++---- src/bytecode.c | 123 +++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 149 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..9dee69e3f6 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -310,6 +310,12 @@ enum byte_code_op #define TOP (*top) +/* Look at the next byte of the bytecode stream. */ + +#define PEEK (*pc) + +static void length_compare (unsigned char const **, Lisp_Object **, int *); + 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 +913,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, NEXT; CASE (Blength): - TOP = Flength (TOP); + if (CONSP (TOP)) + length_compare (&pc, &top, &op); + else + TOP = Flength (TOP); NEXT; CASE (Baref): @@ -1522,3 +1531,115 @@ 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. */ + +#define DEF_LENGTH_COMPARE(name, arith_op, loop_op, loop_ret, fin_op)\ +static Lisp_Object \ +name (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_op); \ + } \ + else \ + { \ + intptr_t n = XINT (s1); \ + intptr_t i = 0; \ + FOR_EACH_TAIL (s2) \ + { \ + ++i; \ + if (i loop_op n) \ + loop_ret \ + } \ + CHECK_LIST_END (s2, s2); \ + if (i fin_op n) \ + val = Qt; \ + } \ + \ + return val; \ +} + +DEF_LENGTH_COMPARE (length_Beqlsign, ARITH_EQUAL, >, return val;, ==) +DEF_LENGTH_COMPARE (length_Bgtr, ARITH_GRTR, >=, return val;, <) +DEF_LENGTH_COMPARE (length_Blss, ARITH_LESS, >, + { + if (! CONSP (s2)) + CHECK_LIST_END (s2, s2); + return Qt; + }, && 0 &&) +DEF_LENGTH_COMPARE (length_Bleq, ARITH_LESS_OR_EQUAL, >=, + { + if (! CONSP (s2)) + CHECK_LIST_END (s2, s2); + return Qt; + }, && 0 &&) +DEF_LENGTH_COMPARE (length_Bgeq, ARITH_GRTR_OR_EQUAL, >, return val;, <=) + +static 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; +} + +static void +length_compare (unsigned char const *PEEK, Lisp_Object *TOP, int *op) +{ + *op = *PEEK++; + Lisp_Object v1 = *TOP--; + switch (*op) + { + case Beqlsign: + *TOP = length_Beqlsign (*TOP, v1); + break; + + case Bgtr: + *TOP = length_Bgtr (*TOP, v1); + break; + + case Blss: + *TOP = length_Blss (*TOP, v1); + break; + + case Bleq: + *TOP = length_Bleq (*TOP, v1); + break; + + case Bgeq: + *TOP = length_Bgeq (*TOP, v1); + break; + + case Beq: + case Bequal: + *TOP = length_Beq (*TOP, v1); + break; + + default: + *op = *--PEEK; + ++TOP; + *TOP = Flength (*TOP); + } +} -- 2.12.0