From 4681f330714b1ac1114f79d6bd2ac33150e1fcc4 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 30 Jun 2020 19:10:19 +0200 Subject: [PATCH] Fix lambda-list relocation class Lambda-lists must stay in the same relocation class of the object referenced by code to respect uninterned symbols. * lisp/emacs-lisp/comp.el (comp-prepare-args-for-top-level): Break the original function in a generic specializing for dynamic/lexical functions. When allocating the lambda-list for dynamic functions do that in the default relocation class. (comp-emit-for-top-level): Make use of the new `comp-prepare-args-for-top-level'. (comp-emit-lambda-for-top-level): Likewise. --- lisp/emacs-lisp/comp.el | 37 +++++++++++++++++++++++-------------- 1 file changed, 23 insertions(+), 14 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index cde9899d26c..39b47f079e2 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1365,16 +1365,25 @@ the annotation emission." (comp-log-func func 2) func) -(defun comp-prepare-args-for-top-level (function) - "Given FUNCTION return the two args arguments for comp--register-..." - (if (comp-func-l-p function) - (let ((args (comp-func-l-args function))) - (cons (comp-args-base-min args) - (if (comp-args-p args) - (comp-args-max args) - 'many))) - (cons (func-arity (comp-func-byte-func function)) - (comp-func-d-lambda-list function)))) +(cl-defgeneric comp-prepare-args-for-top-level (function) + "Given FUNCTION return the two args arguments for comp--register-...") + +(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-l)) + "Lexical scoped FUNCTION." + (let ((args (comp-func-l-args function))) + (cons (make-comp-mvar :constant (comp-args-base-min args)) + (make-comp-mvar :constant (if (comp-args-p args) + (comp-args-max args) + 'many))))) + +(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-d)) + "Dynamic scoped FUNCTION." + (cons (make-comp-mvar :constant (func-arity (comp-func-byte-func function))) + (let ((comp-curr-allocation-class 'd-default)) + ;; Lambda-lists must stay in the same relocation class of + ;; the object referenced by code to respect uninterned + ;; symbols. + (make-comp-mvar :constant (comp-func-d-lambda-list function))))) (cl-defgeneric comp-emit-for-top-level (form for-late-load) "Emit the limple code for top level FORM.") @@ -1390,8 +1399,8 @@ the annotation emission." 'comp--late-register-subr 'comp--register-subr) (make-comp-mvar :constant name) - (make-comp-mvar :constant (car args)) - (make-comp-mvar :constant (cdr args)) + (car args) + (cdr args) (make-comp-mvar :constant c-name) (make-comp-mvar :constant @@ -1431,8 +1440,8 @@ These are stored in the reloc data array." (puthash (comp-func-byte-func func) (make-comp-mvar :constant nil) (comp-ctxt-lambda-fixups-h comp-ctxt))) - (make-comp-mvar :constant (car args)) - (make-comp-mvar :constant (cdr args)) + (car args) + (cdr args) (make-comp-mvar :constant (comp-func-c-name func)) (make-comp-mvar :constant (let* ((h (comp-ctxt-function-docs comp-ctxt)) -- 2.39.5