From 988a5133dc86e28e4b097d2c8d64d25e37bb6c5d Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Sun, 14 Jul 2019 17:21:34 +0200 Subject: [PATCH] block to hash --- lisp/emacs-lisp/comp.el | 39 +++++++++++++++++++++++++-------------- src/comp.c | 17 ++++++++++++++--- 2 files changed, 39 insertions(+), 17 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index e2c8fe427e3..6f4b94d308b 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -74,6 +74,13 @@ To be used when ncall-conv is nil.") :documentation "If t the signature is: (ptrdiff_t nargs, Lisp_Object *args)")) +(cl-defstruct (comp-block (:copier nil)) + "A basic block." + (sp nil + :documentation "When non nil indicates its the sp value") + (closed nil :type 'boolean + :documentation "If the block was already closed")) + (cl-defstruct (comp-func (:copier nil)) "Internal rapresentation for a function." (symbol-name nil @@ -88,8 +95,9 @@ To be used when ncall-conv is nil.") :documentation "Current intermediate rappresentation") (args nil :type 'comp-args) (frame-size nil :type 'number) - (blocks () :type list - :documentation "List of basic block") + (blocks (make-hash-table) :type 'hash-table + :documentation "Key is the basic block symbol value is a comp-block +structure") (lap-block (make-hash-table :test #'equal) :type 'hash-table :documentation "Key value to convert from LAP label number to LIMPLE basic block") @@ -258,26 +266,31 @@ If the calle function is known to have a return type propagate it." :constant val)) (comp-emit (list 'setimm (comp-slot) val))) -(defun comp-emit-block (bblock) - "Emit basic block BBLOCK." - (cl-pushnew bblock (comp-func-blocks comp-func) :test #'eq) +(defun comp-emit-block (block-name) + "Emit basic block BLOCK-NAME." + (unless (gethash block-name (comp-func-blocks comp-func)) + (puthash block-name + (make-comp-block :sp (comp-sp)) + (comp-func-blocks comp-func))) ;; Every new block we are forced to wipe out all the frame. ;; This will be optimized by proper flow analysis. (setf (comp-limple-frame-frame comp-frame) (comp-limple-frame-new-frame (comp-func-frame-size comp-func))) ;; If we are landing here form a recorded branch adjust sp accordingly. - (if-let ((new-sp (gethash bblock (comp-limple-frame-block-sp comp-frame)))) - (setf (comp-sp) new-sp)) - (comp-emit `(block ,bblock))) + (setf (comp-sp) + (comp-block-sp (gethash block-name (comp-func-blocks comp-func)))) + (comp-emit `(block ,block-name))) (defmacro comp-with-fall-through-block (bb &rest body) "Create a basic block BB that is used to fall through after executing BODY." (declare (debug (form body)) (indent defun)) `(let ((,bb (comp-new-block-sym))) - (push ,bb (comp-func-blocks comp-func)) - (progn ,@body) - (comp-emit-block ,bb))) + (puthash ,bb + (make-comp-block :sp (comp-sp)) + (comp-func-blocks comp-func)) + (progn ,@body) + (comp-emit-block ,bb))) (defun comp-stack-adjust (n) "Move sp by N." @@ -298,7 +311,7 @@ If the calle function is known to have a return type propagate it." (defun comp-new-block-sym () "Return a symbol naming the next new basic block." - (intern (format "bb_%s" (length (comp-func-blocks comp-func))))) + (intern (format "bb_%s" (hash-table-count (comp-func-blocks comp-func))))) (defun comp-lap-to-limple-bb (n) "Given the LAP label N return the limple basic block." @@ -562,8 +575,6 @@ If the calle function is known to have a return type propagate it." (comp-emit-block 'body) (mapc #'comp-limplify-lap-inst (comp-func-ir func)) (setf (comp-func-ir func) (reverse comp-limple)) - ;; Prologue block must be first - (setf (comp-func-blocks func) (reverse (comp-func-blocks func))) (when comp-debug (cl-prettyprint (comp-func-ir func))) func)) diff --git a/src/comp.c b/src/comp.c index e407c079b63..c97fe404cad 100644 --- a/src/comp.c +++ b/src/comp.c @@ -212,7 +212,7 @@ retrive_block (Lisp_Object symbol) } static void -declare_block (char *block_name) +declare_block (const char * block_name) { gcc_jit_block *block = gcc_jit_function_new_block (comp.func, block_name); Lisp_Object key = make_string (block_name, strlen (block_name)); @@ -1977,7 +1977,7 @@ DEFUN ("comp-add-func-to-ctxt", Fcomp_add_func_to_ctxt, Scomp_add_func_to_ctxt, Lisp_Object args = FUNCALL1 (comp-func-args, func); EMACS_INT frame_size = XFIXNUM (FUNCALL1 (comp-func-frame-size, func)); EMACS_INT min_args = XFIXNUM (FUNCALL1 (comp-args-min, args)); - EMACS_INT max_args = XFIXNUM (FUNCALL1 (comp-args-max, args)); + /* EMACS_INT max_args = XFIXNUM (FUNCALL1 (comp-args-max, args)); */ bool ncall = !NILP (FUNCALL1 (comp-args-ncall-conv, args)); if (!ncall) @@ -2015,8 +2015,19 @@ DEFUN ("comp-add-func-to-ctxt", Fcomp_add_func_to_ctxt, Scomp_add_func_to_ctxt, comp.func_blocks = CALLN (Fmake_hash_table, QCtest, Qequal, QCweakness, Qt); - /* Pre declare all basic blocks. */ + /* Pre declare all basic blocks to gcc. + The "entry" block must be declared as first. */ + declare_block ("entry"); Lisp_Object blocks = FUNCALL1 (comp-func-blocks, func); + Lisp_Object entry_block = Fgethash (intern ("entry"), blocks, Qnil); + struct Lisp_Hash_Table *ht = XHASH_TABLE (blocks); + for (ptrdiff_t i = 0; i < ht->count; i++) + { + Lisp_Object block = HASH_VALUE (ht, i); + if (!EQ (block, entry_block)) + declare_block ((char *) SDATA (SYMBOL_NAME (HASH_KEY (ht, i)))); + } + while (CONSP (blocks)) { char *block_name = (char *) SDATA (SYMBOL_NAME (XCAR (blocks))); -- 2.39.5