From c27394da7e3e35ab35e0430ab331d6dadca2803d Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 9 Feb 2020 16:17:21 +0100 Subject: [PATCH] Rework frame layout Every function call by reference gets use one unique array of arguments. --- lisp/emacs-lisp/comp.el | 77 +++++++++++++++++--------- src/comp.c | 117 +++++++++++++++++++++++++--------------- 2 files changed, 126 insertions(+), 68 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2d609f0527c..701cba32906 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -274,7 +274,9 @@ structure.") (ssa-cnt-gen (funcall #'comp-gen-counter) :type function :documentation "Counter to create ssa limple vars.") (has-non-local nil :type boolean - :documentation "t if non local jumps are present.")) + :documentation "t if non local jumps are present.") + (array-h (make-hash-table) :type hash-table + :documentation "array idx -> array length.")) (defun comp-func-reset-generators (func) "Reset unique id generators for FUNC." @@ -285,6 +287,8 @@ structure.") "A meta-variable being a slot in the meta-stack." (slot nil :type (or fixnum symbol) :documentation "Slot number if a number or 'scratch' for scratch slot.") + (array-idx 0 :type fixnum + :documentation "Array index.") (id nil :type (or null number) :documentation "SSA number when in SSA form.") (const-vld nil :type boolean @@ -295,9 +299,6 @@ structure.") (type nil :documentation "When non nil indicates the type when known at compile time.") - (ref nil :type boolean - :documentation "When non nil the m-var is involved in a - call where is passed by reference.") (impure nil :type boolean :documentation "When non nil can't be copied into pure space.")) @@ -466,6 +467,8 @@ Put PREFIX in front of it." (comp-byte-frame-size (comp-func-byte-func func)))) (setf (comp-ctxt-top-level-forms comp-ctxt) (list (make-byte-to-native-function :name function-name))) + ;; Create the default array. + (puthash 0 (comp-func-frame-size func) (comp-func-array-h func)) (list func)))) (cl-defgeneric comp-spill-lap-function ((filename string)) @@ -491,7 +494,10 @@ Put PREFIX in front of it." :args (comp-decrypt-arg-list (aref data 0) name) :lap (alist-get name byte-to-native-lap) :frame-size (comp-byte-frame-size data)) - do (comp-log (format "Function %s:\n" name) 1) + do + ;; Create the default array. + (puthash 0 (comp-func-frame-size func) (comp-func-array-h func)) + (comp-log (format "Function %s:\n" name) 1) (comp-log lap 1) collect func)) @@ -1149,6 +1155,7 @@ into the C code forwarding the compilation unit." (comp-emit `(set-par-to-local ,(comp-slot-n 0) 0)) (mapc #'comp-emit-for-top-level (comp-ctxt-top-level-forms comp-ctxt)) (comp-emit `(return ,(make-comp-mvar :constant t))) + (puthash 0 (comp-func-frame-size func) (comp-func-array-h func)) (comp-limplify-finalize-function func))) (defun comp-addr-to-bb-name (addr) @@ -1564,14 +1571,38 @@ PRE-LAMBDA and POST-LAMBDA are called in pre or post-order if non nil." (copy-comp-mvar insn) insn))) -(defun comp-basic-const-propagate () - "Propagate simple constants for setimm operands. -This can run just once." +(defun comp-ref-args-to-array (args) + "Given ARGS assign them to a dedicated array." + (when (and args + ;; Never rename an already renamed array index. + (= (comp-mvar-array-idx (car args)) 0)) + (cl-loop with array-h = (comp-func-array-h comp-func) + with arr-idx = (hash-table-count array-h) + for i from 0 + for arg in args + initially + (puthash arr-idx (length args) array-h) + do + ;; Just check that all args have zeroed arr-idx. + ;; (arrays must be used once). + (cl-assert (= (comp-mvar-array-idx arg) 0)) + (setf (comp-mvar-slot arg) i) + (setf (comp-mvar-array-idx arg) arr-idx)))) + +(defun comp-propagate-once () + "Prologue for the propagate pass. +Here goes everything that can be done not iteratively (read once). +- Forward propagate immediate involed in assignments +- Backward propagate placement into arrays" (cl-loop for b being each hash-value of (comp-func-blocks comp-func) do (cl-loop for insn in (comp-block-insns b) do (pcase insn + (`(set ,_lval (,(or 'callref 'direct-callref) ,_f . ,args)) + (comp-ref-args-to-array args)) + (`(,(or 'callref 'direct-callref) ,_f . ,args) + (comp-ref-args-to-array args)) (`(setimm ,lval ,_ ,v) (setf (comp-mvar-const-vld lval) t (comp-mvar-constant lval) v @@ -1628,13 +1659,13 @@ This can run just once." (_ (comp-mvar-propagate lval rval)))) (`(phi ,lval . ,rest) - ;; Const prop here. + ;; Forward const prop here. (when-let* ((vld (cl-every #'comp-mvar-const-vld rest)) (consts (mapcar #'comp-mvar-constant rest)) (x (car consts)) (equals (cl-every (lambda (y) (equal x y)) consts))) (setf (comp-mvar-constant lval) x)) - ;; Type propagation. + ;; Forward type propagation. ;; FIXME: checking for type equality is not sufficient cause does not ;; account type hierarchy! (when-let* ((types (mapcar #'comp-mvar-type rest)) @@ -1642,10 +1673,14 @@ This can run just once." (x (car types)) (eqs (cl-every (lambda (y) (eq x y)) types))) (setf (comp-mvar-type lval) x)) - ;; Reference propagation. - (let ((operands (cons lval rest))) - (when (cl-some #'comp-mvar-ref operands) - (mapc (lambda (x) (setf (comp-mvar-ref x) t)) operands)))))) + ;; Backward propagate array index and slot. + (let ((arr-idx (comp-mvar-array-idx lval))) + (when (> arr-idx 0) + (cl-loop with slot = (comp-mvar-slot lval) + for arg in rest + do + (setf (comp-mvar-array-idx arg) arr-idx) + (setf (comp-mvar-slot arg) slot))))))) (defun comp-propagate* () "Propagate for set* and phi operands. @@ -1666,7 +1701,7 @@ Return t if something was changed." ;; FIXME remove the following condition when tested. (unless (comp-func-has-non-local f) (let ((comp-func f)) - (comp-basic-const-propagate) + (comp-propagate-once) (cl-loop for i from 1 while (comp-propagate*) @@ -1695,13 +1730,7 @@ Return t if something was changed." (cl-flet ((fill-args (args total) ;; Fill missing args to reach TOTAL (append args (cl-loop repeat (- total (length args)) - collect (make-comp-mvar :constant nil)))) - (clean-args-ref (args) - ;; Clean-up the ref slot in all args - (mapc (lambda (arg) - (setf (comp-mvar-ref arg) nil)) - args) - args)) + collect (make-comp-mvar :constant nil))))) (when (and (symbolp callee) ; Do nothing if callee is a byte compiled func. (not (memq callee comp-never-optimize-functions))) (let* ((f (symbol-function callee)) @@ -1721,7 +1750,7 @@ Return t if something was changed." (args (if (eq call-type 'callref) args (fill-args args maxarg)))) - `(,call-type ,callee ,@(clean-args-ref args)))) + `(,call-type ,callee ,@args))) ;; Intra compilation unit procedure call optimization. ;; Attention speed 3 triggers that for non self calls too!! ((or (eq callee self) @@ -1733,7 +1762,7 @@ Return t if something was changed." (args (if (eq call-type 'direct-callref) args (fill-args args (comp-args-max func-args))))) - `(,call-type ,callee ,@(clean-args-ref args)))) + `(,call-type ,callee ,@args))) ((comp-type-hint-p callee) `(call ,callee ,@args))))))) diff --git a/src/comp.c b/src/comp.c index 4b1ddeda0f4..d95a87b03b1 100644 --- a/src/comp.c +++ b/src/comp.c @@ -150,10 +150,10 @@ typedef struct { gcc_jit_field *cast_union_as_lisp_obj_ptr; gcc_jit_function *func; /* Current function being compiled. */ bool func_has_non_local; /* From comp-func has-non-local slot. */ - gcc_jit_block *block; /* Current basic block being compiled. */ - gcc_jit_lvalue **frame; /* Frame for the current function. */ gcc_jit_lvalue **f_frame; /* "Floating" frame for the current function. */ + gcc_jit_block *block; /* Current basic block being compiled. */ gcc_jit_lvalue *scratch; /* Used as scratch slot for some code sequence (switch). */ + gcc_jit_lvalue ***arrays; /* Array index -> gcc_jit_lvalue **. */ gcc_jit_rvalue *most_positive_fixnum; gcc_jit_rvalue *most_negative_fixnum; gcc_jit_rvalue *one; @@ -348,7 +348,7 @@ declare_block (Lisp_Object block_name) } static gcc_jit_lvalue * -get_slot (Lisp_Object mvar) +emit_mvar_access (Lisp_Object mvar) { Lisp_Object mvar_slot = CALL1I (comp-mvar-slot, mvar); @@ -361,15 +361,18 @@ get_slot (Lisp_Object mvar) "scratch"); return comp.scratch; } + + EMACS_INT arr_idx = XFIXNUM (CALL1I (comp-mvar-array-idx, mvar)); EMACS_INT slot_n = XFIXNUM (mvar_slot); - gcc_jit_lvalue **frame = - /* Disable floating frame for functions with non local jumps. - This is probably overkill cause we could do it just for blocks - dominated by push-handler. */ - comp.func_has_non_local - || (CALL1I (comp-mvar-ref, mvar) || SPEED < 2) - ? comp.frame : comp.f_frame; - return frame[slot_n]; + if (comp.func_has_non_local || !SPEED) + return comp.arrays[arr_idx][slot_n]; + else + { + if (arr_idx) + return comp.arrays[arr_idx][slot_n]; + else + return comp.f_frame[slot_n]; + } } static void @@ -1140,7 +1143,7 @@ emit_mvar_val (Lisp_Object mvar) return emit_const_lisp_obj (constant, CALL1I (comp-mvar-impure, mvar)); } - return gcc_jit_lvalue_as_rvalue (get_slot (mvar)); + return gcc_jit_lvalue_as_rvalue (emit_mvar_access (mvar)); } static void @@ -1150,7 +1153,7 @@ emit_frame_assignment (Lisp_Object dst_mvar, gcc_jit_rvalue *val) gcc_jit_block_add_assignment ( comp.block, NULL, - get_slot (dst_mvar), + emit_mvar_access (dst_mvar), val); } @@ -1239,10 +1242,28 @@ emit_limple_call_ref (Lisp_Object insn, bool direct) Lisp_Object callee = FIRST (insn); EMACS_INT nargs = XFIXNUM (Flength (CDR (insn))); - EMACS_INT base_ptr = 0; - if (nargs) - base_ptr = XFIXNUM (CALL1I (comp-mvar-slot, SECOND (insn))); - return emit_call_ref (callee, nargs, comp.frame[base_ptr], direct); + + if (!nargs) + return emit_call_ref (callee, + nargs, + comp.arrays[0][0], + direct); + + Lisp_Object first_arg = SECOND (insn); + Lisp_Object arr_idx = CALL1I (comp-mvar-array-idx, first_arg); + + /* Make sure all the arguments are layout-ed into the same array. */ + Lisp_Object p = XCDR (XCDR (insn)); + FOR_EACH_TAIL (p) + if (!EQ (arr_idx, CALL1I (comp-mvar-array-idx, XCAR (p)))) + xsignal2 (Qnative_ice, build_string ("incoherent array idx for insn"), + insn); + + EMACS_INT first_slot = XFIXNUM (CALL1I (comp-mvar-slot, first_arg)); + return emit_call_ref (callee, + nargs, + comp.arrays[XFIXNUM (arr_idx)][first_slot], + direct); } /* Register an handler for a non local exit. */ @@ -2867,34 +2888,43 @@ compile_function (Lisp_Object func) comp.func_has_non_local = !NILP (CALL1I (comp-func-has-non-local, func)); - gcc_jit_lvalue *frame_array = - gcc_jit_function_new_local ( - comp.func, - NULL, - gcc_jit_context_new_array_type (comp.ctxt, - NULL, - comp.lisp_obj_type, - frame_size), - "local"); - comp.frame = SAFE_ALLOCA (frame_size * sizeof (*comp.frame)); - for (EMACS_INT i = 0; i < frame_size; ++i) - comp.frame[i] = - gcc_jit_context_new_array_access ( - comp.ctxt, - NULL, - gcc_jit_lvalue_as_rvalue (frame_array), - gcc_jit_context_new_rvalue_from_int (comp.ctxt, - comp.int_type, - i)); + struct Lisp_Hash_Table *array_h = + XHASH_TABLE (CALL1I (comp-func-array-h, func)); + comp.arrays = SAFE_ALLOCA (array_h->count * sizeof (*comp.arrays)); + for (ptrdiff_t i = 0; i < array_h->count; i++) + { + EMACS_INT array_len = XFIXNUM (HASH_VALUE (array_h, i)); + comp.arrays[i] = SAFE_ALLOCA (array_len * sizeof (**comp.arrays)); + + gcc_jit_lvalue *arr = + gcc_jit_function_new_local ( + comp.func, + NULL, + gcc_jit_context_new_array_type (comp.ctxt, + NULL, + comp.lisp_obj_type, + array_len), + format_string ("arr_%td", i)); + + for (ptrdiff_t j = 0; j < array_len; j++) + comp.arrays[i][j] = + gcc_jit_context_new_array_access ( + comp.ctxt, + NULL, + gcc_jit_lvalue_as_rvalue (arr), + gcc_jit_context_new_rvalue_from_int (comp.ctxt, + comp.int_type, + j)); + } /* - The floating frame is a copy of the normal frame that can be used to store - locals if the are not going to be used in a nargs call. - This has two advantages: - - Enable gcc for better reordering (frame array is clobbered every time is - passed as parameter being involved into an nargs function call). - - Allow gcc to trigger other optimizations that are prevented by memory - referencing. + The floating frame is a copy of the normal frame that can be used to store + locals if the are not going to be used in a nargs call. + This has two advantages: + - Enable gcc for better reordering (frame array is clobbered every time is + passed as parameter being involved into an nargs function call). + - Allow gcc to trigger other optimizations that are prevented by memory + referencing. */ if (SPEED >= 2) { @@ -2952,7 +2982,6 @@ compile_function (Lisp_Object func) build_string ("failing to compile function"), CALL1I (comp-func-name, func), build_string (err)); - SAFE_FREE (); } -- 2.39.5