masscollaborationlabs/emacs
2
0
Fork 0
mirror of https://github.com/masscollaborationlabs/emacs.git synced 2025-07-19 02:10:10 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Prevent collisions in C namespace and function shadowing

Browse source 
This rework make functions being indexed by their unique C symbol name
preventing multiple lisp function with the same name colliding.
This commit is contained in:
Andrea Corallo 2020-03-28 20:56:47 +00:00
parent 9d8ce520f0
commit d5f6dc131b
3 changed files with 81 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

14
lisp/emacs-lisp/bytecomp.el
View file

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

75
lisp/emacs-lisp/comp.el
View file

@ -208,9 +208,11 @@ 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.")
(d-impure (make-comp-data-container) :type comp-data-container
@ -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
;; 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)
collect func))
(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)))

21
src/comp.c
View file

@ -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,
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.