Prevent collisions in C namespace and function shadowing

This rework make functions being indexed by their unique C symbol name
preventing multiple lisp function with the same name colliding.

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index fe5616be668fc0295812b00e5f7dd6e841ec0959..977f137b7931b741229257d7d61eab0945844d72 100644 (file)
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -565,7 +565,7 @@ Each element is (INDEX . VALUE)")
 ;; These are use by comp.el to spill data out of here
 (cl-defstruct byte-to-native-function
   "Named or anonymous function defined a top level."
-              name data)
+              name c-name data)
 (cl-defstruct byte-to-native-top-level
   "All other top level forms."
               form)
@@ -1094,6 +1094,8 @@ message buffer `default-directory'."
 (defvar byte-compile-current-file nil)
 (defvar byte-compile-current-group nil)
 (defvar byte-compile-current-buffer nil)
+(defvar byte-compile-not-top-level nil ; We'll evolve this for naming lambdas
+  "Non nil if compiling something that is not top-level.")
 
 ;; Log something that isn't a warning.
 (defmacro byte-compile-log (format-string &rest args)
@@ -2916,6 +2918,7 @@ for symbols generated by the byte compiler itself."
             ;; args of `list'.  Actually, compile it to get warnings,
             ;; but don't use the result.
             (let* ((form (nth 1 int))
+                    (byte-compile-not-top-level t)
                     (newform (byte-compile-top-level form)))
               (while (memq (car-safe form) '(let let* progn save-excursion))
                 (while (consp (cdr form))
@@ -3116,7 +3119,8 @@ for symbols generated by the byte compiler itself."
       (let* ((byte-compile-vector (byte-compile-constants-vector))
              (out (list 'byte-code (byte-compile-lapcode byte-compile-output)
                        byte-compile-vector byte-compile-maxdepth)))
-        (when byte-native-compiling
+        (when (and byte-native-compiling
+                   (null byte-compile-not-top-level))
           ;; Spill LAP for the native compiler here
           (push (cons byte-compile-current-form byte-compile-output)
                 byte-to-native-lap))
@@ -3170,7 +3174,8 @@ for symbols generated by the byte compiler itself."
 ;; byte-compile--for-effect flag too.)
 ;;
 (defun byte-compile-form (form &optional for-effect)
-  (let ((byte-compile--for-effect for-effect))
+  (let ((byte-compile--for-effect for-effect)
+        (byte-compile-not-top-level t))
     (cond
      ((not (consp form))
       (cond ((or (not (symbolp form)) (macroexp--const-symbol-p form))
@@ -3944,7 +3949,8 @@ discarding."
 ;; and (funcall (function foo)) will lose with autoloads.
 
 (defun byte-compile-function-form (form)
-  (let ((f (nth 1 form)))
+  (let ((f (nth 1 form))
+        (byte-compile-not-top-level t))
     (when (and (symbolp f)
                (byte-compile-warning-enabled-p 'callargs f))
       (byte-compile-function-warn f t (byte-compile-fdefinition f nil)))

diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index c5c894f66073c4d28f64deb91b6c2d9d12af69e2..eca61c6bac5573ff1b010559e002aadd04372501 100644 (file)
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -208,13 +208,15 @@ Can be one of: 'd-default', 'd-impure' or 'd-ephemeral'.  See `comp-ctxt'.")
           :documentation "Target output file-name for the compilation.")
   (top-level-forms () :type list
                    :documentation "List of spilled top level forms.")
-  (funcs-h (make-hash-table) :type hash-table
-           :documentation "lisp-func-name -> comp-func.
-This is to build the prev field.")
+  (funcs-h (make-hash-table :test #'equal) :type hash-table
+           :documentation "c-name -> comp-func.")
+  (sym-to-c-name-h (make-hash-table :test #'eq) :type hash-table
+                   :documentation "symbol-function -> c-name.
+This is only for optimizing intra CU calls at speed 3.")
   (d-default (make-comp-data-container) :type comp-data-container
-          :documentation "Standard data relocated in use by functions.")
+             :documentation "Standard data relocated in use by functions.")
   (d-impure (make-comp-data-container) :type comp-data-container
-          :documentation "Relocated data that cannot be moved into pure space.
+            :documentation "Relocated data that cannot be moved into pure space.
 This is tipically for top-level forms other than defun.")
   (d-ephemeral (make-comp-data-container) :type comp-data-container
                :documentation "Relocated data not necessary after load.")
@@ -471,7 +473,14 @@ Put PREFIX in front of it."
                           "-" "_" orig-name))
          (human-readable (replace-regexp-in-string
                           (rx (not (any "0-9a-z_"))) "" human-readable)))
-    (concat prefix crypted "_" human-readable)))
+    ;; Prevent C namespace conflicts.
+    (cl-loop
+     with h = (comp-ctxt-funcs-h comp-ctxt)
+     for i from 0
+     for c-sym = (concat prefix crypted "_" human-readable "_"
+                        (number-to-string i))
+     unless (gethash c-sym h)
+       return c-sym)))
 
 (defun comp-decrypt-arg-list (x function-name)
   "Decript argument list X for FUNCTION-NAME."
@@ -492,14 +501,22 @@ Put PREFIX in front of it."
   "Given BYTE-COMPILED-FUNC return the frame size to be allocated."
   (aref byte-compiled-func 3))
 
+(defun comp-add-func-to-ctxt (func)
+  "Add FUNC to the current compiler contex."
+  (let ((name (comp-func-name func))
+        (c-name (comp-func-c-name func)))
+    (puthash name c-name (comp-ctxt-sym-to-c-name-h comp-ctxt))
+    (puthash c-name func (comp-ctxt-funcs-h comp-ctxt))))
+
 (cl-defgeneric comp-spill-lap-function (input)
   "Byte compile INPUT and spill lap for further stages.")
 
 (cl-defgeneric comp-spill-lap-function ((function-name symbol))
   "Byte compile FUNCTION-NAME spilling data from the byte compiler."
   (let* ((f (symbol-function function-name))
+         (c-name (comp-c-func-name function-name "F"))
          (func (make-comp-func :name function-name
-                               :c-name (comp-c-func-name function-name "F")
+                               :c-name c-name
                                :doc (documentation f)
                                :int-spec (interactive-form f))))
       (when (byte-code-function-p f)
@@ -519,9 +536,10 @@ 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)))
+        (setf (byte-to-native-function-c-name func) c-name)
         ;; Create the default array.
         (puthash 0 (comp-func-frame-size func) (comp-func-array-h func))
-        (list func))))
+        (comp-add-func-to-ctxt func))))
 
 (cl-defgeneric comp-spill-lap-function ((filename string))
   "Byte compile FILENAME spilling data from the byte compiler."
@@ -530,28 +548,39 @@ Put PREFIX in front of it."
     (signal 'native-compiler-error-empty-byte filename))
   (setf (comp-ctxt-top-level-forms comp-ctxt)
         (reverse byte-to-native-top-level-forms))
+  (comp-log byte-to-native-lap 3)
   (cl-loop
-   for f in (cl-loop for x in byte-to-native-top-level-forms ; All non anonymous.
+   with lap-forms = (reverse byte-to-native-lap)
+   ;; All non anonymous functions.
+   for f in (cl-loop for x in (comp-ctxt-top-level-forms comp-ctxt)
                      when (and (byte-to-native-function-p x)
                                (byte-to-native-function-name x))
                        collect x)
    for name = (byte-to-native-function-name f)
+   for c-name = (comp-c-func-name name "F")
+   for lap-entry = (assoc name lap-forms)
+   for lap = (cdr lap-entry)
    for data = (byte-to-native-function-data f)
-   for lap = (alist-get name byte-to-native-lap)
    for func = (make-comp-func :name name
                               :byte-func data
                               :doc (documentation data)
                               :int-spec (interactive-form data)
-                              :c-name (comp-c-func-name name "F")
+                              :c-name c-name
                               :args (comp-decrypt-arg-list (aref data 0) name)
-                              :lap (alist-get name byte-to-native-lap)
+                              :lap lap
                               :frame-size (comp-byte-frame-size data))
    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))
+   ;; Remove it form the original lap list to avoid multiple function
+   ;; definition with the same name shadowing each other.
+   (setf lap-forms (delete lap-entry lap-forms))
+   ;; Store the c-name to have it retrivable from
+   ;; comp-ctxt-top-level-forms.
+   (setf (byte-to-native-function-c-name f) c-name)
+   ;; Create the default array.
+   (puthash 0 (comp-func-frame-size func) (comp-func-array-h func))
+   (comp-add-func-to-ctxt func)
+   (comp-log (format "Function %s:\n" name) 1)
+   (comp-log lap 1)))
 
 (defun comp-spill-lap (input)
   "Byte compile and spill the LAP representation for INPUT.
@@ -1163,7 +1192,8 @@ the annotation emission."
 (cl-defmethod comp-emit-for-top-level ((form byte-to-native-function)
                                        for-late-load)
   (let* ((name (byte-to-native-function-name form))
-         (f (gethash name (comp-ctxt-funcs-h comp-ctxt)))
+         (c-name (byte-to-native-function-c-name form))
+         (f (gethash c-name (comp-ctxt-funcs-h comp-ctxt)))
          (args (comp-func-args f)))
     (cl-assert (and name f))
     (comp-emit (comp-call (if for-late-load
@@ -1174,7 +1204,7 @@ the annotation emission."
                           (make-comp-mvar :constant (if (comp-args-p args)
                                                         (comp-args-max args)
                                                       'many))
-                          (make-comp-mvar :constant (comp-func-c-name f))
+                          (make-comp-mvar :constant c-name)
                           (make-comp-mvar :constant (comp-func-doc f))
                           (make-comp-mvar :constant
                                           (comp-func-int-spec f))
@@ -1301,16 +1331,10 @@ into the C code forwarding the compilation unit."
                   (puthash addr t addr-h))
     (comp-limplify-finalize-function func)))
 
-(defun comp-add-func-to-ctxt (func)
-  "Add FUNC to the current compiler contex."
-  (puthash (comp-func-name func)
-           func
-           (comp-ctxt-funcs-h comp-ctxt)))
-
-(defun comp-limplify (lap-funcs)
-  "Compute the LIMPLE ir for LAP-FUNCS.
-Top-level forms for the current context are rendered too."
-  (mapc #'comp-add-func-to-ctxt (mapcar #'comp-limplify-function lap-funcs))
+(defun comp-limplify (_)
+  "Compute LIMPLE IR for forms in `comp-ctxt'."
+  (maphash (lambda (_ f) (comp-limplify-function f))
+           (comp-ctxt-funcs-h comp-ctxt))
   (comp-add-func-to-ctxt (comp-limplify-top-level nil))
   (when (comp-ctxt-with-late-load comp-ctxt)
     (comp-add-func-to-ctxt (comp-limplify-top-level t))))
@@ -1843,7 +1867,8 @@ Backward propagate array placement properties."
                (not (memq callee comp-never-optimize-functions)))
       (let* ((f (symbol-function callee))
              (subrp (subrp f))
-             (callee-in-unit (gethash callee
+             (callee-in-unit (gethash (gethash callee
+                                               (comp-ctxt-sym-to-c-name-h comp-ctxt))
                                       (comp-ctxt-funcs-h comp-ctxt))))
         (cond
          ((and subrp (not (subr-native-elisp-p f)))

diff --git a/src/comp.c b/src/comp.c
index 563f625073065917b18e9cf32b861cfebe164776..2aa0c4722176f5cd536f63ed519c3639ab01fc16 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -174,7 +174,7 @@ typedef struct {
   gcc_jit_function *check_type;
   gcc_jit_function *check_impure;
   Lisp_Object func_blocks_h; /* blk_name -> gcc_block.  */
-  Lisp_Object exported_funcs_h; /* subr_name -> gcc_jit_function *.  */
+  Lisp_Object exported_funcs_h; /* c-func-name -> gcc_jit_function *.  */
   Lisp_Object imported_funcs_h; /* subr_name -> gcc_jit_field *reloc_field.  */
   Lisp_Object emitter_dispatcher;
   /* Synthesized struct holding data relocs.  */
@@ -518,9 +518,18 @@ static gcc_jit_rvalue *
 emit_call (Lisp_Object subr_sym, gcc_jit_type *ret_type, ptrdiff_t nargs,
           gcc_jit_rvalue **args, bool direct)
 {
-  Lisp_Object func =
-    Fgethash (subr_sym, direct ? comp.exported_funcs_h: comp.imported_funcs_h,
-             Qnil);
+  Lisp_Object func;
+  if (direct)
+    {
+      Lisp_Object c_name =
+       Fgethash (subr_sym,
+                 CALL1I (comp-ctxt-sym-to-c-name-h, Vcomp_ctxt),
+                 Qnil);
+      func = Fgethash (c_name, comp.exported_funcs_h, Qnil);
+    }
+  else
+    func = Fgethash (subr_sym, comp.imported_funcs_h, Qnil);
+
   if (NILP (func))
       xsignal2 (Qnative_ice,
                build_string ("missing function declaration"),
@@ -2926,7 +2935,7 @@ declare_function (Lisp_Object func)
                                      c_name, 2, param, 0);
     }
 
-  Fputhash (CALL1I (comp-func-name, func),
+  Fputhash (CALL1I (comp-func-c-name, func),
            make_mint_ptr (gcc_func),
            comp.exported_funcs_h);
 
@@ -2939,7 +2948,7 @@ compile_function (Lisp_Object func)
   USE_SAFE_ALLOCA;
   EMACS_INT frame_size = XFIXNUM (CALL1I (comp-func-frame-size, func));
 
-  comp.func = xmint_pointer (Fgethash (CALL1I (comp-func-name, func),
+  comp.func = xmint_pointer (Fgethash (CALL1I (comp-func-c-name, func),
                                       comp.exported_funcs_h, Qnil));
 
   comp.func_has_non_local = !NILP (CALL1I (comp-func-has-non-local, func));
@@ -3179,7 +3188,7 @@ DEFUN ("comp--init-ctxt", Fcomp__init_ctxt, Scomp__init_ctxt,
                                                    sizeof (void *),
                                                    false);
 
-  comp.exported_funcs_h = CALLN (Fmake_hash_table);
+  comp.exported_funcs_h = CALLN (Fmake_hash_table, QCtest, Qequal);
   /*
     Always reinitialize this cause old function definitions are garbage
     collected by libgccjit when the ctxt is released.