From: Andrea Corallo Date: Sat, 28 Mar 2020 20:56:47 +0000 (+0000) Subject: Prevent collisions in C namespace and function shadowing X-Git-Tag: emacs-28.0.90~2727^2~740 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=d5f6dc131b63d6bde096c03927c05a490c707c41;p=emacs.git 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 fe5616be668..977f137b793 100644 --- 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 c5c894f6607..eca61c6bac5 100644 --- 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 563f6250730..2aa0c472217 100644 --- 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.