feature/native-comp 4681f33 1/2: Fix lambda-list relocation class

[Andrea Corallo]

branch: feature/native-comp
commit 4681f330714b1ac1114f79d6bd2ac33150e1fcc4
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>

    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 cde9899..39b47f0 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))