mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-06 14:30:50 -08:00
Merge branch 'scratch/no-purespace' into 'master'
This commit is contained in:
Stefan Kangas
commit
bf97946d7d
181 changed files with 2108 additions and 9370 deletions
|
|
@ -1861,7 +1861,7 @@ See Info node `(elisp) Integer Basics'."
|
|||
(side-effect-and-error-free-fns
|
||||
'(
|
||||
;; alloc.c
|
||||
bool-vector cons list make-marker purecopy record vector
|
||||
bool-vector cons list make-marker record vector
|
||||
;; buffer.c
|
||||
buffer-list buffer-live-p current-buffer overlay-lists overlayp
|
||||
;; casetab.c
|
||||
|
|
|
|||
|
|
@ -543,7 +543,7 @@ was first made obsolete, for example a date or a release number."
|
|||
(put obsolete-name 'byte-obsolete-info
|
||||
;; The second entry used to hold the `byte-compile' handler, but
|
||||
;; is not used any more nowadays.
|
||||
(purecopy (list current-name nil when)))
|
||||
(list current-name nil when))
|
||||
obsolete-name)
|
||||
|
||||
(defmacro define-obsolete-function-alias ( obsolete-name current-name when
|
||||
|
|
@ -579,7 +579,7 @@ ACCESS-TYPE if non-nil should specify the kind of access that will trigger
|
|||
obsolescence warnings; it can be either `get' or `set'."
|
||||
(byte-run--constant-obsolete-warning obsolete-name)
|
||||
(put obsolete-name 'byte-obsolete-variable
|
||||
(purecopy (list current-name access-type when)))
|
||||
(list current-name access-type when))
|
||||
obsolete-name)
|
||||
|
||||
(defmacro define-obsolete-variable-alias ( obsolete-name current-name when
|
||||
|
|
@ -634,7 +634,7 @@ obsolete, for example a date or a release number."
|
|||
`(progn
|
||||
(put ,obsolete-face 'face-alias ,current-face)
|
||||
;; Used by M-x describe-face.
|
||||
(put ,obsolete-face 'obsolete-face (or (purecopy ,when) t))))
|
||||
(put ,obsolete-face 'obsolete-face (or ,when t))))
|
||||
|
||||
(defmacro dont-compile (&rest body)
|
||||
"Like `progn', but the body always runs interpreted (not compiled).
|
||||
|
|
|
|||
|
|
@ -4640,13 +4640,12 @@ Return (TAIL VAR TEST CASES), where:
|
|||
cases))))
|
||||
(setq jump-table (make-hash-table
|
||||
:test test
|
||||
:purecopy t
|
||||
:size nvalues)))
|
||||
(setq default-tag (byte-compile-make-tag))
|
||||
;; The structure of byte-switch code:
|
||||
;;
|
||||
;; varref var
|
||||
;; constant #s(hash-table purecopy t data (val1 (TAG1) val2 (TAG2)))
|
||||
;; constant #s(hash-table data (val1 (TAG1) val2 (TAG2)))
|
||||
;; switch
|
||||
;; goto DEFAULT-TAG
|
||||
;; TAG1
|
||||
|
|
|
|||
|
|
@ -722,7 +722,7 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
|
|||
|
||||
(define-button-type 'cl-type-definition
|
||||
:supertype 'help-function-def
|
||||
'help-echo (purecopy "mouse-2, RET: find type definition"))
|
||||
'help-echo "mouse-2, RET: find type definition")
|
||||
|
||||
(declare-function help-fns-short-filename "help-fns" (filename))
|
||||
|
||||
|
|
|
|||
|
|
@ -654,11 +654,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
|
|||
(symbol-function sym)))
|
||||
;; Prevent `defalias' from recording this as the definition site of
|
||||
;; the generic function.
|
||||
current-load-list
|
||||
;; BEWARE! Don't purify this function definition, since that leads
|
||||
;; to memory corruption if the hash-tables it holds are modified
|
||||
;; (the GC doesn't trace those pointers).
|
||||
(purify-flag nil))
|
||||
current-load-list)
|
||||
(when (listp old-adv-cc)
|
||||
(set-advertised-calling-convention gfun old-adv-cc nil))
|
||||
;; But do use `defalias', so that it interacts properly with nadvice,
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@
|
|||
|
||||
;; The `assert' macro from the cl package signals
|
||||
;; `cl-assertion-failed' at runtime so always define it.
|
||||
(define-error 'cl-assertion-failed (purecopy "Assertion failed"))
|
||||
(define-error 'cl-assertion-failed "Assertion failed")
|
||||
|
||||
(defun cl--assertion-failed (form &optional string sargs args)
|
||||
(if debug-on-error
|
||||
|
|
@ -183,20 +183,7 @@
|
|||
(add-to-list 'current-load-list `(define-type . ,name))
|
||||
(cl--struct-register-child parent-class tag)
|
||||
(unless (or (eq named t) (eq tag name))
|
||||
;; We used to use `defconst' instead of `set' but that
|
||||
;; has a side-effect of purecopying during the dump, so that the
|
||||
;; class object stored in the tag ends up being a *copy* of the
|
||||
;; one stored in the `cl--class' property! We could have fixed
|
||||
;; this needless duplication by using the purecopied object, but
|
||||
;; that then breaks down a bit later when we modify the
|
||||
;; cl-structure-class class object to close the recursion
|
||||
;; between cl-structure-object and cl-structure-class (because
|
||||
;; modifying purecopied objects is not allowed. Since this is
|
||||
;; done during dumping, we could relax this rule and allow the
|
||||
;; modification, but it's cumbersome).
|
||||
;; So in the end, it's easier to just avoid the duplication by
|
||||
;; avoiding the use of the purespace here.
|
||||
(set tag class)
|
||||
(eval `(defconst ,tag ',class) t)
|
||||
;; In the cl-generic support, we need to be able to check
|
||||
;; if a vector is a cl-struct object, without knowing its particular type.
|
||||
;; So we use the (otherwise) unused function slots of the tag symbol
|
||||
|
|
|
|||
|
|
@ -160,7 +160,7 @@ Print the contents hidden by the ellipsis to STREAM."
|
|||
'follow-link t
|
||||
'action (lambda (button)
|
||||
(disassemble (button-get button 'byte-code-function)))
|
||||
'help-echo (purecopy "mouse-2, RET: disassemble this function"))
|
||||
'help-echo "mouse-2, RET: disassemble this function")
|
||||
|
||||
(defvar cl-print-compiled nil
|
||||
"Control how to print byte-compiled functions.
|
||||
|
|
|
|||
|
|
@ -155,7 +155,7 @@ native compilation runs.")
|
|||
|
||||
(defvar comp-curr-allocation-class 'd-default
|
||||
"Current allocation class.
|
||||
Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.")
|
||||
Can be one of: `d-default' or `d-ephemeral'. See `comp-ctxt'.")
|
||||
|
||||
(defconst comp-passes '(comp--spill-lap
|
||||
comp--limplify
|
||||
|
|
@ -395,9 +395,6 @@ Needed to replace immediate byte-compiled lambdas with the compiled reference.")
|
|||
:documentation "Documentation index -> documentation")
|
||||
(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
|
||||
:documentation "Relocated data that cannot be moved into pure space.
|
||||
This is typically for top-level forms other than defun.")
|
||||
(d-ephemeral (make-comp-data-container) :type comp-data-container
|
||||
:documentation "Relocated data not necessary after load.")
|
||||
(with-late-load nil :type boolean
|
||||
|
|
@ -1190,7 +1187,7 @@ Return value is the fall-through block name."
|
|||
(defun comp--jump-table-optimizable (jmp-table)
|
||||
"Return t if JMP-TABLE can be optimized out."
|
||||
;; Identify LAP sequences like:
|
||||
;; (byte-constant #s(hash-table test eq purecopy t data (created 126 deleted 126 changed 126)) . 24)
|
||||
;; (byte-constant #s(hash-table test eq data (created 126 deleted 126 changed 126)) . 24)
|
||||
;; (byte-switch)
|
||||
;; (TAG 126 . 10)
|
||||
(let ((targets (hash-table-values jmp-table)))
|
||||
|
|
@ -1615,7 +1612,7 @@ and the annotation emission."
|
|||
(unless for-late-load
|
||||
(comp--emit
|
||||
(comp--call 'eval
|
||||
(let ((comp-curr-allocation-class 'd-impure))
|
||||
(let ((comp-curr-allocation-class 'd-default))
|
||||
(make--comp-mvar :constant
|
||||
(byte-to-native-top-level-form form)))
|
||||
(make--comp-mvar :constant
|
||||
|
|
@ -1625,7 +1622,7 @@ and the annotation emission."
|
|||
"Emit the creation of subrs for lambda FUNC.
|
||||
These are stored in the reloc data array."
|
||||
(let ((args (comp--prepare-args-for-top-level func)))
|
||||
(let ((comp-curr-allocation-class 'd-impure))
|
||||
(let ((comp-curr-allocation-class 'd-default))
|
||||
(comp--add-const-to-relocs (comp-func-byte-func func)))
|
||||
(comp--emit
|
||||
(comp--call 'comp--register-lambda
|
||||
|
|
@ -3257,7 +3254,10 @@ Set it into the `type' slot."
|
|||
;; from the corresponding m-var.
|
||||
collect (if (gethash obj
|
||||
(comp-ctxt-byte-func-to-func-h comp-ctxt))
|
||||
'lambda-fixup
|
||||
;; Hack not to have `--lambda-fixup' in
|
||||
;; data relocations as it would trigger the
|
||||
;; check in 'check_comp_unit_relocs'.
|
||||
(intern (concat (make-string 1 ?-) "-lambda-fixup"))
|
||||
obj))))
|
||||
|
||||
(defun comp--finalize-relocs ()
|
||||
|
|
@ -3271,28 +3271,15 @@ Update all insn accordingly."
|
|||
|
||||
(let* ((d-default (comp-ctxt-d-default comp-ctxt))
|
||||
(d-default-idx (comp-data-container-idx d-default))
|
||||
(d-impure (comp-ctxt-d-impure comp-ctxt))
|
||||
(d-impure-idx (comp-data-container-idx d-impure))
|
||||
(d-ephemeral (comp-ctxt-d-ephemeral comp-ctxt))
|
||||
(d-ephemeral-idx (comp-data-container-idx d-ephemeral)))
|
||||
;; We never want compiled lambdas ending up in pure space. A copy must
|
||||
;; be already present in impure (see `comp--emit-lambda-for-top-level').
|
||||
(cl-loop for obj being each hash-keys of d-default-idx
|
||||
when (gethash obj (comp-ctxt-lambda-fixups-h comp-ctxt))
|
||||
do (cl-assert (gethash obj d-impure-idx))
|
||||
(remhash obj d-default-idx))
|
||||
;; Remove entries in d-impure already present in d-default.
|
||||
(cl-loop for obj being each hash-keys of d-impure-idx
|
||||
when (gethash obj d-default-idx)
|
||||
do (remhash obj d-impure-idx))
|
||||
;; Remove entries in d-ephemeral already present in d-default or
|
||||
;; d-impure.
|
||||
;; Remove entries in d-ephemeral already present in d-default
|
||||
(cl-loop for obj being each hash-keys of d-ephemeral-idx
|
||||
when (or (gethash obj d-default-idx) (gethash obj d-impure-idx))
|
||||
when (gethash obj d-default-idx)
|
||||
do (remhash obj d-ephemeral-idx))
|
||||
;; Fix-up indexes in each relocation class and fill corresponding
|
||||
;; reloc lists.
|
||||
(mapc #'comp--finalize-container (list d-default d-impure d-ephemeral))
|
||||
(mapc #'comp--finalize-container (list d-default d-ephemeral))
|
||||
;; Make a vector from the function documentation hash table.
|
||||
(cl-loop with h = (comp-ctxt-function-docs comp-ctxt)
|
||||
with v = (make-vector (hash-table-count h) nil)
|
||||
|
|
@ -3302,13 +3289,13 @@ Update all insn accordingly."
|
|||
finally
|
||||
do (setf (comp-ctxt-function-docs comp-ctxt) v))
|
||||
;; And now we conclude with the following: We need to pass to
|
||||
;; `comp--register-lambda' the index in the impure relocation
|
||||
;; array to store revived lambdas, but given we know it only now
|
||||
;; we fix it up as last.
|
||||
;; `comp--register-lambda' the index in the relocation array to
|
||||
;; store revived lambdas, but given we know it only now we fix it up
|
||||
;; as last.
|
||||
(cl-loop for f being each hash-keys of (comp-ctxt-lambda-fixups-h comp-ctxt)
|
||||
using (hash-value mvar)
|
||||
with reverse-h = (make-hash-table) ;; Make sure idx is unique.
|
||||
for idx = (gethash f d-impure-idx)
|
||||
for idx = (gethash f d-default-idx)
|
||||
do
|
||||
(cl-assert (null (gethash idx reverse-h)))
|
||||
(cl-assert (fixnump idx))
|
||||
|
|
|
|||
|
|
@ -220,7 +220,7 @@ No problems result if this variable is not bound.
|
|||
(with-no-warnings (defvar ,map (make-sparse-keymap)))
|
||||
(unless (get ',map 'variable-documentation)
|
||||
(put ',map 'variable-documentation
|
||||
(purecopy ,(format "Keymap for `%s'." child))))
|
||||
,(format "Keymap for `%s'." child)))
|
||||
,(if declare-syntax
|
||||
`(progn
|
||||
(defvar ,syntax)
|
||||
|
|
@ -229,7 +229,7 @@ No problems result if this variable is not bound.
|
|||
(defvar ,syntax (make-syntax-table)))
|
||||
(unless (get ',syntax 'variable-documentation)
|
||||
(put ',syntax 'variable-documentation
|
||||
(purecopy ,(format "Syntax table for `%s'." child))))))
|
||||
,(format "Syntax table for `%s'." child)))))
|
||||
,(if declare-abbrev
|
||||
`(progn
|
||||
(defvar ,abbrev)
|
||||
|
|
@ -239,7 +239,7 @@ No problems result if this variable is not bound.
|
|||
(progn (define-abbrev-table ',abbrev nil) ,abbrev)))
|
||||
(unless (get ',abbrev 'variable-documentation)
|
||||
(put ',abbrev 'variable-documentation
|
||||
(purecopy ,(format "Abbrev table for `%s'." child))))))
|
||||
,(format "Abbrev table for `%s'." child)))))
|
||||
(if (fboundp 'derived-mode-set-parent) ;; Emacs≥30.1
|
||||
(derived-mode-set-parent ',child ',parent)
|
||||
(put ',child 'derived-mode-parent ',parent))
|
||||
|
|
|
|||
|
|
@ -269,7 +269,7 @@ INIT-VALUE LIGHTER KEYMAP.
|
|||
(setq body (cdr body))
|
||||
(pcase keyw
|
||||
(:init-value (setq init-value (pop body)))
|
||||
(:lighter (setq lighter (purecopy (pop body))))
|
||||
(:lighter (setq lighter (pop body)))
|
||||
(:global (setq globalp (pop body))
|
||||
(when (and globalp (symbolp mode))
|
||||
(setq setter `(setq-default ,mode))
|
||||
|
|
|
|||
|
|
@ -78,7 +78,7 @@ If nil, truncated messages will just have \"...\" to indicate truncation."
|
|||
:version "28.1")
|
||||
|
||||
;;;###autoload
|
||||
(defcustom eldoc-minor-mode-string (purecopy " ElDoc")
|
||||
(defcustom eldoc-minor-mode-string " ElDoc"
|
||||
"String to display in mode line when ElDoc Mode is enabled; nil for none."
|
||||
:type '(choice string (const :tag "None" nil)))
|
||||
|
||||
|
|
@ -154,7 +154,6 @@ this file since the obarray is initialized at load time.
|
|||
Remember to keep it a prime number to improve hash performance.")
|
||||
|
||||
(defvar eldoc-message-commands
|
||||
;; Don't define as `defconst' since it would then go to (read-only) purespace.
|
||||
(obarray-make eldoc-message-commands-table-size)
|
||||
"Commands after which it is appropriate to print in the echo area.
|
||||
ElDoc does not try to print function arglists, etc., after just any command,
|
||||
|
|
@ -166,7 +165,6 @@ directly. Instead, use `eldoc-add-command' and `eldoc-remove-command'.")
|
|||
|
||||
;; Not a constant.
|
||||
(defvar eldoc-last-data (make-vector 3 nil)
|
||||
;; Don't define as `defconst' since it would then go to (read-only) purespace.
|
||||
"Bookkeeping; elements are as follows:
|
||||
0 - contains the last symbol read from the buffer.
|
||||
1 - contains the string last displayed in the echo area for variables,
|
||||
|
|
|
|||
|
|
@ -182,7 +182,7 @@ If CURRENT-NAME is a string, that is the `use instead' message.
|
|||
WHEN should be a string indicating when the variable was first
|
||||
made obsolete, for example a date or a release number."
|
||||
(put obsolete-name 'byte-obsolete-generalized-variable
|
||||
(purecopy (list current-name when)))
|
||||
(list current-name when))
|
||||
obsolete-name)
|
||||
|
||||
;; Additions for `declare'. We specify the values as named aliases so
|
||||
|
|
|
|||
|
|
@ -94,68 +94,68 @@
|
|||
(defvar lisp-imenu-generic-expression
|
||||
(list
|
||||
(list nil
|
||||
(purecopy (concat "^\\s-*("
|
||||
(regexp-opt
|
||||
'("defun" "defmacro"
|
||||
;; Elisp.
|
||||
"defun*" "defsubst" "define-inline"
|
||||
"define-advice" "defadvice" "define-skeleton"
|
||||
"define-compilation-mode" "define-minor-mode"
|
||||
"define-global-minor-mode"
|
||||
"define-globalized-minor-mode"
|
||||
"define-derived-mode" "define-generic-mode"
|
||||
"ert-deftest"
|
||||
"cl-defun" "cl-defsubst" "cl-defmacro"
|
||||
"cl-define-compiler-macro" "cl-defgeneric"
|
||||
"cl-defmethod"
|
||||
;; CL.
|
||||
"define-compiler-macro" "define-modify-macro"
|
||||
"defsetf" "define-setf-expander"
|
||||
"define-method-combination"
|
||||
;; CLOS and EIEIO
|
||||
"defgeneric" "defmethod")
|
||||
t)
|
||||
"\\s-+\\(" (rx lisp-mode-symbol) "\\)"))
|
||||
(concat "^\\s-*("
|
||||
(regexp-opt
|
||||
'("defun" "defmacro"
|
||||
;; Elisp.
|
||||
"defun*" "defsubst" "define-inline"
|
||||
"define-advice" "defadvice" "define-skeleton"
|
||||
"define-compilation-mode" "define-minor-mode"
|
||||
"define-global-minor-mode"
|
||||
"define-globalized-minor-mode"
|
||||
"define-derived-mode" "define-generic-mode"
|
||||
"ert-deftest"
|
||||
"cl-defun" "cl-defsubst" "cl-defmacro"
|
||||
"cl-define-compiler-macro" "cl-defgeneric"
|
||||
"cl-defmethod"
|
||||
;; CL.
|
||||
"define-compiler-macro" "define-modify-macro"
|
||||
"defsetf" "define-setf-expander"
|
||||
"define-method-combination"
|
||||
;; CLOS and EIEIO
|
||||
"defgeneric" "defmethod")
|
||||
t)
|
||||
"\\s-+\\(" (rx lisp-mode-symbol) "\\)")
|
||||
2)
|
||||
;; Like the previous, but uses a quoted symbol as the name.
|
||||
(list nil
|
||||
(purecopy (concat "^\\s-*("
|
||||
(regexp-opt
|
||||
'("defalias" "define-obsolete-function-alias")
|
||||
t)
|
||||
"\\s-+'\\(" (rx lisp-mode-symbol) "\\)"))
|
||||
(concat "^\\s-*("
|
||||
(regexp-opt
|
||||
'("defalias" "define-obsolete-function-alias")
|
||||
t)
|
||||
"\\s-+'\\(" (rx lisp-mode-symbol) "\\)")
|
||||
2)
|
||||
(list (purecopy "Variables")
|
||||
(purecopy (concat "^\\s-*("
|
||||
(regexp-opt
|
||||
'(;; Elisp
|
||||
"defconst" "defcustom" "defvar-keymap"
|
||||
;; CL
|
||||
"defconstant"
|
||||
"defparameter" "define-symbol-macro")
|
||||
t)
|
||||
"\\s-+\\(" (rx lisp-mode-symbol) "\\)"))
|
||||
(list "Variables"
|
||||
(concat "^\\s-*("
|
||||
(regexp-opt
|
||||
'(;; Elisp
|
||||
"defconst" "defcustom" "defvar-keymap"
|
||||
;; CL
|
||||
"defconstant"
|
||||
"defparameter" "define-symbol-macro")
|
||||
t)
|
||||
"\\s-+\\(" (rx lisp-mode-symbol) "\\)")
|
||||
2)
|
||||
;; For `defvar'/`defvar-local', we ignore (defvar FOO) constructs.
|
||||
(list (purecopy "Variables")
|
||||
(purecopy (concat "^\\s-*(defvar\\(?:-local\\)?\\s-+\\("
|
||||
(rx lisp-mode-symbol) "\\)"
|
||||
"[[:space:]\n]+[^)]"))
|
||||
(list "Variables"
|
||||
(concat "^\\s-*(defvar\\(?:-local\\)?\\s-+\\("
|
||||
(rx lisp-mode-symbol) "\\)"
|
||||
"[[:space:]\n]+[^)]")
|
||||
1)
|
||||
(list (purecopy "Types")
|
||||
(purecopy (concat "^\\s-*("
|
||||
(regexp-opt
|
||||
'(;; Elisp
|
||||
"defgroup" "deftheme"
|
||||
"define-widget" "define-error"
|
||||
"defface" "cl-deftype" "cl-defstruct"
|
||||
;; CL
|
||||
"deftype" "defstruct"
|
||||
"define-condition" "defpackage"
|
||||
;; CLOS and EIEIO
|
||||
"defclass")
|
||||
t)
|
||||
"\\s-+'?\\(" (rx lisp-mode-symbol) "\\)"))
|
||||
(list "Types"
|
||||
(concat "^\\s-*("
|
||||
(regexp-opt
|
||||
'(;; Elisp
|
||||
"defgroup" "deftheme"
|
||||
"define-widget" "define-error"
|
||||
"defface" "cl-deftype" "cl-defstruct"
|
||||
;; CL
|
||||
"deftype" "defstruct"
|
||||
"define-condition" "defpackage"
|
||||
;; CLOS and EIEIO
|
||||
"defclass")
|
||||
t)
|
||||
"\\s-+'?\\(" (rx lisp-mode-symbol) "\\)")
|
||||
2))
|
||||
|
||||
"Imenu generic expression for Lisp mode. See `imenu-generic-expression'.")
|
||||
|
|
|
|||
|
|
@ -441,7 +441,7 @@ don't include."
|
|||
(file-name-sans-extension
|
||||
(file-name-nondirectory file)))))
|
||||
(push (list (or local-outfile main-outfile) file
|
||||
`(push (purecopy ',(cons (intern package) version))
|
||||
`(push ',(cons (intern package) version)
|
||||
package--builtin-versions))
|
||||
defs))))
|
||||
|
||||
|
|
|
|||
|
|
@ -172,7 +172,7 @@ also call that function before the next warning.")
|
|||
;; safely, testing the existing value, before they call one of the
|
||||
;; warnings functions.
|
||||
;;;###autoload
|
||||
(defvar warning-type-format (purecopy " (%s)")
|
||||
(defvar warning-type-format " (%s)"
|
||||
"Format for displaying the warning type in the warning message.
|
||||
The result of formatting the type this way gets included in the
|
||||
message under the control of the string in `warning-levels'.")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue