[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp 4681f33 1/2: Fix lambda-list relocation class
From: |
Andrea Corallo |
Subject: |
feature/native-comp 4681f33 1/2: Fix lambda-list relocation class |
Date: |
Tue, 30 Jun 2020 15:31:52 -0400 (EDT) |
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))