mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-13 09:32:47 +00:00
Code Issues Releases Activity

Rework frame layout

Browse Source 
Every function call by reference gets use one unique array of
arguments.
This commit is contained in:
Andrea Corallo 2020-02-09 16:17:21 +01:00
parent 0c6f4caeb3
commit c27394da7e
2 changed files with 126 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
lisp/emacs-lisp/comp.el
View File

@ -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)))))))

117
src/comp.c
View File

@ -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 ();
}