block to hash

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

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