From 7ce34a3bcf5ed277ef37aa75e1ccbd858543b6cf Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 20 Aug 2024 18:29:53 +0000 Subject: [PATCH 01/57] Unexec removal: Remove obsolete files * src/sheap.c, src/sheap.h, src/unexec.h, src/unexaix.c, unexcoff.c: * src/unexcw.c, src/unexelf.c, src/unexhp9k800.c, src/unexmacosx.c: * src/unexsol.c, src/unexw32.c: Remove files. --- src/sheap.c | 79 --- src/sheap.h | 30 - src/unexaix.c | 611 -------------------- src/unexcoff.c | 540 ----------------- src/unexcw.c | 302 ---------- src/unexec.h | 4 - src/unexelf.c | 658 --------------------- src/unexhp9k800.c | 324 ----------- src/unexmacosx.c | 1406 --------------------------------------------- src/unexsol.c | 28 - src/unexw32.c | 684 ---------------------- 11 files changed, 4666 deletions(-) delete mode 100644 src/sheap.c delete mode 100644 src/sheap.h delete mode 100644 src/unexaix.c delete mode 100644 src/unexcoff.c delete mode 100644 src/unexcw.c delete mode 100644 src/unexec.h delete mode 100644 src/unexelf.c delete mode 100644 src/unexhp9k800.c delete mode 100644 src/unexmacosx.c delete mode 100644 src/unexsol.c delete mode 100644 src/unexw32.c diff --git a/src/sheap.c b/src/sheap.c deleted file mode 100644 index bab70c4e343..00000000000 --- a/src/sheap.c +++ /dev/null @@ -1,79 +0,0 @@ -/* simulate `sbrk' with an array in .bss, for `unexec' support for Cygwin; - complete rewrite of xemacs Cygwin `unexec' code - - Copyright (C) 2004-2024 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -#include - -#include "sheap.h" - -#include -#include "lisp.h" -#include -#include /* for exit */ - -static int debug_sheap; - -char bss_sbrk_buffer[STATIC_HEAP_SIZE]; -char *max_bss_sbrk_ptr; - -void * -bss_sbrk (ptrdiff_t request_size) -{ - static char *bss_sbrk_ptr; - - if (!bss_sbrk_ptr) - { - max_bss_sbrk_ptr = bss_sbrk_ptr = bss_sbrk_buffer; -#ifdef CYGWIN - /* Force space for fork to work. */ - sbrk (4096); -#endif - } - - int used = bss_sbrk_ptr - bss_sbrk_buffer; - - if (request_size < -used) - { - printf (("attempt to free too much: " - "avail %d used %d failed request %"pD"d\n"), - STATIC_HEAP_SIZE, used, request_size); - exit (-1); - return 0; - } - else if (STATIC_HEAP_SIZE - used < request_size) - { - printf ("static heap exhausted: avail %d used %d failed request %"pD"d\n", - STATIC_HEAP_SIZE, used, request_size); - exit (-1); - return 0; - } - - void *ret = bss_sbrk_ptr; - bss_sbrk_ptr += request_size; - if (max_bss_sbrk_ptr < bss_sbrk_ptr) - max_bss_sbrk_ptr = bss_sbrk_ptr; - if (debug_sheap) - { - if (request_size < 0) - printf ("freed size %"pD"d\n", request_size); - else - printf ("allocated %p size %"pD"d\n", ret, request_size); - } - return ret; -} diff --git a/src/sheap.h b/src/sheap.h deleted file mode 100644 index 92f7ba5e857..00000000000 --- a/src/sheap.h +++ /dev/null @@ -1,30 +0,0 @@ -/* Static heap allocation for GNU Emacs. - -Copyright 2016-2024 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or -(at your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -#include -#include "lisp.h" - -/* Size of the static heap. Guess a value that is probably too large, - by up to a factor of four or so. Typically the unused part is not - paged in and so does not cost much. */ -enum { STATIC_HEAP_SIZE = sizeof (Lisp_Object) << 24 }; - -extern char bss_sbrk_buffer[STATIC_HEAP_SIZE]; -extern char *max_bss_sbrk_ptr; -extern void *bss_sbrk (ptrdiff_t); diff --git a/src/unexaix.c b/src/unexaix.c deleted file mode 100644 index f9bc39cf927..00000000000 --- a/src/unexaix.c +++ /dev/null @@ -1,611 +0,0 @@ -/* Dump an executable file. - Copyright (C) 1985-1988, 1999, 2001-2024 Free Software Foundation, - Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -/* -In other words, you are welcome to use, share and improve this program. -You are forbidden to forbid anyone else to use, share and improve -what you give them. Help stamp out software-hoarding! */ - - -/* Originally based on the COFF unexec.c by Spencer W. Thomas. - * - * Subsequently hacked on by - * Bill Mann - * Andrew Vignaux - * Mike Sperber - * - * Synopsis: - * unexec (const char *new_name, const *old_name); - * - * Takes a snapshot of the program and makes an a.out format file in the - * file named by the string argument new_name. - * If a_name is non-NULL, the symbol table will be taken from the given file. - * On some machines, an existing a_name file is required. - * - */ - -#include -#include "unexec.h" -#include "lisp.h" - -#define PERROR(file) report_error (file, new) -#include -/* Define getpagesize () if the system does not. - Note that this may depend on symbols defined in a.out.h - */ -#include "getpagesize.h" - -#include -#include -#include -#include -#include -#include -#include - -extern char _data[]; -extern char _text[]; - -#include -#include -#include -#include - -static struct filehdr f_hdr; /* File header */ -static struct aouthdr f_ohdr; /* Optional file header (a.out) */ -static off_t bias; /* Bias to add for growth */ -static off_t lnnoptr; /* Pointer to line-number info within file */ - -static off_t text_scnptr; -static off_t data_scnptr; -#define ALIGN(val, pwr) (((val) + ((1L<<(pwr))-1)) & ~((1L<<(pwr))-1)) -static off_t load_scnptr; -static off_t orig_load_scnptr; -static off_t orig_data_scnptr; -static int unrelocate_symbols (int, int, const char *, const char *); - -#ifndef MAX_SECTIONS -#define MAX_SECTIONS 10 -#endif - -static int adjust_lnnoptrs (int, int, const char *); - -static int pagemask; - -#include "lisp.h" - -static _Noreturn void -report_error (const char *file, int fd) -{ - int err = errno; - if (fd) - emacs_close (fd); - report_file_errno ("Cannot unexec", build_string (file), err); -} - -#define ERROR0(msg) report_error_1 (new, msg) -#define ERROR1(msg,x) report_error_1 (new, msg, x) -#define ERROR2(msg,x,y) report_error_1 (new, msg, x, y) - -static _Noreturn void ATTRIBUTE_FORMAT_PRINTF (2, 3) -report_error_1 (int fd, const char *msg, ...) -{ - va_list ap; - emacs_close (fd); - va_start (ap, msg); - verror (msg, ap); - va_end (ap); -} - -static int make_hdr (int, int, const char *, const char *); -static void mark_x (const char *); -static int copy_text_and_data (int); -static int copy_sym (int, int, const char *, const char *); -static void write_segment (int, char *, char *); - -/* **************************************************************** - * unexec - * - * driving logic. - */ -void -unexec (const char *new_name, const char *a_name) -{ - int new = -1, a_out = -1; - - if (a_name && (a_out = emacs_open (a_name, O_RDONLY, 0)) < 0) - { - PERROR (a_name); - } - if ((new = emacs_open (new_name, O_WRONLY | O_CREAT | O_TRUNC, 0777)) < 0) - { - PERROR (new_name); - } - if (make_hdr (new, a_out, - a_name, new_name) < 0 - || copy_text_and_data (new) < 0 - || copy_sym (new, a_out, a_name, new_name) < 0 - || adjust_lnnoptrs (new, a_out, new_name) < 0 - || unrelocate_symbols (new, a_out, a_name, new_name) < 0) - { - emacs_close (new); - return; - } - - emacs_close (new); - if (a_out >= 0) - emacs_close (a_out); -} - -/* **************************************************************** - * make_hdr - * - * Make the header in the new a.out from the header in core. - * Modify the text and data sizes. - */ -static int -make_hdr (int new, int a_out, - const char *a_name, const char *new_name) -{ - int scns; - uintptr_t bss_start; - uintptr_t data_start; - - struct scnhdr section[MAX_SECTIONS]; - struct scnhdr * f_thdr; /* Text section header */ - struct scnhdr * f_dhdr; /* Data section header */ - struct scnhdr * f_bhdr; /* Bss section header */ - struct scnhdr * f_lhdr; /* Loader section header */ - struct scnhdr * f_tchdr; /* Typechk section header */ - struct scnhdr * f_dbhdr; /* Debug section header */ - struct scnhdr * f_xhdr; /* Except section header */ - - load_scnptr = orig_load_scnptr = lnnoptr = 0; - pagemask = getpagesize () - 1; - - /* Adjust text/data boundary. */ - data_start = (uintptr_t) _data; - - data_start = data_start & ~pagemask; /* (Down) to page boundary. */ - - bss_start = (uintptr_t) sbrk (0) + pagemask; - bss_start &= ~ pagemask; - - if (data_start > bss_start) /* Can't have negative data size. */ - { - ERROR2 (("unexec: data_start (0x%"PRIxPTR - ") can't be greater than bss_start (0x%"PRIxPTR")"), - data_start, bss_start); - } - - /* Salvage as much info from the existing file as possible */ - f_thdr = NULL; f_dhdr = NULL; f_bhdr = NULL; - f_lhdr = NULL; f_tchdr = NULL; f_dbhdr = NULL; f_xhdr = NULL; - if (a_out >= 0) - { - if (read (a_out, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) - { - PERROR (a_name); - } - if (f_hdr.f_opthdr > 0) - { - if (read (a_out, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) - { - PERROR (a_name); - } - } - if (f_hdr.f_nscns > MAX_SECTIONS) - { - ERROR0 ("unexec: too many section headers -- increase MAX_SECTIONS"); - } - /* Loop through section headers */ - for (scns = 0; scns < f_hdr.f_nscns; scns++) { - struct scnhdr *s = §ion[scns]; - if (read (a_out, s, sizeof (*s)) != sizeof (*s)) - { - PERROR (a_name); - } - -#define CHECK_SCNHDR(ptr, name, flags) \ - if (strcmp (s->s_name, name) == 0) { \ - if (s->s_flags != flags) { \ - fprintf (stderr, "unexec: %lx flags where %x expected in %s section.\n", \ - (unsigned long)s->s_flags, flags, name); \ - } \ - if (ptr) { \ - fprintf (stderr, "unexec: duplicate section header for section %s.\n", \ - name); \ - } \ - ptr = s; \ - } - CHECK_SCNHDR (f_thdr, _TEXT, STYP_TEXT); - CHECK_SCNHDR (f_dhdr, _DATA, STYP_DATA); - CHECK_SCNHDR (f_bhdr, _BSS, STYP_BSS); - CHECK_SCNHDR (f_lhdr, _LOADER, STYP_LOADER); - CHECK_SCNHDR (f_dbhdr, _DEBUG, STYP_DEBUG); - CHECK_SCNHDR (f_tchdr, _TYPCHK, STYP_TYPCHK); - CHECK_SCNHDR (f_xhdr, _EXCEPT, STYP_EXCEPT); - } - - if (f_thdr == 0) - { - ERROR1 ("unexec: couldn't find \"%s\" section", _TEXT); - } - if (f_dhdr == 0) - { - ERROR1 ("unexec: couldn't find \"%s\" section", _DATA); - } - if (f_bhdr == 0) - { - ERROR1 ("unexec: couldn't find \"%s\" section", _BSS); - } - } - else - { - ERROR0 ("can't build a COFF file from scratch yet"); - } - orig_data_scnptr = f_dhdr->s_scnptr; - orig_load_scnptr = f_lhdr ? f_lhdr->s_scnptr : 0; - - /* Now we alter the contents of all the f_*hdr variables - to correspond to what we want to dump. */ - - /* Indicate that the reloc information is no longer valid for ld (bind); - we only update it enough to fake out the exec-time loader. */ - f_hdr.f_flags |= (F_RELFLG | F_EXEC); - - f_ohdr.dsize = bss_start - f_ohdr.data_start; - f_ohdr.bsize = 0; - - f_dhdr->s_size = f_ohdr.dsize; - f_bhdr->s_size = f_ohdr.bsize; - f_bhdr->s_paddr = f_ohdr.data_start + f_ohdr.dsize; - f_bhdr->s_vaddr = f_ohdr.data_start + f_ohdr.dsize; - - /* fix scnptr's */ - { - off_t ptr = section[0].s_scnptr; - - bias = -1; - for (scns = 0; scns < f_hdr.f_nscns; scns++) - { - struct scnhdr *s = §ion[scns]; - - if (s->s_flags & STYP_PAD) /* .pad sections omitted in AIX 4.1 */ - { - /* - * the text_start should probably be o_algntext but that doesn't - * seem to change - */ - if (f_ohdr.text_start != 0) /* && scns != 0 */ - { - s->s_size = 512 - (ptr % 512); - if (s->s_size == 512) - s->s_size = 0; - } - s->s_scnptr = ptr; - } - else if (s->s_flags & STYP_DATA) - s->s_scnptr = ptr; - else if (!(s->s_flags & (STYP_TEXT | STYP_BSS))) - { - if (bias == -1) /* if first section after bss */ - bias = ptr - s->s_scnptr; - - s->s_scnptr += bias; - ptr = s->s_scnptr; - } - - ptr = ptr + s->s_size; - } - } - - /* fix other pointers */ - for (scns = 0; scns < f_hdr.f_nscns; scns++) - { - struct scnhdr *s = §ion[scns]; - - if (s->s_relptr != 0) - { - s->s_relptr += bias; - } - if (s->s_lnnoptr != 0) - { - if (lnnoptr == 0) lnnoptr = s->s_lnnoptr; - s->s_lnnoptr += bias; - } - } - - if (f_hdr.f_symptr > 0L) - { - f_hdr.f_symptr += bias; - } - - text_scnptr = f_thdr->s_scnptr; - data_scnptr = f_dhdr->s_scnptr; - load_scnptr = f_lhdr ? f_lhdr->s_scnptr : 0; - - if (write (new, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) - { - PERROR (new_name); - } - - if (f_hdr.f_opthdr > 0) - { - if (write (new, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) - { - PERROR (new_name); - } - } - - for (scns = 0; scns < f_hdr.f_nscns; scns++) { - struct scnhdr *s = §ion[scns]; - if (write (new, s, sizeof (*s)) != sizeof (*s)) - { - PERROR (new_name); - } - } - - return (0); -} - -/* **************************************************************** - - * - * Copy the text and data segments from memory to the new a.out - */ -static int -copy_text_and_data (int new) -{ - char *end; - char *ptr; - - lseek (new, text_scnptr, SEEK_SET); - ptr = _text; - end = ptr + f_ohdr.tsize; - write_segment (new, ptr, end); - - lseek (new, data_scnptr, SEEK_SET); - ptr = (char *) (ptrdiff_t) f_ohdr.data_start; - end = ptr + f_ohdr.dsize; - write_segment (new, ptr, end); - - return 0; -} - -#define UnexBlockSz (1<<12) /* read/write block size */ -static void -write_segment (int new, char *ptr, char *end) -{ - int i, nwrite, ret; - char zeros[UnexBlockSz]; - - for (i = 0; ptr < end;) - { - /* distance to next block. */ - nwrite = (((ptrdiff_t) ptr + UnexBlockSz) & -UnexBlockSz) - (ptrdiff_t) ptr; - /* But not beyond specified end. */ - if (nwrite > end - ptr) nwrite = end - ptr; - ret = write (new, ptr, nwrite); - /* If write gets a page fault, it means we reached - a gap between the old text segment and the old data segment. - This gap has probably been remapped into part of the text segment. - So write zeros for it. */ - if (ret == -1 && errno == EFAULT) - { - memset (zeros, 0, nwrite); - write (new, zeros, nwrite); - } - else if (nwrite != ret) - { - int write_errno = errno; - char buf[1000]; - void *addr = ptr; - sprintf (buf, - "unexec write failure: addr %p, fileno %d, size 0x%x, wrote 0x%x, errno %d", - addr, new, nwrite, ret, errno); - errno = write_errno; - PERROR (buf); - } - i += nwrite; - ptr += nwrite; - } -} - -/* **************************************************************** - * copy_sym - * - * Copy the relocation information and symbol table from the a.out to the new - */ -static int -copy_sym (int new, int a_out, const char *a_name, const char *new_name) -{ - char page[UnexBlockSz]; - int n; - - if (a_out < 0) - return 0; - - if (orig_load_scnptr == 0L) - return 0; - - if (lnnoptr && lnnoptr < orig_load_scnptr) /* if there is line number info */ - lseek (a_out, lnnoptr, SEEK_SET); /* start copying from there */ - else - lseek (a_out, orig_load_scnptr, SEEK_SET); /* Position a.out to symtab. */ - - while ((n = read (a_out, page, sizeof page)) > 0) - { - if (write (new, page, n) != n) - { - PERROR (new_name); - } - } - if (n < 0) - { - PERROR (a_name); - } - return 0; -} - -static int -adjust_lnnoptrs (int writedesc, int readdesc, const char *new_name) -{ - int nsyms; - int naux; - int new; - struct syment symentry; - union auxent auxentry; - - if (!lnnoptr || !f_hdr.f_symptr) - return 0; - - if ((new = emacs_open (new_name, O_RDWR, 0)) < 0) - { - PERROR (new_name); - return -1; - } - - lseek (new, f_hdr.f_symptr, SEEK_SET); - for (nsyms = 0; nsyms < f_hdr.f_nsyms; nsyms++) - { - read (new, &symentry, SYMESZ); - if (symentry.n_sclass == C_BINCL || symentry.n_sclass == C_EINCL) - { - symentry.n_value += bias; - lseek (new, -SYMESZ, SEEK_CUR); - write (new, &symentry, SYMESZ); - } - - for (naux = symentry.n_numaux; naux-- != 0; ) - { - read (new, &auxentry, AUXESZ); - nsyms++; - if (naux != 0 /* skip csect auxentry (last entry) */ - && (symentry.n_sclass == C_EXT || symentry.n_sclass == C_HIDEXT)) - { - auxentry.x_sym.x_fcnary.x_fcn.x_lnnoptr += bias; - lseek (new, -AUXESZ, SEEK_CUR); - write (new, &auxentry, AUXESZ); - } - } - } - emacs_close (new); - - return 0; -} - -static int -unrelocate_symbols (int new, int a_out, - const char *a_name, const char *new_name) -{ - int i; - LDHDR ldhdr; - LDREL ldrel; - off_t t_reloc = (intptr_t) _text - f_ohdr.text_start; -#ifndef ALIGN_DATA_RELOC - off_t d_reloc = (intptr_t) _data - f_ohdr.data_start; -#else - /* This worked (and was needed) before AIX 4.2. - I have no idea why. -- Mike */ - off_t d_reloc = (intptr_t) _data - ALIGN (f_ohdr.data_start, 2); -#endif - int * p; - - if (load_scnptr == 0) - return 0; - - lseek (a_out, orig_load_scnptr, SEEK_SET); - if (read (a_out, &ldhdr, sizeof (ldhdr)) != sizeof (ldhdr)) - { - PERROR (new_name); - } - -#define SYMNDX_TEXT 0 -#define SYMNDX_DATA 1 -#define SYMNDX_BSS 2 - - for (i = 0; i < ldhdr.l_nreloc; i++) - { - lseek (a_out, - orig_load_scnptr + LDHDRSZ + LDSYMSZ*ldhdr.l_nsyms + LDRELSZ*i, - SEEK_SET); - - if (read (a_out, &ldrel, LDRELSZ) != LDRELSZ) - { - PERROR (a_name); - } - - /* move the BSS loader symbols to the DATA segment */ - if (ldrel.l_symndx == SYMNDX_BSS) - { - ldrel.l_symndx = SYMNDX_DATA; - - lseek (new, - load_scnptr + LDHDRSZ + LDSYMSZ*ldhdr.l_nsyms + LDRELSZ*i, - SEEK_SET); - - if (write (new, &ldrel, LDRELSZ) != LDRELSZ) - { - PERROR (new_name); - } - } - - if (ldrel.l_rsecnm == f_ohdr.o_sndata) - { - int orig_int; - - lseek (a_out, - orig_data_scnptr + (ldrel.l_vaddr - f_ohdr.data_start), - SEEK_SET); - - if (read (a_out, (void *) &orig_int, sizeof (orig_int)) - != sizeof (orig_int)) - { - PERROR (a_name); - } - - p = (int *) (intptr_t) (ldrel.l_vaddr + d_reloc); - - switch (ldrel.l_symndx) { - case SYMNDX_TEXT: - orig_int = * p - t_reloc; - break; - - case SYMNDX_DATA: - case SYMNDX_BSS: - orig_int = * p - d_reloc; - break; - } - - if (orig_int != * p) - { - lseek (new, - data_scnptr + (ldrel.l_vaddr - f_ohdr.data_start), - SEEK_SET); - if (write (new, (void *) &orig_int, sizeof (orig_int)) - != sizeof (orig_int)) - { - PERROR (new_name); - } - } - } - } - return 0; -} diff --git a/src/unexcoff.c b/src/unexcoff.c deleted file mode 100644 index 4a981da4a04..00000000000 --- a/src/unexcoff.c +++ /dev/null @@ -1,540 +0,0 @@ -/* Copyright (C) 1985-1988, 1992-1994, 2001-2024 Free Software - * Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - - -/* - * unexcoff.c - Convert a running program into an a.out or COFF file. - * - * ================================================================== - * Note: This file is currently used only by the MSDOS (a.k.a. DJGPP) - * build of Emacs. If you are not interested in the MSDOS build, you - * are looking at the wrong version of unexec! - * ================================================================== - * - * Author: Spencer W. Thomas - * Computer Science Dept. - * University of Utah - * Date: Tue Mar 2 1982 - * Originally under the name unexec.c. - * Modified heavily since then. - * - * Synopsis: - * unexec (const char *new_name, const char *old_name); - * - * Takes a snapshot of the program and makes an a.out format file in the - * file named by the string argument new_name. - * If a_name is non-NULL, the symbol table will be taken from the given file. - * On some machines, an existing a_name file is required. - * - * If you make improvements I'd like to get them too. - * harpo!utah-cs!thomas, thomas@Utah-20 - * - */ - -/* Modified to support SysVr3 shared libraries by James Van Artsdalen - * of Dell Computer Corporation. james@bigtex.cactus.org. - */ - -#include -#include "unexec.h" -#include "lisp.h" - -#define PERROR(file) report_error (file, new) - -#ifdef HAVE_UNEXEC /* all rest of file! */ - -#ifdef HAVE_COFF_H -#include -#ifdef MSDOS -#include /* for O_RDONLY, O_RDWR */ -#include /* for _crt0_startup_flags and its bits */ -#include -static int save_djgpp_startup_flags; -#include -static struct __atexit *save_atexit_ptr; -#define filehdr external_filehdr -#define scnhdr external_scnhdr -#define syment external_syment -#define auxent external_auxent -#define n_numaux e_numaux -#define n_type e_type -struct aouthdr -{ - unsigned short magic; /* type of file */ - unsigned short vstamp; /* version stamp */ - unsigned long tsize; /* text size in bytes, padded to FW bdry*/ - unsigned long dsize; /* initialized data " " */ - unsigned long bsize; /* uninitialized data " " */ - unsigned long entry; /* entry pt. */ - unsigned long text_start;/* base of text used for this file */ - unsigned long data_start;/* base of data used for this file */ -}; -#endif /* MSDOS */ -#else /* not HAVE_COFF_H */ -#include -#endif /* not HAVE_COFF_H */ - -/* Define getpagesize if the system does not. - Note that this may depend on symbols defined in a.out.h. */ -#include "getpagesize.h" - -#ifndef makedev /* Try to detect types.h already loaded */ -#include -#endif /* makedev */ -#include - -#include - -extern int etext; - -static long block_copy_start; /* Old executable start point */ -static struct filehdr f_hdr; /* File header */ -static struct aouthdr f_ohdr; /* Optional file header (a.out) */ -long bias; /* Bias to add for growth */ -long lnnoptr; /* Pointer to line-number info within file */ -#define SYMS_START block_copy_start - -static long text_scnptr; -static long data_scnptr; - -static long coff_offset; - -static int pagemask; - -/* Correct an int which is the bit pattern of a pointer to a byte - into an int which is the number of a byte. - This is a no-op on ordinary machines, but not on all. */ - -#define ADDR_CORRECT(x) ((char *) (x) - (char *) 0) - -#include "lisp.h" - -static void -report_error (const char *file, int fd) -{ - int err = errno; - if (fd) - emacs_close (fd); - report_file_errno ("Cannot unexec", build_string (file), err); -} - -#define ERROR0(msg) report_error_1 (new, msg, 0, 0); return -1 -#define ERROR1(msg,x) report_error_1 (new, msg, x, 0); return -1 -#define ERROR2(msg,x,y) report_error_1 (new, msg, x, y); return -1 - -static void -report_error_1 (int fd, const char *msg, int a1, int a2) -{ - emacs_close (fd); - error (msg, a1, a2); -} - -static int make_hdr (int, int, const char *, const char *); -static int copy_text_and_data (int, int); -static int copy_sym (int, int, const char *, const char *); -static void mark_x (const char *); - -/* **************************************************************** - * make_hdr - * - * Make the header in the new a.out from the header in core. - * Modify the text and data sizes. - */ -static int -make_hdr (int new, int a_out, - const char *a_name, const char *new_name) -{ - auto struct scnhdr f_thdr; /* Text section header */ - auto struct scnhdr f_dhdr; /* Data section header */ - auto struct scnhdr f_bhdr; /* Bss section header */ - auto struct scnhdr scntemp; /* Temporary section header */ - register int scns; - unsigned int bss_start; - unsigned int data_start; - - pagemask = getpagesize () - 1; - - /* Adjust text/data boundary. */ - data_start = (int) DATA_START; - data_start = ADDR_CORRECT (data_start); - data_start = data_start & ~pagemask; /* (Down) to page boundary. */ - - bss_start = ADDR_CORRECT (sbrk (0)) + pagemask; - bss_start &= ~ pagemask; - - if (data_start > bss_start) /* Can't have negative data size. */ - { - ERROR2 ("unexec: data_start (%u) can't be greater than bss_start (%u)", - data_start, bss_start); - } - - coff_offset = 0L; /* stays zero, except in DJGPP */ - - /* Salvage as much info from the existing file as possible */ - if (a_out >= 0) - { -#ifdef MSDOS - /* Support the coff-go32-exe format with a prepended stub, since - this is what GCC 2.8.0 and later generates by default in DJGPP. */ - unsigned short mz_header[3]; - - if (read (a_out, &mz_header, sizeof (mz_header)) != sizeof (mz_header)) - { - PERROR (a_name); - } - if (mz_header[0] == 0x5a4d || mz_header[0] == 0x4d5a) /* "MZ" or "ZM" */ - { - coff_offset = (long)mz_header[2] * 512L; - if (mz_header[1]) - coff_offset += (long)mz_header[1] - 512L; - lseek (a_out, coff_offset, 0); - } - else - lseek (a_out, 0L, 0); -#endif /* MSDOS */ - if (read (a_out, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) - { - PERROR (a_name); - } - block_copy_start += sizeof (f_hdr); - if (f_hdr.f_opthdr > 0) - { - if (read (a_out, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) - { - PERROR (a_name); - } - block_copy_start += sizeof (f_ohdr); - } - /* Loop through section headers, copying them in */ - lseek (a_out, coff_offset + sizeof (f_hdr) + f_hdr.f_opthdr, 0); - for (scns = f_hdr.f_nscns; scns > 0; scns--) { - if (read (a_out, &scntemp, sizeof (scntemp)) != sizeof (scntemp)) - { - PERROR (a_name); - } - if (scntemp.s_scnptr > 0L) - { - if (block_copy_start < scntemp.s_scnptr + scntemp.s_size) - block_copy_start = scntemp.s_scnptr + scntemp.s_size; - } - if (strcmp (scntemp.s_name, ".text") == 0) - { - f_thdr = scntemp; - } - else if (strcmp (scntemp.s_name, ".data") == 0) - { - f_dhdr = scntemp; - } - else if (strcmp (scntemp.s_name, ".bss") == 0) - { - f_bhdr = scntemp; - } - } - } - else - { - ERROR0 ("can't build a COFF file from scratch yet"); - } - - /* Now we alter the contents of all the f_*hdr variables - to correspond to what we want to dump. */ - - f_hdr.f_flags |= (F_RELFLG | F_EXEC); - f_ohdr.dsize = bss_start - f_ohdr.data_start; - f_ohdr.bsize = 0; - f_thdr.s_size = f_ohdr.tsize; - f_thdr.s_scnptr = sizeof (f_hdr) + sizeof (f_ohdr); - f_thdr.s_scnptr += (f_hdr.f_nscns) * (sizeof (f_thdr)); - lnnoptr = f_thdr.s_lnnoptr; - text_scnptr = f_thdr.s_scnptr; - f_dhdr.s_paddr = f_ohdr.data_start; - f_dhdr.s_vaddr = f_ohdr.data_start; - f_dhdr.s_size = f_ohdr.dsize; - f_dhdr.s_scnptr = f_thdr.s_scnptr + f_thdr.s_size; - data_scnptr = f_dhdr.s_scnptr; - f_bhdr.s_paddr = f_ohdr.data_start + f_ohdr.dsize; - f_bhdr.s_vaddr = f_ohdr.data_start + f_ohdr.dsize; - f_bhdr.s_size = f_ohdr.bsize; - f_bhdr.s_scnptr = 0L; - bias = f_dhdr.s_scnptr + f_dhdr.s_size - block_copy_start; - - if (f_hdr.f_symptr > 0L) - { - f_hdr.f_symptr += bias; - } - - if (f_thdr.s_lnnoptr > 0L) - { - f_thdr.s_lnnoptr += bias; - } - - if (write (new, &f_hdr, sizeof (f_hdr)) != sizeof (f_hdr)) - { - PERROR (new_name); - } - - if (write (new, &f_ohdr, sizeof (f_ohdr)) != sizeof (f_ohdr)) - { - PERROR (new_name); - } - - if (write (new, &f_thdr, sizeof (f_thdr)) != sizeof (f_thdr)) - { - PERROR (new_name); - } - - if (write (new, &f_dhdr, sizeof (f_dhdr)) != sizeof (f_dhdr)) - { - PERROR (new_name); - } - - if (write (new, &f_bhdr, sizeof (f_bhdr)) != sizeof (f_bhdr)) - { - PERROR (new_name); - } - - return (0); - -} - -void -write_segment (int new, const char *ptr, const char *end) -{ - register int i, nwrite, ret; - /* This is the normal amount to write at once. - It is the size of block that NFS uses. */ - int writesize = 1 << 13; - int pagesize = getpagesize (); - char zeros[1 << 13]; - - memset (zeros, 0, sizeof (zeros)); - - for (i = 0; ptr < end;) - { - /* Distance to next multiple of writesize. */ - nwrite = (((int) ptr + writesize) & -writesize) - (int) ptr; - /* But not beyond specified end. */ - if (nwrite > end - ptr) nwrite = end - ptr; - ret = write (new, ptr, nwrite); - /* If write gets a page fault, it means we reached - a gap between the old text segment and the old data segment. - This gap has probably been remapped into part of the text segment. - So write zeros for it. */ - if (ret == -1 && errno == EFAULT) - { - /* Write only a page of zeros at once, - so that we don't overshoot the start - of the valid memory in the old data segment. */ - if (nwrite > pagesize) - nwrite = pagesize; - write (new, zeros, nwrite); - } - i += nwrite; - ptr += nwrite; - } -} -/* **************************************************************** - * copy_text_and_data - * - * Copy the text and data segments from memory to the new a.out - */ -static int -copy_text_and_data (int new, int a_out) -{ - register char *end; - register char *ptr; - -#ifdef MSDOS - /* Dump the original table of exception handlers, not the one - where our exception hooks are registered. */ - __djgpp_exception_toggle (); - - /* Switch off startup flags that might have been set at runtime - and which might change the way that dumped Emacs works. */ - save_djgpp_startup_flags = _crt0_startup_flags; - _crt0_startup_flags &= ~(_CRT0_FLAG_NO_LFN | _CRT0_FLAG_NEARPTR); - - /* Zero out the 'atexit' chain in the dumped executable, to avoid - calling the atexit functions twice. (emacs.c:main installs an - atexit function.) */ - save_atexit_ptr = __atexit_ptr; - __atexit_ptr = NULL; -#endif - - lseek (new, (long) text_scnptr, 0); - ptr = (char *) f_ohdr.text_start; - end = ptr + f_ohdr.tsize; - write_segment (new, ptr, end); - - lseek (new, (long) data_scnptr, 0); - ptr = (char *) f_ohdr.data_start; - end = ptr + f_ohdr.dsize; - write_segment (new, ptr, end); - -#ifdef MSDOS - /* Restore our exception hooks. */ - __djgpp_exception_toggle (); - - /* Restore the startup flags. */ - _crt0_startup_flags = save_djgpp_startup_flags; - - /* Restore the atexit chain. */ - __atexit_ptr = save_atexit_ptr; -#endif - - - return 0; -} - -/* **************************************************************** - * copy_sym - * - * Copy the relocation information and symbol table from the a.out to the new - */ -static int -copy_sym (int new, int a_out, const char *a_name, const char *new_name) -{ - char page[1024]; - int n; - - if (a_out < 0) - return 0; - - if (SYMS_START == 0L) - return 0; - - if (lnnoptr) /* if there is line number info */ - lseek (a_out, coff_offset + lnnoptr, 0); /* start copying from there */ - else - lseek (a_out, coff_offset + SYMS_START, 0); /* Position a.out to symtab. */ - - while ((n = read (a_out, page, sizeof page)) > 0) - { - if (write (new, page, n) != n) - { - PERROR (new_name); - } - } - if (n < 0) - { - PERROR (a_name); - } - return 0; -} - - -/* - * If the COFF file contains a symbol table and a line number section, - * then any auxiliary entries that have values for x_lnnoptr must - * be adjusted by the amount that the line number section has moved - * in the file (bias computed in make_hdr). The #@$%&* designers of - * the auxiliary entry structures used the absolute file offsets for - * the line number entry rather than an offset from the start of the - * line number section! - * - * When I figure out how to scan through the symbol table and pick out - * the auxiliary entries that need adjustment, this routine will - * be fixed. As it is now, all such entries are wrong and sdb - * will complain. Fred Fish, UniSoft Systems Inc. - */ - -/* This function is probably very slow. Instead of reopening the new - file for input and output it should copy from the old to the new - using the two descriptors already open (WRITEDESC and READDESC). - Instead of reading one small structure at a time it should use - a reasonable size buffer. But I don't have time to work on such - things, so I am installing it as submitted to me. -- RMS. */ - -int -adjust_lnnoptrs (int writedesc, int readdesc, const char *new_name) -{ - register int nsyms; - register int new; - struct syment symentry; - union auxent auxentry; - - if (!lnnoptr || !f_hdr.f_symptr) - return 0; - -#ifdef MSDOS - if ((new = writedesc) < 0) -#else - if ((new = emacs_open (new_name, O_RDWR, 0)) < 0) -#endif - { - PERROR (new_name); - return -1; - } - - lseek (new, f_hdr.f_symptr, 0); - for (nsyms = 0; nsyms < f_hdr.f_nsyms; nsyms++) - { - read (new, &symentry, SYMESZ); - if (symentry.n_numaux) - { - read (new, &auxentry, AUXESZ); - nsyms++; - if (ISFCN (symentry.n_type) || symentry.n_type == 0x2400) - { - auxentry.x_sym.x_fcnary.x_fcn.x_lnnoptr += bias; - lseek (new, -AUXESZ, 1); - write (new, &auxentry, AUXESZ); - } - } - } -#ifndef MSDOS - emacs_close (new); -#endif - return 0; -} - -/* **************************************************************** - * unexec - * - * driving logic. - */ -void -unexec (const char *new_name, const char *a_name) -{ - int new = -1, a_out = -1; - - if (a_name && (a_out = emacs_open (a_name, O_RDONLY, 0)) < 0) - { - PERROR (a_name); - } - if ((new = emacs_open (new_name, O_WRONLY | O_CREAT | O_TRUNC, 0777)) < 0) - { - PERROR (new_name); - } - - if (make_hdr (new, a_out, a_name, new_name) < 0 - || copy_text_and_data (new, a_out) < 0 - || copy_sym (new, a_out, a_name, new_name) < 0 - || adjust_lnnoptrs (new, a_out, new_name) < 0 - ) - { - emacs_close (new); - return; - } - - emacs_close (new); - if (a_out >= 0) - emacs_close (a_out); -} - -#endif /* HAVE_UNEXEC */ diff --git a/src/unexcw.c b/src/unexcw.c deleted file mode 100644 index 5c91498cc6c..00000000000 --- a/src/unexcw.c +++ /dev/null @@ -1,302 +0,0 @@ -/* unexec() support for Cygwin; - complete rewrite of xemacs Cygwin unexec() code - - Copyright (C) 2004-2024 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -#include -#include "unexec.h" -#include "lisp.h" -#include -#include -#include -#include -#include - -#define DOTEXE ".exe" - -/* -** header for Windows executable files -*/ -typedef struct -{ - FILHDR file_header; - PEAOUTHDR file_optional_header; - SCNHDR section_header[32]; -} exe_header_t; - -int debug_unexcw = 0; - -/* -** Read the header from the executable into memory so we can more easily access it. -*/ -static exe_header_t * -read_exe_header (int fd, exe_header_t * exe_header_buffer) -{ - int i; - MAYBE_UNUSED int ret; - - assert (fd >= 0); - assert (exe_header_buffer != 0); - - ret = lseek (fd, 0L, SEEK_SET); - assert (ret != -1); - - ret = - read (fd, &exe_header_buffer->file_header, - sizeof (exe_header_buffer->file_header)); - assert (ret == sizeof (exe_header_buffer->file_header)); - - assert (exe_header_buffer->file_header.e_magic == 0x5a4d); - assert (exe_header_buffer->file_header.nt_signature == 0x4550); -#ifdef __x86_64__ - assert (exe_header_buffer->file_header.f_magic == 0x8664); -#else - assert (exe_header_buffer->file_header.f_magic == 0x014c); -#endif - assert (exe_header_buffer->file_header.f_nscns > 0); - assert (exe_header_buffer->file_header.f_nscns <= - ARRAYELTS (exe_header_buffer->section_header)); - assert (exe_header_buffer->file_header.f_opthdr > 0); - - ret = - read (fd, &exe_header_buffer->file_optional_header, - sizeof (exe_header_buffer->file_optional_header)); - assert (ret == sizeof (exe_header_buffer->file_optional_header)); - -#ifdef __x86_64__ - assert (exe_header_buffer->file_optional_header.magic == 0x020b); -#else - assert (exe_header_buffer->file_optional_header.magic == 0x010b); -#endif - - for (i = 0; i < exe_header_buffer->file_header.f_nscns; ++i) - { - ret = - read (fd, &exe_header_buffer->section_header[i], - sizeof (exe_header_buffer->section_header[i])); - assert (ret == sizeof (exe_header_buffer->section_header[i])); - } - - return (exe_header_buffer); -} - -/* -** Fix the dumped emacs executable: -** -** - copy .data section data of interest from running executable into -** output .exe file -** -** - convert .bss section into an initialized data section (like -** .data) and copy .bss section data of interest from running -** executable into output .exe file -*/ -static void -fixup_executable (int fd) -{ - exe_header_t exe_header_buffer; - exe_header_t *exe_header; - int i; - MAYBE_UNUSED int ret; - int found_data = 0; - int found_bss = 0; - - exe_header = read_exe_header (fd, &exe_header_buffer); - assert (exe_header != 0); - - assert (exe_header->file_header.f_nscns > 0); - for (i = 0; i < exe_header->file_header.f_nscns; ++i) - { - unsigned long start_address = - exe_header->section_header[i].s_vaddr + - exe_header->file_optional_header.ImageBase; - unsigned long end_address = - exe_header->section_header[i].s_vaddr + - exe_header->file_optional_header.ImageBase + - exe_header->section_header[i].s_paddr; - if (debug_unexcw) - printf ("%8s start %#lx end %#lx\n", - exe_header->section_header[i].s_name, - start_address, end_address); - if (my_edata >= (char *) start_address - && my_edata < (char *) end_address) - { - /* data section */ - ret = - lseek (fd, (long) (exe_header->section_header[i].s_scnptr), - SEEK_SET); - assert (ret != -1); - ret = - write (fd, (char *) start_address, - my_edata - (char *) start_address); - assert (ret == my_edata - (char *) start_address); - ++found_data; - if (debug_unexcw) - printf (" .data, mem start %#lx mem length %td\n", - start_address, my_edata - (char *) start_address); - if (debug_unexcw) - printf (" .data, file start %d file length %d\n", - (int) exe_header->section_header[i].s_scnptr, - (int) exe_header->section_header[i].s_paddr); - } - else if (my_endbss >= (char *) start_address - && my_endbss < (char *) end_address) - { - /* bss section */ - ++found_bss; - if (exe_header->section_header[i].s_flags & 0x00000080) - { - /* convert uninitialized data section to initialized data section */ - struct stat statbuf; - ret = fstat (fd, &statbuf); - assert (ret != -1); - - exe_header->section_header[i].s_flags &= ~0x00000080; - exe_header->section_header[i].s_flags |= 0x00000040; - - exe_header->section_header[i].s_scnptr = - (statbuf.st_size + - exe_header->file_optional_header.FileAlignment) / - exe_header->file_optional_header.FileAlignment * - exe_header->file_optional_header.FileAlignment; - - exe_header->section_header[i].s_size = - (exe_header->section_header[i].s_paddr + - exe_header->file_optional_header.FileAlignment) / - exe_header->file_optional_header.FileAlignment * - exe_header->file_optional_header.FileAlignment; - - /* Make sure the generated bootstrap binary isn't - * sparse. NT doesn't use a file cache for sparse - * executables, so if we bootstrap Emacs using a sparse - * bootstrap-emacs.exe, bootstrap takes about twenty - * times longer than it would otherwise. */ - - ret = posix_fallocate (fd, - ( exe_header->section_header[i].s_scnptr + - exe_header->section_header[i].s_size ), - 1); - - assert (ret != -1); - - ret = - lseek (fd, - (long) (exe_header->section_header[i].s_scnptr + - exe_header->section_header[i].s_size - 1), - SEEK_SET); - assert (ret != -1); - ret = write (fd, "", 1); - assert (ret == 1); - - ret = - lseek (fd, - (long) ((char *) &exe_header->section_header[i] - - (char *) exe_header), SEEK_SET); - assert (ret != -1); - ret = - write (fd, &exe_header->section_header[i], - sizeof (exe_header->section_header[i])); - assert (ret == sizeof (exe_header->section_header[i])); - if (debug_unexcw) - printf (" seek to %ld, write %zu\n", - (long) ((char *) &exe_header->section_header[i] - - (char *) exe_header), - sizeof (exe_header->section_header[i])); - } - /* write initialized data section */ - ret = - lseek (fd, (long) (exe_header->section_header[i].s_scnptr), - SEEK_SET); - assert (ret != -1); - ret = - write (fd, (char *) start_address, - my_endbss - (char *) start_address); - assert (ret == (my_endbss - (char *) start_address)); - if (debug_unexcw) - printf (" .bss, mem start %#lx mem length %td\n", - start_address, my_endbss - (char *) start_address); - if (debug_unexcw) - printf (" .bss, file start %d file length %d\n", - (int) exe_header->section_header[i].s_scnptr, - (int) exe_header->section_header[i].s_paddr); - } - } - assert (found_bss == 1); - assert (found_data == 1); -} - -/* -** Windows likes .exe suffixes on executables. -*/ -static char * -add_exe_suffix_if_necessary (const char *name, char *modified) -{ - int i = strlen (name); - if (i <= (sizeof (DOTEXE) - 1)) - { - sprintf (modified, "%s%s", name, DOTEXE); - } - else if (!strcasecmp (name + i - (sizeof (DOTEXE) - 1), DOTEXE)) - { - strcpy (modified, name); - } - else - { - sprintf (modified, "%s%s", name, DOTEXE); - } - return (modified); -} - -void -unexec (const char *outfile, const char *infile) -{ - char infile_buffer[FILENAME_MAX]; - char outfile_buffer[FILENAME_MAX]; - int fd_in; - int fd_out; - int ret; - MAYBE_UNUSED int ret2; - - infile = add_exe_suffix_if_necessary (infile, infile_buffer); - outfile = add_exe_suffix_if_necessary (outfile, outfile_buffer); - - fd_in = emacs_open (infile, O_RDONLY, 0); - assert (fd_in >= 0); - fd_out = emacs_open (outfile, O_RDWR | O_TRUNC | O_CREAT, 0755); - assert (fd_out >= 0); - for (;;) - { - char buffer[4096]; - ret = read (fd_in, buffer, sizeof (buffer)); - if (ret == 0) - { - /* eof */ - break; - } - assert (ret > 0); - /* data */ - ret2 = write (fd_out, buffer, ret); - assert (ret2 == ret); - } - ret = emacs_close (fd_in); - assert (ret == 0); - - fixup_executable (fd_out); - - ret = emacs_close (fd_out); - assert (ret == 0); -} diff --git a/src/unexec.h b/src/unexec.h deleted file mode 100644 index cdb2e8016ea..00000000000 --- a/src/unexec.h +++ /dev/null @@ -1,4 +0,0 @@ -#ifndef EMACS_UNEXEC_H -#define EMACS_UNEXEC_H -void unexec (const char *, const char *); -#endif /* EMACS_UNEXEC_H */ diff --git a/src/unexelf.c b/src/unexelf.c deleted file mode 100644 index 4b109470066..00000000000 --- a/src/unexelf.c +++ /dev/null @@ -1,658 +0,0 @@ -/* Copyright (C) 1985-1988, 1990, 1992, 1999-2024 Free Software - Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -/* -In other words, you are welcome to use, share and improve this program. -You are forbidden to forbid anyone else to use, share and improve -what you give them. Help stamp out software-hoarding! */ - - -/* - * unexec.c - Convert a running program into an a.out file. - * - * Author: Spencer W. Thomas - * Computer Science Dept. - * University of Utah - * Date: Tue Mar 2 1982 - * Modified heavily since then. - * - * Synopsis: - * unexec (const char *new_name, const char *old_name); - * - * Takes a snapshot of the program and makes an a.out format file in the - * file named by the string argument new_name. - * If old_name is non-NULL, the symbol table will be taken from the given file. - * On some machines, an existing old_name file is required. - * - */ - -/* We do not use mmap because that fails with NFS. - Instead we read the whole file, modify it, and write it out. */ - -#include -#include "unexec.h" -#include "lisp.h" - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#ifdef __QNX__ -# include -#elif !defined __NetBSD__ && !defined __OpenBSD__ -# include -#endif -#include -#if defined (_SYSTYPE_SYSV) -#include -#include -#endif /* _SYSTYPE_SYSV */ - -#ifndef MAP_ANON -#ifdef MAP_ANONYMOUS -#define MAP_ANON MAP_ANONYMOUS -#else -#define MAP_ANON 0 -#endif -#endif - -#ifndef MAP_FAILED -#define MAP_FAILED ((void *) -1) -#endif - -#if defined (__alpha__) && !defined (__NetBSD__) && !defined (__OpenBSD__) -/* Declare COFF debugging symbol table. This used to be in - /usr/include/sym.h, but this file is no longer included in Red Hat - 5.0 and presumably in any other glibc 2.x based distribution. */ -typedef struct { - short magic; - short vstamp; - int ilineMax; - int idnMax; - int ipdMax; - int isymMax; - int ioptMax; - int iauxMax; - int issMax; - int issExtMax; - int ifdMax; - int crfd; - int iextMax; - long cbLine; - long cbLineOffset; - long cbDnOffset; - long cbPdOffset; - long cbSymOffset; - long cbOptOffset; - long cbAuxOffset; - long cbSsOffset; - long cbSsExtOffset; - long cbFdOffset; - long cbRfdOffset; - long cbExtOffset; -} HDRR, *pHDRR; -#define cbHDRR sizeof (HDRR) -#define hdrNil ((pHDRR)0) -#endif - -#ifdef __NetBSD__ -/* - * NetBSD does not have normal-looking user-land ELF support. - */ -# if defined __alpha__ || defined __sparc_v9__ || defined _LP64 -# define ELFSIZE 64 -# else -# define ELFSIZE 32 -# endif -# include - -# ifndef PT_LOAD -# define PT_LOAD Elf_pt_load -# if 0 /* was in pkgsrc patches for 20.7 */ -# define SHT_PROGBITS Elf_sht_progbits -# endif -# define SHT_SYMTAB Elf_sht_symtab -# define SHT_DYNSYM Elf_sht_dynsym -# define SHT_NULL Elf_sht_null -# define SHT_NOBITS Elf_sht_nobits -# define SHT_REL Elf_sht_rel -# define SHT_RELA Elf_sht_rela - -# define SHN_UNDEF Elf_eshn_undefined -# define SHN_ABS Elf_eshn_absolute -# define SHN_COMMON Elf_eshn_common -# endif /* !PT_LOAD */ - -# ifdef __alpha__ -# include -# define HDRR struct ecoff_symhdr -# define pHDRR HDRR * -# endif /* __alpha__ */ - -#ifdef __mips__ /* was in pkgsrc patches for 20.7 */ -# define SHT_MIPS_DEBUG DT_MIPS_FLAGS -# define HDRR struct Elf_Shdr -#endif /* __mips__ */ -#endif /* __NetBSD__ */ - -#ifdef __OpenBSD__ -# include -#endif - -#if __GNU_LIBRARY__ - 0 >= 6 -# include /* get ElfW etc */ -#endif - -#ifndef ElfW -# define ElfBitsW(bits, type) Elf##bits##_##type -# ifndef ELFSIZE -# ifdef _LP64 -# define ELFSIZE 64 -# else -# define ELFSIZE 32 -# endif -# endif - /* This macro expands `bits' before invoking ElfBitsW. */ -# define ElfExpandBitsW(bits, type) ElfBitsW (bits, type) -# define ElfW(type) ElfExpandBitsW (ELFSIZE, type) -#endif - -/* The code often converts ElfW (Half) values like e_shentsize to ptrdiff_t; - check that this doesn't lose information. */ -#include -static_assert ((! TYPE_SIGNED (ElfW (Half)) - || PTRDIFF_MIN <= TYPE_MINIMUM (ElfW (Half))) - && TYPE_MAXIMUM (ElfW (Half)) <= PTRDIFF_MAX); - -#ifdef UNEXELF_DEBUG -# define DEBUG_LOG(expr) fprintf (stderr, #expr " 0x%"PRIxMAX"\n", \ - (uintmax_t) (expr)) -#endif - -/* Get the address of a particular section or program header entry, - * accounting for the size of the entries. - */ - -static void * -entry_address (void *section_h, ptrdiff_t idx, ptrdiff_t entsize) -{ - char *h = section_h; - return h + idx * entsize; -} - -#define OLD_SECTION_H(n) \ - (*(ElfW (Shdr) *) entry_address (old_section_h, n, old_file_h->e_shentsize)) -#define NEW_SECTION_H(n) \ - (*(ElfW (Shdr) *) entry_address (new_section_h, n, new_file_h->e_shentsize)) -#define OLD_PROGRAM_H(n) \ - (*(ElfW (Phdr) *) entry_address (old_program_h, n, old_file_h->e_phentsize)) - -typedef unsigned char byte; - -/* **************************************************************** - * unexec - * - * driving logic. - * - * In ELF, this works by replacing the old bss SHT_NOBITS section with - * a new, larger, SHT_PROGBITS section. - * - */ -void -unexec (const char *new_name, const char *old_name) -{ - int new_file, old_file; - off_t new_file_size; - - /* Pointers to the base of the image of the two files. */ - caddr_t old_base, new_base; - -#if MAP_ANON == 0 - int mmap_fd; -#else -# define mmap_fd -1 -#endif - - /* Pointers to the file, program and section headers for the old and - new files. */ - ElfW (Ehdr) *old_file_h, *new_file_h; - ElfW (Phdr) *old_program_h, *new_program_h; - ElfW (Shdr) *old_section_h, *new_section_h; - - /* Point to the section name table. */ - char *old_section_names, *new_section_names; - - ElfW (Phdr) *old_bss_seg, *new_bss_seg; - ElfW (Addr) old_bss_addr, new_bss_addr; - ElfW (Word) old_bss_size, bss_size_growth, new_data2_size; - ElfW (Off) old_bss_offset, new_data2_offset; - - ptrdiff_t n; - ptrdiff_t old_bss_index; - struct stat stat_buf; - off_t old_file_size; - - /* Open the old file, allocate a buffer of the right size, and read - in the file contents. */ - - old_file = emacs_open (old_name, O_RDONLY, 0); - - if (old_file < 0) - fatal ("Can't open %s for reading: %s", old_name, strerror (errno)); - - if (fstat (old_file, &stat_buf) != 0) - fatal ("Can't fstat (%s): %s", old_name, strerror (errno)); - -#if MAP_ANON == 0 - mmap_fd = emacs_open ("/dev/zero", O_RDONLY, 0); - if (mmap_fd < 0) - fatal ("Can't open /dev/zero for reading: %s", strerror (errno)); -#endif - - /* We cannot use malloc here because that may use sbrk. If it does, - we'd dump our temporary buffers with Emacs, and we'd have to be - extra careful to use the correct value of sbrk(0) after - allocating all buffers in the code below, which we aren't. */ - old_file_size = stat_buf.st_size; - if (! (0 <= old_file_size && old_file_size <= SIZE_MAX)) - fatal ("File size out of range"); - old_base = mmap (NULL, old_file_size, PROT_READ | PROT_WRITE, - MAP_ANON | MAP_PRIVATE, mmap_fd, 0); - if (old_base == MAP_FAILED) - fatal ("Can't allocate buffer for %s: %s", old_name, strerror (errno)); - - if (read (old_file, old_base, old_file_size) != old_file_size) - fatal ("Didn't read all of %s: %s", old_name, strerror (errno)); - - /* Get pointers to headers & section names */ - - old_file_h = (ElfW (Ehdr) *) old_base; - old_program_h = (ElfW (Phdr) *) ((byte *) old_base + old_file_h->e_phoff); - old_section_h = (ElfW (Shdr) *) ((byte *) old_base + old_file_h->e_shoff); - old_section_names = (char *) old_base - + OLD_SECTION_H (old_file_h->e_shstrndx).sh_offset; - - /* Find the PT_LOAD header covering the highest address. This - segment will be where bss sections are located, past p_filesz. */ - old_bss_seg = 0; - for (n = old_file_h->e_phnum; --n >= 0; ) - { - ElfW (Phdr) *seg = &OLD_PROGRAM_H (n); - if (seg->p_type == PT_LOAD - && (old_bss_seg == 0 - || seg->p_vaddr > old_bss_seg->p_vaddr)) - old_bss_seg = seg; - } - eassume (old_bss_seg); - if (!old_bss_seg) - emacs_abort (); - - /* Note that old_bss_addr may be lower than the first bss section - address, since the section may need aligning. */ - old_bss_addr = old_bss_seg->p_vaddr + old_bss_seg->p_filesz; - old_bss_offset = old_bss_seg->p_offset + old_bss_seg->p_filesz; - old_bss_size = old_bss_seg->p_memsz - old_bss_seg->p_filesz; - - /* Find the last bss style section in the bss segment range. */ - old_bss_index = -1; - for (n = old_file_h->e_shnum; --n > 0; ) - { - ElfW (Shdr) *shdr = &OLD_SECTION_H (n); - if (shdr->sh_type == SHT_NOBITS - && shdr->sh_addr >= old_bss_addr - && shdr->sh_addr + shdr->sh_size <= old_bss_addr + old_bss_size - && (old_bss_index == -1 - || OLD_SECTION_H (old_bss_index).sh_addr < shdr->sh_addr)) - old_bss_index = n; - } - - if (old_bss_index == -1) - fatal ("no bss section found"); - - void *no_break = (void *) (intptr_t) -1; - void *new_break = no_break; -#ifdef HAVE_SBRK - new_break = sbrk (0); -#endif - if (new_break == no_break) - new_break = (byte *) old_bss_addr + old_bss_size; - new_bss_addr = (ElfW (Addr)) new_break; - bss_size_growth = new_bss_addr - old_bss_addr; - new_data2_size = bss_size_growth; - new_data2_size += alignof (ElfW (Shdr)) - 1; - new_data2_size -= new_data2_size % alignof (ElfW (Shdr)); - - new_data2_offset = old_bss_offset; - -#ifdef UNEXELF_DEBUG - fprintf (stderr, "old_bss_index %td\n", old_bss_index); - DEBUG_LOG (old_bss_addr); - DEBUG_LOG (old_bss_size); - DEBUG_LOG (old_bss_offset); - DEBUG_LOG (new_bss_addr); - DEBUG_LOG (new_data2_size); - DEBUG_LOG (new_data2_offset); -#endif - - if (new_bss_addr < old_bss_addr + old_bss_size) - fatal (".bss shrank when undumping"); - - /* Set the output file to the right size. Allocate a buffer to hold - the image of the new file. Set pointers to various interesting - objects. */ - - new_file = emacs_open (new_name, O_RDWR | O_CREAT, 0777); - if (new_file < 0) - fatal ("Can't creat (%s): %s", new_name, strerror (errno)); - - new_file_size = old_file_size + new_data2_size; - - if (ftruncate (new_file, new_file_size)) - fatal ("Can't ftruncate (%s): %s", new_name, strerror (errno)); - - new_base = mmap (NULL, new_file_size, PROT_READ | PROT_WRITE, - MAP_ANON | MAP_PRIVATE, mmap_fd, 0); - if (new_base == MAP_FAILED) - fatal ("Can't allocate buffer for %s: %s", old_name, strerror (errno)); - - /* Make our new file, program and section headers as copies of the - originals. */ - - new_file_h = (ElfW (Ehdr) *) new_base; - memcpy (new_file_h, old_file_h, old_file_h->e_ehsize); - - /* Fix up file header. Section header is further away now. */ - - if (new_file_h->e_shoff >= old_bss_offset) - new_file_h->e_shoff += new_data2_size; - - new_program_h = (ElfW (Phdr) *) ((byte *) new_base + new_file_h->e_phoff); - new_section_h = (ElfW (Shdr) *) ((byte *) new_base + new_file_h->e_shoff); - - memcpy (new_program_h, old_program_h, - old_file_h->e_phnum * old_file_h->e_phentsize); - memcpy (new_section_h, old_section_h, - old_file_h->e_shnum * old_file_h->e_shentsize); - -#ifdef UNEXELF_DEBUG - DEBUG_LOG (old_file_h->e_shoff); - fprintf (stderr, "Old section count %td\n", (ptrdiff_t) old_file_h->e_shnum); - DEBUG_LOG (new_file_h->e_shoff); - fprintf (stderr, "New section count %td\n", (ptrdiff_t) new_file_h->e_shnum); -#endif - - /* Fix up program header. Extend the writable data segment so - that the bss area is covered too. */ - - new_bss_seg = new_program_h + (old_bss_seg - old_program_h); - new_bss_seg->p_filesz = new_bss_addr - new_bss_seg->p_vaddr; - new_bss_seg->p_memsz = new_bss_seg->p_filesz; - - /* Copy over what we have in memory now for the bss area. */ - memcpy (new_base + new_data2_offset, (caddr_t) old_bss_addr, - bss_size_growth); - - /* Walk through all section headers, copying data and updating. */ - for (n = 1; n < old_file_h->e_shnum; n++) - { - caddr_t src; - ElfW (Shdr) *old_shdr = &OLD_SECTION_H (n); - ElfW (Shdr) *new_shdr = &NEW_SECTION_H (n); - - if (new_shdr->sh_type == SHT_NOBITS - && new_shdr->sh_addr >= old_bss_addr - && (new_shdr->sh_addr + new_shdr->sh_size - <= old_bss_addr + old_bss_size)) - { - /* This section now has file backing. */ - new_shdr->sh_type = SHT_PROGBITS; - - /* SHT_NOBITS sections do not need a valid sh_offset, so it - might be incorrect. Write the correct value. */ - new_shdr->sh_offset = (new_shdr->sh_addr - new_bss_seg->p_vaddr - + new_bss_seg->p_offset); - - /* If this is was a SHT_NOBITS .plt section, then it is - probably a PowerPC PLT. If it is PowerPC64 ELFv1 then - glibc ld.so doesn't initialize the toc pointer word. A - non-zero toc pointer word can defeat Power7 thread safety - during lazy update of a PLT entry. This only matters if - emacs becomes multi-threaded. */ - if (strcmp (old_section_names + new_shdr->sh_name, ".plt") == 0) - memset (new_shdr->sh_offset + new_base, 0, new_shdr->sh_size); - - /* Extend the size of the last bss section to cover dumped - data. */ - if (n == old_bss_index) - new_shdr->sh_size = new_bss_addr - new_shdr->sh_addr; - - /* We have already copied this section from the current - process. */ - continue; - } - - /* Any section that was originally placed after the .bss - section should now be offset by NEW_DATA2_SIZE. */ - if (new_shdr->sh_offset >= old_bss_offset) - new_shdr->sh_offset += new_data2_size; - - /* Now, start to copy the content of sections. */ - if (new_shdr->sh_type == SHT_NULL - || new_shdr->sh_type == SHT_NOBITS) - continue; - - /* Some sections are copied from the current process instead of - the old file. */ - if (!strcmp (old_section_names + new_shdr->sh_name, ".data") - || !strcmp (old_section_names + new_shdr->sh_name, ".sdata") - || !strcmp (old_section_names + new_shdr->sh_name, ".lit4") - || !strcmp (old_section_names + new_shdr->sh_name, ".lit8") - || !strcmp (old_section_names + new_shdr->sh_name, ".sdata1") - || !strcmp (old_section_names + new_shdr->sh_name, ".data1")) - src = (caddr_t) old_shdr->sh_addr; - else - src = old_base + old_shdr->sh_offset; - - memcpy (new_shdr->sh_offset + new_base, src, new_shdr->sh_size); - -#if (defined __alpha__ && !defined __OpenBSD__) || defined _SYSTYPE_SYSV - /* Update Alpha and MIPS COFF debug symbol table. */ - if (strcmp (old_section_names + new_shdr->sh_name, ".mdebug") == 0 - && new_shdr->sh_offset - old_shdr->sh_offset != 0 -#if defined _SYSTYPE_SYSV - && new_shdr->sh_type == SHT_MIPS_DEBUG -#endif - ) - { - ptrdiff_t diff = new_shdr->sh_offset - old_shdr->sh_offset; - HDRR *phdr = (HDRR *) (new_shdr->sh_offset + new_base); - - phdr->cbLineOffset += diff; - phdr->cbDnOffset += diff; - phdr->cbPdOffset += diff; - phdr->cbSymOffset += diff; - phdr->cbOptOffset += diff; - phdr->cbAuxOffset += diff; - phdr->cbSsOffset += diff; - phdr->cbSsExtOffset += diff; - phdr->cbFdOffset += diff; - phdr->cbRfdOffset += diff; - phdr->cbExtOffset += diff; - } -#endif /* __alpha__ || _SYSTYPE_SYSV */ - } - - /* Update the symbol values of _edata and _end. */ - for (n = new_file_h->e_shnum; 0 < --n; ) - { - byte *symnames; - ElfW (Sym) *symp, *symendp; - ElfW (Shdr) *sym_shdr = &NEW_SECTION_H (n); - - if (sym_shdr->sh_type != SHT_DYNSYM - && sym_shdr->sh_type != SHT_SYMTAB) - continue; - - symnames = ((byte *) new_base - + NEW_SECTION_H (sym_shdr->sh_link).sh_offset); - symp = (ElfW (Sym) *) (sym_shdr->sh_offset + new_base); - symendp = (ElfW (Sym) *) ((byte *) symp + sym_shdr->sh_size); - - for (; symp < symendp; symp ++) - { - if (strcmp ((char *) (symnames + symp->st_name), "_end") == 0 - || strcmp ((char *) (symnames + symp->st_name), "end") == 0 - || strcmp ((char *) (symnames + symp->st_name), "_edata") == 0 - || strcmp ((char *) (symnames + symp->st_name), "edata") == 0) - memcpy (&symp->st_value, &new_bss_addr, sizeof (new_bss_addr)); - - /* Strictly speaking, #ifdef below is not necessary. But we - keep it to indicate that this kind of change may also be - necessary for other unexecs to support GNUstep. */ -#ifdef NS_IMPL_GNUSTEP - /* ObjC runtime modifies the values of some data structures - such as classes and selectors in the .data section after - loading. As the dump process copies the .data section - from the current process, that causes problems when the - modified classes are reinitialized in the dumped - executable. We copy such data from the old file, not - from the current process. */ - if (strncmp ((char *) (symnames + symp->st_name), - "_OBJC_", sizeof ("_OBJC_") - 1) == 0) - { - ElfW (Shdr) *new_shdr = &NEW_SECTION_H (symp->st_shndx); - if (new_shdr->sh_type != SHT_NOBITS) - { - ElfW (Shdr) *old_shdr = &OLD_SECTION_H (symp->st_shndx); - ptrdiff_t reladdr = symp->st_value - new_shdr->sh_addr; - ptrdiff_t newoff = reladdr + new_shdr->sh_offset; - - if (old_shdr->sh_type == SHT_NOBITS) - memset (new_base + newoff, 0, symp->st_size); - else - { - ptrdiff_t oldoff = reladdr + old_shdr->sh_offset; - memcpy (new_base + newoff, old_base + oldoff, - symp->st_size); - } - } - } -#endif - } - } - - /* Modify the names of sections we changed from SHT_NOBITS to - SHT_PROGBITS. This is really just cosmetic, but some tools that - (wrongly) operate on section names rather than types might be - confused by a SHT_PROGBITS .bss section. */ - new_section_names = ((char *) new_base - + NEW_SECTION_H (new_file_h->e_shstrndx).sh_offset); - for (n = new_file_h->e_shnum; 0 < --n; ) - { - ElfW (Shdr) *old_shdr = &OLD_SECTION_H (n); - ElfW (Shdr) *new_shdr = &NEW_SECTION_H (n); - - /* Replace the leading '.' with ','. When .shstrtab is string - merged this will rename both .bss and .rela.bss to ,bss and - .rela,bss. */ - if (old_shdr->sh_type == SHT_NOBITS - && new_shdr->sh_type == SHT_PROGBITS) - *(new_section_names + new_shdr->sh_name) = ','; - } - - /* This loop seeks out relocation sections for the data section, so - that it can undo relocations performed by the runtime loader. - - The following approach does not work on x86 platforms that use - the GNU Gold linker, which can generate .rel.dyn relocation - sections containing R_386_32 entries that the following code does - not grok. Emacs works around this problem by avoiding C - constructs that generate such entries, which is horrible hack. - - FIXME: Presumably more problems like this will crop up as linkers - get fancier. We really need to stop assuming that Emacs can grok - arbitrary linker output. See Bug#27248. */ - for (n = new_file_h->e_shnum; 0 < --n; ) - { - ElfW (Shdr) *rel_shdr = &NEW_SECTION_H (n); - ElfW (Shdr) *shdr; - - switch (rel_shdr->sh_type) - { - default: - break; - case SHT_REL: - case SHT_RELA: - /* This code handles two different size structs, but there should - be no harm in that provided that r_offset is always the first - member. */ - shdr = &NEW_SECTION_H (rel_shdr->sh_info); - if (!strcmp (old_section_names + shdr->sh_name, ".data") - || !strcmp (old_section_names + shdr->sh_name, ".sdata") - || !strcmp (old_section_names + shdr->sh_name, ".lit4") - || !strcmp (old_section_names + shdr->sh_name, ".lit8") - || !strcmp (old_section_names + shdr->sh_name, ".sdata1") - || !strcmp (old_section_names + shdr->sh_name, ".data1")) - { - ElfW (Addr) offset = shdr->sh_addr - shdr->sh_offset; - caddr_t reloc = old_base + rel_shdr->sh_offset, end; - for (end = reloc + rel_shdr->sh_size; - reloc < end; - reloc += rel_shdr->sh_entsize) - { - ElfW (Addr) addr = ((ElfW (Rel) *) reloc)->r_offset - offset; - /* Ignore R_*_NONE relocs. */ - if (((ElfW (Rel) *) reloc)->r_offset == 0) - continue; - /* Assume reloc applies to a word. - ??? This is not always true, eg. TLS module/index - pair in .got which occupies two words. */ - memcpy (new_base + addr, old_base + addr, - sizeof (ElfW (Addr))); - } - } - break; - } - } - - /* Write out new_file, and free the buffers. */ - - if (write (new_file, new_base, new_file_size) != new_file_size) - fatal ("Didn't write %lu bytes to %s: %s", - (unsigned long) new_file_size, new_name, strerror (errno)); - munmap (old_base, old_file_size); - munmap (new_base, new_file_size); - - /* Close the files and make the new file executable. */ - -#if MAP_ANON == 0 - emacs_close (mmap_fd); -#endif - - if (emacs_close (old_file) != 0) - fatal ("Can't close (%s): %s", old_name, strerror (errno)); - - if (emacs_close (new_file) != 0) - fatal ("Can't close (%s): %s", new_name, strerror (errno)); -} diff --git a/src/unexhp9k800.c b/src/unexhp9k800.c deleted file mode 100644 index d2943eb18c9..00000000000 --- a/src/unexhp9k800.c +++ /dev/null @@ -1,324 +0,0 @@ -/* Unexec for HP 9000 Series 800 machines. - - This file is in the public domain. - - Author: John V. Morris - - This file was written by John V. Morris at Hewlett Packard. - Both the author and Hewlett Packard Co. have disclaimed the - copyright on this file, and it is therefore in the public domain. - (Search for "hp9k800" in copyright.list.) -*/ - -/* - Bob Desinger - - Note that the GNU project considers support for HP operation a - peripheral activity which should not be allowed to divert effort - from development of the GNU system. Changes in this code will be - installed when users send them in, but aside from that we don't - plan to think about it, or about whether other Emacs maintenance - might break it. - - - Unexec creates a copy of the old a.out file, and replaces the old data - area with the current data area. When the new file is executed, the - process will see the same data structures and data values that the - original process had when unexec was called. - - Unlike other versions of unexec, this one copies symbol table and - debug information to the new a.out file. Thus, the new a.out file - may be debugged with symbolic debuggers. - - If you fix any bugs in this, I'd like to incorporate your fixes. - Send them to uunet!hpda!hpsemc!jmorris or jmorris%hpsemc@hplabs.HP.COM. - - CAVEATS: - This routine saves the current value of all static and external - variables. This means that any data structure that needs to be - initialized must be explicitly reset. Variables will not have their - expected default values. - - Unfortunately, the HP-UX signal handler has internal initialization - flags which are not explicitly reset. Thus, for signals to work in - conjunction with this routine, the following code must executed when - the new process starts up. - - void _sigreturn (); - ... - sigsetreturn (_sigreturn); -*/ - -#include -#include "unexec.h" -#include "lisp.h" -#include "sysstdio.h" - -#include -#include -#include -#include - -/* brk value to restore, stored as a global. - This is really used only if we used shared libraries. */ -static long brk_on_dump = 0; - -/* Called from main, if we use shared libraries. */ -int -run_time_remap (char *ignored) -{ - brk ((char *) brk_on_dump); -} - -#undef roundup -#define roundup(x,n) (((x) + ((n) - 1)) & ~((n) - 1)) /* n is power of 2 */ - -/* Report a fatal error and exit. */ -static _Noreturn void -unexec_error (char const *msg) -{ - perror (msg); - exit (1); -} - -/* Do an lseek and check the result. */ -static void -check_lseek (int fd, off_t offset, int whence) -{ - if (lseek (fd, offset, whence) < 0) - unexec_error ("Cannot lseek"); -} - -/* Save current data space in the file, update header. */ - -static void -save_data_space (int file, struct header *hdr, struct som_exec_auxhdr *auxhdr, - int size) -{ - /* Write the entire data space out to the file */ - if (write (file, auxhdr->exec_dmem, size) != size) - unexec_error ("Can't save new data space"); - - /* Update the header to reflect the new data size */ - auxhdr->exec_dsize = size; - auxhdr->exec_bsize = 0; -} - -/* Update the values of file pointers when something is inserted. */ - -static void -update_file_ptrs (int file, struct header *hdr, struct som_exec_auxhdr *auxhdr, - unsigned int location, int offset) -{ - struct subspace_dictionary_record subspace; - int i; - - /* Increase the overall size of the module */ - hdr->som_length += offset; - - /* Update the various file pointers in the header */ -#define update(ptr) if (ptr > location) ptr = ptr + offset - update (hdr->aux_header_location); - update (hdr->space_strings_location); - update (hdr->init_array_location); - update (hdr->compiler_location); - update (hdr->symbol_location); - update (hdr->fixup_request_location); - update (hdr->symbol_strings_location); - update (hdr->unloadable_sp_location); - update (auxhdr->exec_tfile); - update (auxhdr->exec_dfile); - - /* Do for each subspace dictionary entry */ - check_lseek (file, hdr->subspace_location, 0); - for (i = 0; i < hdr->subspace_total; i++) - { - ptrdiff_t subspace_size = sizeof subspace; - if (read (file, &subspace, subspace_size) != subspace_size) - unexec_error ("Can't read subspace record"); - - /* If subspace has a file location, update it */ - if (subspace.initialization_length > 0 - && subspace.file_loc_init_value > location) - { - subspace.file_loc_init_value += offset; - check_lseek (file, -subspace_size, 1); - if (write (file, &subspace, subspace_size) != subspace_size) - unexec_error ("Can't update subspace record"); - } - } - - /* Do for each initialization pointer record */ - /* (I don't think it applies to executable files, only relocatables) */ -#undef update -} - -/* Read in the header records from an a.out file. */ - -static void -read_header (int file, struct header *hdr, struct som_exec_auxhdr *auxhdr) -{ - - /* Read the header in */ - check_lseek (file, 0, 0); - if (read (file, hdr, sizeof (*hdr)) != sizeof (*hdr)) - unexec_error ("Couldn't read header from a.out file"); - - if (hdr->a_magic != EXEC_MAGIC && hdr->a_magic != SHARE_MAGIC - && hdr->a_magic != DEMAND_MAGIC) - { - fputs ("a.out file doesn't have valid magic number\n", stderr); - exit (1); - } - - check_lseek (file, hdr->aux_header_location, 0); - if (read (file, auxhdr, sizeof (*auxhdr)) != sizeof (*auxhdr)) - unexec_error ("Couldn't read auxiliary header from a.out file"); -} - -/* Write out the header records into an a.out file. */ - -static void -write_header (int file, struct header *hdr, struct som_exec_auxhdr *auxhdr) -{ - /* Update the checksum */ - hdr->checksum = calculate_checksum (hdr); - - /* Write the header back into the a.out file */ - check_lseek (file, 0, 0); - if (write (file, hdr, sizeof (*hdr)) != sizeof (*hdr)) - unexec_error ("Couldn't write header to a.out file"); - check_lseek (file, hdr->aux_header_location, 0); - if (write (file, auxhdr, sizeof (*auxhdr)) != sizeof (*auxhdr)) - unexec_error ("Couldn't write auxiliary header to a.out file"); -} - -/* Calculate the checksum of a SOM header record. */ - -static int -calculate_checksum (struct header *hdr) -{ - int checksum, i, *ptr; - - checksum = 0; ptr = (int *) hdr; - - for (i = 0; i < sizeof (*hdr) / sizeof (int) - 1; i++) - checksum ^= ptr[i]; - - return (checksum); -} - -/* Copy size bytes from the old file to the new one. */ - -static void -copy_file (int old, int new, int size) -{ - int len; - int buffer[8192]; /* word aligned will be faster */ - - for (; size > 0; size -= len) - { - len = min (size, sizeof (buffer)); - if (read (old, buffer, len) != len) - unexec_error ("Read failure on a.out file"); - if (write (new, buffer, len) != len) - unexec_error ("Write failure in a.out file"); - } -} - -/* Copy the rest of the file, up to EOF. */ - -static void -copy_rest (int old, int new) -{ - int buffer[4096]; - int len; - - /* Copy bytes until end of file or error */ - while ((len = read (old, buffer, sizeof (buffer))) > 0) - if (write (new, buffer, len) != len) break; - - if (len != 0) - unexec_error ("Unable to copy the rest of the file"); -} - -#ifdef DEBUG -static void -display_header (struct header *hdr, struct som_exec_auxhdr *auxhdr) -{ - /* Display the header information (debug) */ - printf ("\n\nFILE HEADER\n"); - printf ("magic number %d \n", hdr->a_magic); - printf ("text loc %.8x size %d \n", auxhdr->exec_tmem, auxhdr->exec_tsize); - printf ("data loc %.8x size %d \n", auxhdr->exec_dmem, auxhdr->exec_dsize); - printf ("entry %x \n", auxhdr->exec_entry); - printf ("Bss segment size %u\n", auxhdr->exec_bsize); - printf ("\n"); - printf ("data file loc %d size %d\n", - auxhdr->exec_dfile, auxhdr->exec_dsize); - printf ("som_length %d\n", hdr->som_length); - printf ("unloadable sploc %d size %d\n", - hdr->unloadable_sp_location, hdr->unloadable_sp_size); -} -#endif /* DEBUG */ - - -/* Create a new a.out file, same as old but with current data space */ -void -unexec (const char *new_name, /* name of the new a.out file to be created */ - const char *old_name) /* name of the old a.out file */ -{ - int old, new; - int old_size, new_size; - struct header hdr; - struct som_exec_auxhdr auxhdr; - long i; - - /* For the greatest flexibility, should create a temporary file in - the same directory as the new file. When everything is complete, - rename the temp file to the new name. - This way, a program could update its own a.out file even while - it is still executing. If problems occur, everything is still - intact. NOT implemented. */ - - /* Open the input and output a.out files. */ - old = emacs_open (old_name, O_RDONLY, 0); - if (old < 0) - unexec_error (old_name); - new = emacs_open (new_name, O_CREAT | O_RDWR | O_TRUNC, 0777); - if (new < 0) - unexec_error (new_name); - - /* Read the old headers. */ - read_header (old, &hdr, &auxhdr); - - brk_on_dump = (long) sbrk (0); - - /* Decide how large the new and old data areas are. */ - old_size = auxhdr.exec_dsize; - /* I suspect these two statements are separate - to avoid a compiler bug in hpux version 8. */ - i = (long) sbrk (0); - new_size = i - auxhdr.exec_dmem; - - /* Copy the old file to the new, up to the data space. */ - check_lseek (old, 0, 0); - copy_file (old, new, auxhdr.exec_dfile); - - /* Skip the old data segment and write a new one. */ - check_lseek (old, old_size, 1); - save_data_space (new, &hdr, &auxhdr, new_size); - - /* Copy the rest of the file. */ - copy_rest (old, new); - - /* Update file pointers since we probably changed size of data area. */ - update_file_ptrs (new, &hdr, &auxhdr, auxhdr.exec_dfile, new_size-old_size); - - /* Save the modified header. */ - write_header (new, &hdr, &auxhdr); - - /* Close the binary file. */ - emacs_close (old); - emacs_close (new); -} diff --git a/src/unexmacosx.c b/src/unexmacosx.c deleted file mode 100644 index 7b2326441b4..00000000000 --- a/src/unexmacosx.c +++ /dev/null @@ -1,1406 +0,0 @@ -/* Dump Emacs in Mach-O format for use on macOS. - Copyright (C) 2001-2024 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -/* Contributed by Andrew Choi (akochoi@mac.com). */ - -/* Documentation note. - - Consult the following documents/files for a description of the - Mach-O format: the file loader.h, man pages for Mach-O and ld, old - NEXTSTEP documents of the Mach-O format. The tool otool dumps the - mach header (-h option) and the load commands (-l option) in a - Mach-O file. The tool nm on macOS displays the symbol table in - a Mach-O file. For examples of unexec for the Mach-O format, see - the file unexnext.c in the GNU Emacs distribution, the file - unexdyld.c in the Darwin port of GNU Emacs 20.7, and unexdyld.c in - the Darwin port of XEmacs 21.1. Also the Darwin Libc source - contains the source code for malloc_freezedry and malloc_jumpstart. - Read that to see what they do. This file was written completely - from scratch, making use of information from the above sources. */ - -/* The macOS implementation of unexec makes use of Darwin's `zone' - memory allocator. All calls to malloc, realloc, and free in Emacs - are redirected to unexec_malloc, unexec_realloc, and unexec_free in - this file. When temacs is run, all memory requests are handled in - the zone EmacsZone. The Darwin memory allocator library calls - maintain the data structures to manage this zone. Dumping writes - its contents to data segments of the executable file. When emacs - is run, the loader recreates the contents of the zone in memory. - However since the initialization routine of the zone memory - allocator is run again, this `zone' can no longer be used as a - heap. That is why emacs uses the ordinary malloc system call to - allocate memory. Also, when a block of memory needs to be - reallocated and the new size is larger than the old one, a new - block must be obtained by malloc and the old contents copied to - it. */ - -/* Peculiarity of the Mach-O files generated by ld in macOS - (possible causes of future bugs if changed). - - The file offset of the start of the __TEXT segment is zero. Since - the Mach header and load commands are located at the beginning of a - Mach-O file, copying the contents of the __TEXT segment from the - input file overwrites them in the output file. Despite this, - unexec works fine as written below because the segment load command - for __TEXT appears, and is therefore processed, before all other - load commands except the segment load command for __PAGEZERO, which - remains unchanged. - - Although the file offset of the start of the __TEXT segment is - zero, none of the sections it contains actually start there. In - fact, the earliest one starts a few hundred bytes beyond the end of - the last load command. The linker option -headerpad controls the - minimum size of this padding. Its setting can be changed in - s/darwin.h. A value of 0x690, e.g., leaves room for 30 additional - load commands for the newly created __DATA segments (at 56 bytes - each). Unexec fails if there is not enough room for these new - segments. - - The __TEXT segment contains the sections __text, __cstring, - __picsymbol_stub, and __const and the __DATA segment contains the - sections __data, __la_symbol_ptr, __nl_symbol_ptr, __dyld, __bss, - and __common. The other segments do not contain any sections. - These sections are copied from the input file to the output file, - except for __data, __bss, and __common, which are dumped from - memory. The types of the sections __bss and __common are changed - from S_ZEROFILL to S_REGULAR. Note that the number of sections and - their relative order in the input and output files remain - unchanged. Otherwise all n_sect fields in the nlist records in the - symbol table (specified by the LC_SYMTAB load command) will have to - be changed accordingly. -*/ - -#include - -/* Although redefines malloc to unexec_malloc, etc., this - file wants stdlib.h to declare the originals. */ -#undef malloc -#undef realloc -#undef free - -#include - -#include "unexec.h" -#include "lisp.h" -#include "sysstdio.h" - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#ifdef HAVE_MALLOC_MALLOC_H -#include -#else -#include -#endif - -#include - -/* LC_DATA_IN_CODE is not defined in mach-o/loader.h on Mac OS X 10.7. - But it is used if we build with "Command Line Tools for Xcode 4.5 - (Mac OS X Lion) - September 2012". */ -#ifndef LC_DATA_IN_CODE -#define LC_DATA_IN_CODE 0x29 /* table of non-instructions in __text */ -#endif - -#ifdef _LP64 -#define mach_header mach_header_64 -#define segment_command segment_command_64 -#undef VM_REGION_BASIC_INFO_COUNT -#define VM_REGION_BASIC_INFO_COUNT VM_REGION_BASIC_INFO_COUNT_64 -#undef VM_REGION_BASIC_INFO -#define VM_REGION_BASIC_INFO VM_REGION_BASIC_INFO_64 -#undef LC_SEGMENT -#define LC_SEGMENT LC_SEGMENT_64 -#define vm_region vm_region_64 -#define section section_64 -#undef MH_MAGIC -#define MH_MAGIC MH_MAGIC_64 -#endif - -#define VERBOSE 1 - -/* Size of buffer used to copy data from the input file to the output - file in function unexec_copy. */ -#define UNEXEC_COPY_BUFSZ 1024 - -/* Regions with memory addresses above this value are assumed to be - mapped to dynamically loaded libraries and will not be dumped. */ -#define VM_DATA_TOP (20 * 1024 * 1024) - -/* Type of an element on the list of regions to be dumped. */ -struct region_t { - vm_address_t address; - vm_size_t size; - vm_prot_t protection; - vm_prot_t max_protection; - - struct region_t *next; -}; - -/* Head and tail of the list of regions to be dumped. */ -static struct region_t *region_list_head = 0; -static struct region_t *region_list_tail = 0; - -/* Pointer to array of load commands. */ -static struct load_command **lca; - -/* Number of load commands. */ -static int nlc; - -/* The highest VM address of segments loaded by the input file. - Regions with addresses beyond this are assumed to be allocated - dynamically and thus require dumping. */ -static vm_address_t infile_lc_highest_addr = 0; - -/* The lowest file offset used by the all sections in the __TEXT - segments. This leaves room at the beginning of the file to store - the Mach-O header. Check this value against header size to ensure - the added load commands for the new __DATA segments did not - overwrite any of the sections in the __TEXT segment. */ -static unsigned long text_seg_lowest_offset = 0x10000000; - -/* Mach header. */ -static struct mach_header mh; - -/* Offset at which the next load command should be written. */ -static unsigned long curr_header_offset = sizeof (struct mach_header); - -/* Offset at which the next segment should be written. */ -static unsigned long curr_file_offset = 0; - -static unsigned long pagesize; -#define ROUNDUP_TO_PAGE_BOUNDARY(x) (((x) + pagesize - 1) & ~(pagesize - 1)) - -static int infd, outfd; - -static int in_dumped_exec = 0; - -static malloc_zone_t *emacs_zone; - -/* file offset of input file's data segment */ -static off_t data_segment_old_fileoff = 0; - -static struct segment_command *data_segment_scp; - -/* Read N bytes from infd into memory starting at address DEST. - Return true if successful, false otherwise. */ -static int -unexec_read (void *dest, size_t n) -{ - return n == read (infd, dest, n); -} - -/* Write COUNT bytes from memory starting at address SRC to outfd - starting at offset DEST. Return true if successful, false - otherwise. */ -static int -unexec_write (off_t dest, const void *src, size_t count) -{ - task_t task = mach_task_self(); - if (task == MACH_PORT_NULL || task == MACH_PORT_DEAD) - return false; - - if (lseek (outfd, dest, SEEK_SET) != dest) - return 0; - - /* We use the Mach virtual memory API to read our process memory - because using src directly would be undefined behavior and fails - under Address Sanitizer. */ - bool success = false; - vm_offset_t data; - mach_msg_type_number_t data_count; - if (vm_read (task, (uintptr_t) src, count, &data, &data_count) - == KERN_SUCCESS) - { - success = - write (outfd, (const void *) (uintptr_t) data, data_count) == count; - vm_deallocate (task, data, data_count); - } - return success; -} - -/* Write COUNT bytes of zeros to outfd starting at offset DEST. - Return true if successful, false otherwise. */ -static int -unexec_write_zero (off_t dest, size_t count) -{ - char buf[UNEXEC_COPY_BUFSZ]; - ssize_t bytes; - - memset (buf, 0, UNEXEC_COPY_BUFSZ); - if (lseek (outfd, dest, SEEK_SET) != dest) - return 0; - - while (count > 0) - { - bytes = count > UNEXEC_COPY_BUFSZ ? UNEXEC_COPY_BUFSZ : count; - if (write (outfd, buf, bytes) != bytes) - return 0; - count -= bytes; - } - - return 1; -} - -/* Copy COUNT bytes from starting offset SRC in infd to starting - offset DEST in outfd. Return true if successful, false - otherwise. */ -static int -unexec_copy (off_t dest, off_t src, ssize_t count) -{ - ssize_t bytes_read; - ssize_t bytes_to_read; - - char buf[UNEXEC_COPY_BUFSZ]; - - if (lseek (infd, src, SEEK_SET) != src) - return 0; - - if (lseek (outfd, dest, SEEK_SET) != dest) - return 0; - - while (count > 0) - { - bytes_to_read = count > UNEXEC_COPY_BUFSZ ? UNEXEC_COPY_BUFSZ : count; - bytes_read = read (infd, buf, bytes_to_read); - if (bytes_read <= 0) - return 0; - if (write (outfd, buf, bytes_read) != bytes_read) - return 0; - count -= bytes_read; - } - - return 1; -} - -/* Debugging and informational messages routines. */ - -static _Noreturn void -unexec_error (const char *format, ...) -{ - va_list ap; - - va_start (ap, format); - fputs ("unexec: ", stderr); - vfprintf (stderr, format, ap); - putc ('\n', stderr); - va_end (ap); - exit (1); -} - -static void -print_prot (vm_prot_t prot) -{ - if (prot == VM_PROT_NONE) - printf ("none"); - else - { - putchar (prot & VM_PROT_READ ? 'r' : ' '); - putchar (prot & VM_PROT_WRITE ? 'w' : ' '); - putchar (prot & VM_PROT_EXECUTE ? 'x' : ' '); - putchar (' '); - } -} - -static void -print_region (vm_address_t address, vm_size_t size, vm_prot_t prot, - vm_prot_t max_prot) -{ - printf ("%#10lx %#8lx ", (long) address, (long) size); - print_prot (prot); - putchar (' '); - print_prot (max_prot); - putchar ('\n'); -} - -static void -print_region_list (void) -{ - struct region_t *r; - - printf (" address size prot maxp\n"); - - for (r = region_list_head; r; r = r->next) - print_region (r->address, r->size, r->protection, r->max_protection); -} - -/* Build the list of regions that need to be dumped. Regions with - addresses above VM_DATA_TOP are omitted. Adjacent regions with - identical protection are merged. Note that non-writable regions - cannot be omitted because they some regions created at run time are - read-only. */ -static void -build_region_list (void) -{ - task_t target_task = mach_task_self (); - vm_address_t address = (vm_address_t) 0; - vm_size_t size; - struct vm_region_basic_info info; - mach_msg_type_number_t info_count = VM_REGION_BASIC_INFO_COUNT; - mach_port_t object_name; - struct region_t *r; - -#if VERBOSE - printf ("--- List of All Regions ---\n"); - printf (" address size prot maxp\n"); -#endif - - while (vm_region (target_task, &address, &size, VM_REGION_BASIC_INFO, - (vm_region_info_t) &info, &info_count, &object_name) - == KERN_SUCCESS && info_count == VM_REGION_BASIC_INFO_COUNT) - { - /* Done when we reach addresses of shared libraries, which are - loaded in high memory. */ - if (address >= VM_DATA_TOP) - break; - -#if VERBOSE - print_region (address, size, info.protection, info.max_protection); -#endif - - /* If a region immediately follows the previous one (the one - most recently added to the list) and has identical - protection, merge it with the latter. Otherwise create a - new list element for it. */ - if (region_list_tail - && info.protection == region_list_tail->protection - && info.max_protection == region_list_tail->max_protection - && region_list_tail->address + region_list_tail->size == address) - { - region_list_tail->size += size; - } - else - { - r = malloc (sizeof *r); - - if (!r) - unexec_error ("cannot allocate region structure"); - - r->address = address; - r->size = size; - r->protection = info.protection; - r->max_protection = info.max_protection; - - r->next = 0; - if (region_list_head == 0) - { - region_list_head = r; - region_list_tail = r; - } - else - { - region_list_tail->next = r; - region_list_tail = r; - } - - /* Deallocate (unused) object name returned by - vm_region. */ - if (object_name != MACH_PORT_NULL) - mach_port_deallocate (target_task, object_name); - } - - address += size; - } - - printf ("--- List of Regions to be Dumped ---\n"); - print_region_list (); -} - - -#define MAX_UNEXEC_REGIONS 400 - -static int num_unexec_regions; -typedef struct { - vm_range_t range; - vm_size_t filesize; -} unexec_region_info; -static unexec_region_info unexec_regions[MAX_UNEXEC_REGIONS]; - -static void -unexec_regions_recorder (task_t task, void *rr, unsigned type, - vm_range_t *ranges, unsigned num) -{ - vm_address_t p; - vm_size_t filesize; - - while (num && num_unexec_regions < MAX_UNEXEC_REGIONS) - { - /* Subtract the size of trailing null bytes from filesize. It - can be smaller than vmsize in segment commands. In such a - case, trailing bytes are initialized with zeros. */ - for (p = ranges->address + ranges->size; p > ranges->address; p--) - if (*(((char *) p)-1)) - break; - filesize = p - ranges->address; - - unexec_regions[num_unexec_regions].filesize = filesize; - unexec_regions[num_unexec_regions++].range = *ranges; - printf ("%#10lx (sz: %#8lx/%#8lx)\n", (long) (ranges->address), - (long) filesize, (long) (ranges->size)); - ranges++; num--; - } -} - -static kern_return_t -unexec_reader (task_t task, vm_address_t address, vm_size_t size, void **ptr) -{ - *ptr = (void *) address; - return KERN_SUCCESS; -} - -static void -find_emacs_zone_regions (void) -{ - num_unexec_regions = 0; - - emacs_zone->introspect->enumerator (mach_task_self (), 0, - MALLOC_PTR_REGION_RANGE_TYPE - | MALLOC_ADMIN_REGION_RANGE_TYPE, - (vm_address_t) emacs_zone, - unexec_reader, - unexec_regions_recorder); - - if (num_unexec_regions == MAX_UNEXEC_REGIONS) - unexec_error ("find_emacs_zone_regions: too many regions"); -} - -static int -unexec_regions_sort_compare (const void *a, const void *b) -{ - vm_address_t aa = ((unexec_region_info *) a)->range.address; - vm_address_t bb = ((unexec_region_info *) b)->range.address; - - if (aa < bb) - return -1; - else if (aa > bb) - return 1; - else - return 0; -} - -static void -unexec_regions_merge (void) -{ - qsort (unexec_regions, num_unexec_regions, sizeof (unexec_regions[0]), - &unexec_regions_sort_compare); - - /* Align each region start address to a page boundary. */ - for (unexec_region_info *cur = unexec_regions; - cur < unexec_regions + num_unexec_regions; cur++) - { - vm_size_t padsize = cur->range.address & (pagesize - 1); - if (padsize) - { - cur->range.address -= padsize; - cur->range.size += padsize; - cur->filesize += padsize; - - unexec_region_info *prev = cur == unexec_regions ? NULL : cur - 1; - if (prev - && prev->range.address + prev->range.size > cur->range.address) - { - prev->range.size = cur->range.address - prev->range.address; - if (prev->filesize > prev->range.size) - prev->filesize = prev->range.size; - } - } - } - - int n = 0; - unexec_region_info r = unexec_regions[0]; - for (int i = 1; i < num_unexec_regions; i++) - { - if (r.range.address + r.range.size == unexec_regions[i].range.address - && r.range.size - r.filesize < 2 * pagesize) - { - r.filesize = r.range.size + unexec_regions[i].filesize; - r.range.size += unexec_regions[i].range.size; - } - else - { - unexec_regions[n++] = r; - r = unexec_regions[i]; - } - } - unexec_regions[n++] = r; - num_unexec_regions = n; -} - - -/* More informational messages routines. */ - -static void -print_load_command_name (int lc) -{ - switch (lc) - { - case LC_SEGMENT: -#ifndef _LP64 - printf ("LC_SEGMENT "); -#else - printf ("LC_SEGMENT_64 "); -#endif - break; - case LC_LOAD_DYLINKER: - printf ("LC_LOAD_DYLINKER "); - break; - case LC_LOAD_DYLIB: - printf ("LC_LOAD_DYLIB "); - break; - case LC_SYMTAB: - printf ("LC_SYMTAB "); - break; - case LC_DYSYMTAB: - printf ("LC_DYSYMTAB "); - break; - case LC_UNIXTHREAD: - printf ("LC_UNIXTHREAD "); - break; - case LC_PREBOUND_DYLIB: - printf ("LC_PREBOUND_DYLIB"); - break; - case LC_TWOLEVEL_HINTS: - printf ("LC_TWOLEVEL_HINTS"); - break; -#ifdef LC_UUID - case LC_UUID: - printf ("LC_UUID "); - break; -#endif -#ifdef LC_DYLD_INFO - case LC_DYLD_INFO: - printf ("LC_DYLD_INFO "); - break; - case LC_DYLD_INFO_ONLY: - printf ("LC_DYLD_INFO_ONLY"); - break; -#endif -#ifdef LC_VERSION_MIN_MACOSX - case LC_VERSION_MIN_MACOSX: - printf ("LC_VERSION_MIN_MACOSX"); - break; -#endif -#ifdef LC_FUNCTION_STARTS - case LC_FUNCTION_STARTS: - printf ("LC_FUNCTION_STARTS"); - break; -#endif -#ifdef LC_MAIN - case LC_MAIN: - printf ("LC_MAIN "); - break; -#endif -#ifdef LC_DATA_IN_CODE - case LC_DATA_IN_CODE: - printf ("LC_DATA_IN_CODE "); - break; -#endif -#ifdef LC_SOURCE_VERSION - case LC_SOURCE_VERSION: - printf ("LC_SOURCE_VERSION"); - break; -#endif -#ifdef LC_DYLIB_CODE_SIGN_DRS - case LC_DYLIB_CODE_SIGN_DRS: - printf ("LC_DYLIB_CODE_SIGN_DRS"); - break; -#endif - default: - printf ("unknown "); - } -} - -static void -print_load_command (struct load_command *lc) -{ - print_load_command_name (lc->cmd); - printf ("%8d", lc->cmdsize); - - if (lc->cmd == LC_SEGMENT) - { - struct segment_command *scp; - struct section *sectp; - int j; - - scp = (struct segment_command *) lc; - printf (" %-16.16s %#10lx %#8lx\n", - scp->segname, (long) (scp->vmaddr), (long) (scp->vmsize)); - - sectp = (struct section *) (scp + 1); - for (j = 0; j < scp->nsects; j++) - { - printf (" %-16.16s %#10lx %#8lx\n", - sectp->sectname, (long) (sectp->addr), (long) (sectp->size)); - sectp++; - } - } - else - printf ("\n"); -} - -/* Read header and load commands from input file. Store the latter in - the global array lca. Store the total number of load commands in - global variable nlc. */ -static void -read_load_commands (void) -{ - int i; - - if (!unexec_read (&mh, sizeof (struct mach_header))) - unexec_error ("cannot read mach-o header"); - - if (mh.magic != MH_MAGIC) - unexec_error ("input file not in Mach-O format"); - - if (mh.filetype != MH_EXECUTE) - unexec_error ("input Mach-O file is not an executable object file"); - -#if VERBOSE - printf ("--- Header Information ---\n"); - printf ("Magic = 0x%08x\n", mh.magic); - printf ("CPUType = %d\n", mh.cputype); - printf ("CPUSubType = %d\n", mh.cpusubtype); - printf ("FileType = 0x%x\n", mh.filetype); - printf ("NCmds = %d\n", mh.ncmds); - printf ("SizeOfCmds = %d\n", mh.sizeofcmds); - printf ("Flags = 0x%08x\n", mh.flags); -#endif - - nlc = mh.ncmds; - lca = malloc (nlc * sizeof *lca); - - for (i = 0; i < nlc; i++) - { - struct load_command lc; - /* Load commands are variable-size: so read the command type and - size first and then read the rest. */ - if (!unexec_read (&lc, sizeof (struct load_command))) - unexec_error ("cannot read load command"); - lca[i] = malloc (lc.cmdsize); - memcpy (lca[i], &lc, sizeof (struct load_command)); - if (!unexec_read (lca[i] + 1, lc.cmdsize - sizeof (struct load_command))) - unexec_error ("cannot read content of load command"); - if (lc.cmd == LC_SEGMENT) - { - struct segment_command *scp = (struct segment_command *) lca[i]; - - if (scp->vmaddr + scp->vmsize > infile_lc_highest_addr) - infile_lc_highest_addr = scp->vmaddr + scp->vmsize; - - if (strncmp (scp->segname, SEG_TEXT, 16) == 0) - { - struct section *sectp = (struct section *) (scp + 1); - int j; - - for (j = 0; j < scp->nsects; j++) - if (sectp->offset < text_seg_lowest_offset) - text_seg_lowest_offset = sectp->offset; - } - } - } - - printf ("Highest address of load commands in input file: %#8lx\n", - (unsigned long)infile_lc_highest_addr); - - printf ("Lowest offset of all sections in __TEXT segment: %#8lx\n", - text_seg_lowest_offset); - - printf ("--- List of Load Commands in Input File ---\n"); - printf ("# cmd cmdsize name address size\n"); - - for (i = 0; i < nlc; i++) - { - printf ("%1d ", i); - print_load_command (lca[i]); - } -} - -/* Copy a LC_SEGMENT load command other than the __DATA segment from - the input file to the output file, adjusting the file offset of the - segment and the file offsets of sections contained in it. */ -static void -copy_segment (struct load_command *lc) -{ - struct segment_command *scp = (struct segment_command *) lc; - unsigned long old_fileoff = scp->fileoff; - struct section *sectp; - int j; - - scp->fileoff = curr_file_offset; - - sectp = (struct section *) (scp + 1); - for (j = 0; j < scp->nsects; j++) - { - sectp->offset += curr_file_offset - old_fileoff; - sectp++; - } - - printf ("Writing segment %-16.16s @ %#8lx (%#8lx/%#8lx @ %#10lx)\n", - scp->segname, (long) (scp->fileoff), (long) (scp->filesize), - (long) (scp->vmsize), (long) (scp->vmaddr)); - - if (!unexec_copy (scp->fileoff, old_fileoff, scp->filesize)) - unexec_error ("cannot copy segment from input to output file"); - curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (scp->filesize); - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write load command to header"); - - curr_header_offset += lc->cmdsize; -} - -/* Copy a LC_SEGMENT load command for the __DATA segment in the input - file to the output file. We assume that only one such segment load - command exists in the input file and it contains the sections - __data, __bss, __common, __la_symbol_ptr, __nl_symbol_ptr, and - __dyld. The first three of these should be dumped from memory and - the rest should be copied from the input file. Note that the - sections __bss and __common contain no data in the input file - because their flag fields have the value S_ZEROFILL. Dumping these - from memory makes it necessary to adjust file offset fields in - subsequently dumped load commands. Then, create new __DATA segment - load commands for regions on the region list other than the one - corresponding to the __DATA segment in the input file. */ -static void -copy_data_segment (struct load_command *lc) -{ - struct segment_command *scp = (struct segment_command *) lc; - struct section *sectp; - int j; - unsigned long header_offset, old_file_offset; - - /* The new filesize of the segment is set to its vmsize because data - blocks for segments must start at region boundaries. Note that - this may leave unused locations at the end of the segment data - block because the total of the sizes of all sections in the - segment is generally smaller than vmsize. */ - scp->filesize = scp->vmsize; - - printf ("Writing segment %-16.16s @ %#8lx (%#8lx/%#8lx @ %#10lx)\n", - scp->segname, curr_file_offset, (long)(scp->filesize), - (long)(scp->vmsize), (long) (scp->vmaddr)); - - /* Offsets in the output file for writing the next section structure - and segment data block, respectively. */ - header_offset = curr_header_offset + sizeof (struct segment_command); - - sectp = (struct section *) (scp + 1); - for (j = 0; j < scp->nsects; j++) - { - old_file_offset = sectp->offset; - sectp->offset = sectp->addr - scp->vmaddr + curr_file_offset; - /* The __data section is dumped from memory. The __bss and - __common sections are also dumped from memory but their flag - fields require changing (from S_ZEROFILL to S_REGULAR). The - other three kinds of sections are just copied from the input - file. */ - if (strncmp (sectp->sectname, SECT_DATA, 16) == 0) - { - unsigned long my_size; - - /* The __data section is basically dumped from memory. But - initialized data in statically linked libraries are - copied from the input file. In particular, - add_image_hook.names and add_image_hook.pointers stored - by libarclite_macosx.a, are restored so that they will be - reinitialized when the dumped binary is executed. */ - my_size = (unsigned long)my_edata - sectp->addr; - if (!(sectp->addr <= (unsigned long)my_edata - && my_size <= sectp->size)) - unexec_error ("my_edata is not in section %s", SECT_DATA); - if (!unexec_write (sectp->offset, (void *) sectp->addr, my_size)) - unexec_error ("cannot write section %s", SECT_DATA); - if (!unexec_copy (sectp->offset + my_size, old_file_offset + my_size, - sectp->size - my_size)) - unexec_error ("cannot copy section %s", SECT_DATA); - if (!unexec_write (header_offset, sectp, sizeof (struct section))) - unexec_error ("cannot write section %s's header", SECT_DATA); - } - else if (strncmp (sectp->sectname, SECT_COMMON, 16) == 0) - { - sectp->flags = S_REGULAR; - if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size)) - unexec_error ("cannot write section %.16s", sectp->sectname); - if (!unexec_write (header_offset, sectp, sizeof (struct section))) - unexec_error ("cannot write section %.16s's header", sectp->sectname); - } - else if (strncmp (sectp->sectname, SECT_BSS, 16) == 0) - { - unsigned long my_size; - - sectp->flags = S_REGULAR; - - /* Clear uninitialized local variables in statically linked - libraries. In particular, function pointers stored by - libSystemStub.a, which is introduced in Mac OS X 10.4 for - binary compatibility with respect to long double, are - cleared so that they will be reinitialized when the - dumped binary is executed on other versions of OS. */ - my_size = (unsigned long)my_endbss_static - sectp->addr; - if (!(sectp->addr <= (unsigned long)my_endbss_static - && my_size <= sectp->size)) - unexec_error ("my_endbss_static is not in section %.16s", - sectp->sectname); - if (!unexec_write (sectp->offset, (void *) sectp->addr, my_size)) - unexec_error ("cannot write section %.16s", sectp->sectname); - if (!unexec_write_zero (sectp->offset + my_size, - sectp->size - my_size)) - unexec_error ("cannot write section %.16s", sectp->sectname); - if (!unexec_write (header_offset, sectp, sizeof (struct section))) - unexec_error ("cannot write section %.16s's header", sectp->sectname); - } - else if (strncmp (sectp->sectname, "__bss", 5) == 0 - || strncmp (sectp->sectname, "__pu_bss", 8) == 0) - { - sectp->flags = S_REGULAR; - - /* These sections are produced by GCC 4.6+. - - FIXME: We possibly ought to clear uninitialized local - variables in statically linked libraries like for - SECT_BSS (__bss) above, but setting up the markers we - need in lastfile.c would be rather messy. See - darwin_output_aligned_bss () in gcc/config/darwin.c for - the root of the problem, keeping in mind that the - sections are numbered by their alignment in GCC 4.6, but - by log2(alignment) in GCC 4.7. */ - - if (!unexec_write (sectp->offset, (void *) sectp->addr, sectp->size)) - unexec_error ("cannot copy section %.16s", sectp->sectname); - if (!unexec_write (header_offset, sectp, sizeof (struct section))) - unexec_error ("cannot write section %.16s's header", sectp->sectname); - } - else if (strncmp (sectp->sectname, "__la_symbol_ptr", 16) == 0 - || strncmp (sectp->sectname, "__nl_symbol_ptr", 16) == 0 - || strncmp (sectp->sectname, "__got", 16) == 0 - || strncmp (sectp->sectname, "__la_sym_ptr2", 16) == 0 - || strncmp (sectp->sectname, "__dyld", 16) == 0 - || strncmp (sectp->sectname, "__const", 16) == 0 - || strncmp (sectp->sectname, "__cfstring", 16) == 0 - || strncmp (sectp->sectname, "__gcc_except_tab", 16) == 0 - || strncmp (sectp->sectname, "__program_vars", 16) == 0 - || strncmp (sectp->sectname, "__mod_init_func", 16) == 0 - || strncmp (sectp->sectname, "__mod_term_func", 16) == 0 - || strncmp (sectp->sectname, "__static_data", 16) == 0 - || strncmp (sectp->sectname, "__objc_", 7) == 0) - { - if (!unexec_copy (sectp->offset, old_file_offset, sectp->size)) - unexec_error ("cannot copy section %.16s", sectp->sectname); - if (!unexec_write (header_offset, sectp, sizeof (struct section))) - unexec_error ("cannot write section %.16s's header", sectp->sectname); - } - else - unexec_error ("unrecognized section %.16s in __DATA segment", - sectp->sectname); - - printf (" section %-16.16s at %#8lx - %#8lx (sz: %#8lx)\n", - sectp->sectname, (long) (sectp->offset), - (long) (sectp->offset + sectp->size), (long) (sectp->size)); - - header_offset += sizeof (struct section); - sectp++; - } - - curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (scp->filesize); - - if (!unexec_write (curr_header_offset, scp, sizeof (struct segment_command))) - unexec_error ("cannot write header of __DATA segment"); - curr_header_offset += lc->cmdsize; - - /* Create new __DATA segment load commands for regions on the region - list that do not corresponding to any segment load commands in - the input file. - */ - for (j = 0; j < num_unexec_regions; j++) - { - struct segment_command sc; - - sc.cmd = LC_SEGMENT; - sc.cmdsize = sizeof (struct segment_command); - strncpy (sc.segname, SEG_DATA, 16); - sc.vmaddr = unexec_regions[j].range.address; - sc.vmsize = unexec_regions[j].range.size; - sc.fileoff = curr_file_offset; - sc.filesize = unexec_regions[j].filesize; - sc.maxprot = VM_PROT_READ | VM_PROT_WRITE; - sc.initprot = VM_PROT_READ | VM_PROT_WRITE; - sc.nsects = 0; - sc.flags = 0; - - printf ("Writing segment %-16.16s @ %#8lx (%#8lx/%#8lx @ %#10lx)\n", - sc.segname, (long) (sc.fileoff), (long) (sc.filesize), - (long) (sc.vmsize), (long) (sc.vmaddr)); - - if (!unexec_write (sc.fileoff, (void *) sc.vmaddr, sc.filesize)) - unexec_error ("cannot write new __DATA segment"); - curr_file_offset += ROUNDUP_TO_PAGE_BOUNDARY (sc.filesize); - - if (!unexec_write (curr_header_offset, &sc, sc.cmdsize)) - unexec_error ("cannot write new __DATA segment's header"); - curr_header_offset += sc.cmdsize; - mh.ncmds++; - } -} - -/* Copy a LC_SYMTAB load command from the input file to the output - file, adjusting the file offset fields. */ -static void -copy_symtab (struct load_command *lc, long delta) -{ - struct symtab_command *stp = (struct symtab_command *) lc; - - stp->symoff += delta; - stp->stroff += delta; - - printf ("Writing LC_SYMTAB command\n"); - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write symtab command to header"); - - curr_header_offset += lc->cmdsize; -} - -/* Fix up relocation entries. */ -static void -unrelocate (const char *name, off_t reloff, int nrel, vm_address_t base) -{ - int i, unreloc_count; - struct relocation_info reloc_info; - struct scattered_relocation_info *sc_reloc_info - = (struct scattered_relocation_info *) &reloc_info; - vm_address_t location; - - for (unreloc_count = 0, i = 0; i < nrel; i++) - { - if (lseek (infd, reloff, L_SET) != reloff) - unexec_error ("unrelocate: %s:%d cannot seek to reloc_info", name, i); - if (!unexec_read (&reloc_info, sizeof (reloc_info))) - unexec_error ("unrelocate: %s:%d cannot read reloc_info", name, i); - reloff += sizeof (reloc_info); - - if (sc_reloc_info->r_scattered == 0) - switch (reloc_info.r_type) - { - case GENERIC_RELOC_VANILLA: - location = base + reloc_info.r_address; - if (location >= data_segment_scp->vmaddr - && location < (data_segment_scp->vmaddr - + data_segment_scp->vmsize)) - { - off_t src_off = data_segment_old_fileoff - + (location - data_segment_scp->vmaddr); - off_t dst_off = data_segment_scp->fileoff - + (location - data_segment_scp->vmaddr); - - if (!unexec_copy (dst_off, src_off, 1 << reloc_info.r_length)) - unexec_error ("unrelocate: %s:%d cannot copy original value", - name, i); - unreloc_count++; - } - break; - default: - unexec_error ("unrelocate: %s:%d cannot handle type = %d", - name, i, reloc_info.r_type); - } - else - unexec_error ("unrelocate: %s:%d cannot handle scattered type = %d", - name, i, sc_reloc_info->r_type); - } - - if (nrel > 0) - printf ("Fixed up %d/%d %s relocation entries in data segment.\n", - unreloc_count, nrel, name); -} - -/* Copy a LC_DYSYMTAB load command from the input file to the output - file, adjusting the file offset fields. */ -static void -copy_dysymtab (struct load_command *lc, long delta) -{ - struct dysymtab_command *dstp = (struct dysymtab_command *) lc; - vm_address_t base; - -#ifdef _LP64 - /* First writable segment address. */ - base = data_segment_scp->vmaddr; -#else - /* First segment address in the file (unless MH_SPLIT_SEGS set). */ - base = 0; -#endif - - unrelocate ("local", dstp->locreloff, dstp->nlocrel, base); - unrelocate ("external", dstp->extreloff, dstp->nextrel, base); - - if (dstp->nextrel > 0) { - dstp->extreloff += delta; - } - - if (dstp->nlocrel > 0) { - dstp->locreloff += delta; - } - - if (dstp->nindirectsyms > 0) - dstp->indirectsymoff += delta; - - printf ("Writing LC_DYSYMTAB command\n"); - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write symtab command to header"); - - curr_header_offset += lc->cmdsize; -} - -/* Copy a LC_TWOLEVEL_HINTS load command from the input file to the output - file, adjusting the file offset fields. */ -static void -copy_twolevelhints (struct load_command *lc, long delta) -{ - struct twolevel_hints_command *tlhp = (struct twolevel_hints_command *) lc; - - if (tlhp->nhints > 0) { - tlhp->offset += delta; - } - - printf ("Writing LC_TWOLEVEL_HINTS command\n"); - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write two level hint command to header"); - - curr_header_offset += lc->cmdsize; -} - -#ifdef LC_DYLD_INFO -/* Copy a LC_DYLD_INFO(_ONLY) load command from the input file to the output - file, adjusting the file offset fields. */ -static void -copy_dyld_info (struct load_command *lc, long delta) -{ - struct dyld_info_command *dip = (struct dyld_info_command *) lc; - - if (dip->rebase_off > 0) - dip->rebase_off += delta; - if (dip->bind_off > 0) - dip->bind_off += delta; - if (dip->weak_bind_off > 0) - dip->weak_bind_off += delta; - if (dip->lazy_bind_off > 0) - dip->lazy_bind_off += delta; - if (dip->export_off > 0) - dip->export_off += delta; - - printf ("Writing "); - print_load_command_name (lc->cmd); - printf (" command\n"); - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write dyld info command to header"); - - curr_header_offset += lc->cmdsize; -} -#endif - -#ifdef LC_FUNCTION_STARTS -/* Copy a LC_FUNCTION_STARTS/LC_DATA_IN_CODE/LC_DYLIB_CODE_SIGN_DRS - load command from the input file to the output file, adjusting the - data offset field. */ -static void -copy_linkedit_data (struct load_command *lc, long delta) -{ - struct linkedit_data_command *ldp = (struct linkedit_data_command *) lc; - - if (ldp->dataoff > 0) - ldp->dataoff += delta; - - printf ("Writing "); - print_load_command_name (lc->cmd); - printf (" command\n"); - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write linkedit data command to header"); - - curr_header_offset += lc->cmdsize; -} -#endif - -/* Copy other kinds of load commands from the input file to the output - file, ones that do not require adjustments of file offsets. */ -static void -copy_other (struct load_command *lc) -{ - printf ("Writing "); - print_load_command_name (lc->cmd); - printf (" command\n"); - - if (!unexec_write (curr_header_offset, lc, lc->cmdsize)) - unexec_error ("cannot write symtab command to header"); - - curr_header_offset += lc->cmdsize; -} - -/* Loop through all load commands and dump them. Then write the Mach - header. */ -static void -dump_it (void) -{ - int i; - long linkedit_delta = 0; - - printf ("--- Load Commands written to Output File ---\n"); - - for (i = 0; i < nlc; i++) - switch (lca[i]->cmd) - { - case LC_SEGMENT: - { - struct segment_command *scp = (struct segment_command *) lca[i]; - if (strncmp (scp->segname, SEG_DATA, 16) == 0) - { - /* save data segment file offset and segment_command for - unrelocate */ - if (data_segment_old_fileoff) - unexec_error ("cannot handle multiple DATA segments" - " in input file"); - data_segment_old_fileoff = scp->fileoff; - data_segment_scp = scp; - - copy_data_segment (lca[i]); - } - else - { - if (strncmp (scp->segname, SEG_LINKEDIT, 16) == 0) - { - if (linkedit_delta) - unexec_error ("cannot handle multiple LINKEDIT segments" - " in input file"); - linkedit_delta = curr_file_offset - scp->fileoff; - } - - copy_segment (lca[i]); - } - } - break; - case LC_SYMTAB: - copy_symtab (lca[i], linkedit_delta); - break; - case LC_DYSYMTAB: - copy_dysymtab (lca[i], linkedit_delta); - break; - case LC_TWOLEVEL_HINTS: - copy_twolevelhints (lca[i], linkedit_delta); - break; -#ifdef LC_DYLD_INFO - case LC_DYLD_INFO: - case LC_DYLD_INFO_ONLY: - copy_dyld_info (lca[i], linkedit_delta); - break; -#endif -#ifdef LC_FUNCTION_STARTS - case LC_FUNCTION_STARTS: -#ifdef LC_DATA_IN_CODE - case LC_DATA_IN_CODE: -#endif -#ifdef LC_DYLIB_CODE_SIGN_DRS - case LC_DYLIB_CODE_SIGN_DRS: -#endif - copy_linkedit_data (lca[i], linkedit_delta); - break; -#endif - default: - copy_other (lca[i]); - break; - } - - if (curr_header_offset > text_seg_lowest_offset) - unexec_error ("not enough room for load commands for new __DATA segments" - " (increase headerpad_extra in configure.in to at least %lX)", - num_unexec_regions * sizeof (struct segment_command)); - - printf ("%ld unused bytes follow Mach-O header\n", - text_seg_lowest_offset - curr_header_offset); - - mh.sizeofcmds = curr_header_offset - sizeof (struct mach_header); - if (!unexec_write (0, &mh, sizeof (struct mach_header))) - unexec_error ("cannot write final header contents"); -} - -/* Take a snapshot of Emacs and make a Mach-O format executable file - from it. The file names of the output and input files are outfile - and infile, respectively. The three other parameters are - ignored. */ -void -unexec (const char *outfile, const char *infile) -{ - if (in_dumped_exec) - unexec_error ("Unexec from a dumped executable is not supported."); - - pagesize = getpagesize (); - infd = emacs_open (infile, O_RDONLY, 0); - if (infd < 0) - { - unexec_error ("%s: %s", infile, strerror (errno)); - } - - outfd = emacs_open (outfile, O_WRONLY | O_TRUNC | O_CREAT, 0777); - if (outfd < 0) - { - emacs_close (infd); - unexec_error ("%s: %s", outfile, strerror (errno)); - } - - build_region_list (); - read_load_commands (); - - find_emacs_zone_regions (); - unexec_regions_merge (); - - in_dumped_exec = 1; - - dump_it (); - - emacs_close (outfd); -} - - -void -unexec_init_emacs_zone (void) -{ - emacs_zone = malloc_create_zone (0, 0); - malloc_set_zone_name (emacs_zone, "EmacsZone"); -} - -#ifndef MACOSX_MALLOC_MULT16 -#define MACOSX_MALLOC_MULT16 1 -#endif - -typedef struct unexec_malloc_header { - union { - char c[8]; - size_t size; - } u; -} unexec_malloc_header_t; - -#if MACOSX_MALLOC_MULT16 - -#define ptr_in_unexec_regions(p) ((((vm_address_t) (p)) & 8) != 0) - -#else - -int -ptr_in_unexec_regions (void *ptr) -{ - int i; - - for (i = 0; i < num_unexec_regions; i++) - if ((vm_address_t) ptr - unexec_regions[i].range.address - < unexec_regions[i].range.size) - return 1; - - return 0; -} - -#endif - -void * -unexec_malloc (size_t size) -{ - if (in_dumped_exec) - { - void *p; - - p = malloc (size); -#if MACOSX_MALLOC_MULT16 - assert (((vm_address_t) p % 16) == 0); -#endif - return p; - } - else - { - unexec_malloc_header_t *ptr; - - ptr = (unexec_malloc_header_t *) - malloc_zone_malloc (emacs_zone, size + sizeof (unexec_malloc_header_t)); - ptr->u.size = size; - ptr++; -#if MACOSX_MALLOC_MULT16 - assert (((vm_address_t) ptr % 16) == 8); -#endif - return (void *) ptr; - } -} - -void * -unexec_realloc (void *old_ptr, size_t new_size) -{ - if (in_dumped_exec) - { - void *p; - - if (ptr_in_unexec_regions (old_ptr)) - { - size_t old_size = ((unexec_malloc_header_t *) old_ptr)[-1].u.size; - size_t size = new_size > old_size ? old_size : new_size; - - p = malloc (new_size); - if (size) - memcpy (p, old_ptr, size); - } - else - { - p = realloc (old_ptr, new_size); - } -#if MACOSX_MALLOC_MULT16 - assert (((vm_address_t) p % 16) == 0); -#endif - return p; - } - else - { - unexec_malloc_header_t *ptr; - - ptr = (unexec_malloc_header_t *) - malloc_zone_realloc (emacs_zone, (unexec_malloc_header_t *) old_ptr - 1, - new_size + sizeof (unexec_malloc_header_t)); - ptr->u.size = new_size; - ptr++; -#if MACOSX_MALLOC_MULT16 - assert (((vm_address_t) ptr % 16) == 8); -#endif - return (void *) ptr; - } -} - -void -unexec_free (void *ptr) -{ - if (ptr == NULL) - return; - if (in_dumped_exec) - { - if (!ptr_in_unexec_regions (ptr)) - free (ptr); - } - else - malloc_zone_free (emacs_zone, (unexec_malloc_header_t *) ptr - 1); -} diff --git a/src/unexsol.c b/src/unexsol.c deleted file mode 100644 index 0f84099d39e..00000000000 --- a/src/unexsol.c +++ /dev/null @@ -1,28 +0,0 @@ -/* Trivial unexec for Solaris. */ - -#include -#include "unexec.h" - -#include - -#include "lisp.h" -#include "buffer.h" -#include "coding.h" - -void -unexec (const char *new_name, const char *old_name) -{ - Lisp_Object data; - Lisp_Object errstring; - - if (! dldump (0, new_name, RTLD_MEMORY)) - return; - - data = list1 (build_string (new_name)); - synchronize_system_messages_locale (); - errstring = code_convert_string_norecord (build_string (dlerror ()), - Vlocale_coding_system, 0); - - xsignal (Qfile_error, - Fcons (build_string ("Cannot unexec"), Fcons (errstring, data))); -} diff --git a/src/unexw32.c b/src/unexw32.c deleted file mode 100644 index f0a910781cc..00000000000 --- a/src/unexw32.c +++ /dev/null @@ -1,684 +0,0 @@ -/* unexec for GNU Emacs on Windows NT. - Copyright (C) 1994, 2001-2024 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -/* - Geoff Voelker (voelker@cs.washington.edu) 8-12-94 -*/ - -#include -#include "unexec.h" -#include "lisp.h" -#include "w32common.h" -#include "w32.h" - -#include -#include -#include -#include - -/* Include relevant definitions from IMAGEHLP.H, which can be found - in \\win32sdk\mstools\samples\image\include\imagehlp.h. */ - -PIMAGE_NT_HEADERS (__stdcall * pfnCheckSumMappedFile) (LPVOID BaseAddress, - DWORD FileLength, - LPDWORD HeaderSum, - LPDWORD CheckSum); - -extern char my_begdata[]; -extern char my_begbss[]; -extern char *my_begbss_static; - -#include "w32heap.h" - -void get_section_info (file_data *p_file); -void copy_executable_and_dump_data (file_data *, file_data *); -void dump_bss_and_heap (file_data *p_infile, file_data *p_outfile); - -/* Cached info about the .data section in the executable. */ -PIMAGE_SECTION_HEADER data_section; -PCHAR data_start = 0; -DWORD_PTR data_size = 0; - -/* Cached info about the .bss section in the executable. */ -PIMAGE_SECTION_HEADER bss_section; -PCHAR bss_start = 0; -DWORD_PTR bss_size = 0; -DWORD_PTR extra_bss_size = 0; -/* bss data that is static might be discontiguous from non-static. */ -PIMAGE_SECTION_HEADER bss_section_static; -PCHAR bss_start_static = 0; -DWORD_PTR bss_size_static = 0; -DWORD_PTR extra_bss_size_static = 0; - -/* File handling. */ - -/* Implementation note: this and the next functions work with ANSI - codepage encoded file names! */ - -int -open_output_file (file_data *p_file, char *filename, unsigned long size) -{ - HANDLE file; - HANDLE file_mapping; - void *file_base; - - /* We delete any existing FILENAME because loadup.el will create a - hard link to it under the name emacs-XX.YY.ZZ.nn.exe. Evidently, - overwriting a file on Unix breaks any hard links to it, but that - doesn't happen on Windows. If we don't delete the file before - creating it, all the emacs-XX.YY.ZZ.nn.exe end up being hard - links to the same file, which defeats the purpose of these hard - links: being able to run previous builds. */ - DeleteFileA (filename); - file = CreateFileA (filename, GENERIC_READ | GENERIC_WRITE, 0, NULL, - CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); - if (file == INVALID_HANDLE_VALUE) - return FALSE; - - file_mapping = CreateFileMapping (file, NULL, PAGE_READWRITE, - 0, size, NULL); - if (!file_mapping) - return FALSE; - - file_base = MapViewOfFile (file_mapping, FILE_MAP_WRITE, 0, 0, size); - if (file_base == 0) - return FALSE; - - p_file->name = filename; - p_file->size = size; - p_file->file = file; - p_file->file_mapping = file_mapping; - p_file->file_base = file_base; - - return TRUE; -} - - -/* Routines to manipulate NT executable file sections. */ - -/* Return pointer to section header for named section. */ -IMAGE_SECTION_HEADER * -find_section (const char * name, IMAGE_NT_HEADERS * nt_header) -{ - PIMAGE_SECTION_HEADER section; - int i; - - section = IMAGE_FIRST_SECTION (nt_header); - - for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) - { - if (strcmp ((char *)section->Name, name) == 0) - return section; - section++; - } - return NULL; -} - -#if 0 /* unused */ -/* Return pointer to section header for section containing the given - offset in its raw data area. */ -static IMAGE_SECTION_HEADER * -offset_to_section (DWORD_PTR offset, IMAGE_NT_HEADERS * nt_header) -{ - PIMAGE_SECTION_HEADER section; - int i; - - section = IMAGE_FIRST_SECTION (nt_header); - - for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) - { - if (offset >= section->PointerToRawData - && offset < section->PointerToRawData + section->SizeOfRawData) - return section; - section++; - } - return NULL; -} -#endif - -/* Return offset to an object in dst, given offset in src. We assume - there is at least one section in both src and dst images, and that - the some sections may have been added to dst (after sections in src). */ -static DWORD_PTR -relocate_offset (DWORD_PTR offset, - IMAGE_NT_HEADERS * src_nt_header, - IMAGE_NT_HEADERS * dst_nt_header) -{ - PIMAGE_SECTION_HEADER src_section = IMAGE_FIRST_SECTION (src_nt_header); - PIMAGE_SECTION_HEADER dst_section = IMAGE_FIRST_SECTION (dst_nt_header); - int i = 0; - - while (offset >= src_section->PointerToRawData) - { - if (offset < src_section->PointerToRawData + src_section->SizeOfRawData) - break; - i++; - if (i == src_nt_header->FileHeader.NumberOfSections) - { - /* Handle offsets after the last section. */ - dst_section = IMAGE_FIRST_SECTION (dst_nt_header); - dst_section += dst_nt_header->FileHeader.NumberOfSections - 1; - while (dst_section->PointerToRawData == 0) - dst_section--; - while (src_section->PointerToRawData == 0) - src_section--; - return offset - + (dst_section->PointerToRawData + dst_section->SizeOfRawData) - - (src_section->PointerToRawData + src_section->SizeOfRawData); - } - src_section++; - dst_section++; - } - return offset + - (dst_section->PointerToRawData - src_section->PointerToRawData); -} - -#define RVA_TO_OFFSET(rva, section) \ - ((section)->PointerToRawData + ((DWORD_PTR)(rva) - (section)->VirtualAddress)) - -#define RVA_TO_SECTION_OFFSET(rva, section) \ - ((DWORD_PTR)(rva) - (section)->VirtualAddress) - -/* Convert address in executing image to RVA. */ -#define PTR_TO_RVA(ptr) ((DWORD_PTR)(ptr) - (DWORD_PTR) GetModuleHandle (NULL)) - -#define PTR_TO_OFFSET(ptr, pfile_data) \ - ((unsigned char *)(ptr) - (pfile_data)->file_base) - -#define OFFSET_TO_PTR(offset, pfile_data) \ - ((pfile_data)->file_base + (DWORD_PTR)(offset)) - -#if 0 /* unused */ -#define OFFSET_TO_RVA(offset, section) \ - ((section)->VirtualAddress + ((DWORD_PTR)(offset) - (section)->PointerToRawData)) - -#define RVA_TO_PTR(var,section,filedata) \ - ((unsigned char *)(RVA_TO_OFFSET (var,section) + (filedata).file_base)) -#endif - - -/* Flip through the executable and cache the info necessary for dumping. */ -void -get_section_info (file_data *p_infile) -{ - PIMAGE_DOS_HEADER dos_header; - PIMAGE_NT_HEADERS nt_header; - int overlap; - - dos_header = (PIMAGE_DOS_HEADER) p_infile->file_base; - if (dos_header->e_magic != IMAGE_DOS_SIGNATURE) - { - printf ("Unknown EXE header in %s...bailing.\n", p_infile->name); - exit (1); - } - nt_header = (PIMAGE_NT_HEADERS) (((DWORD_PTR) dos_header) + - dos_header->e_lfanew); - if (nt_header == NULL) - { - printf ("Failed to find IMAGE_NT_HEADER in %s...bailing.\n", - p_infile->name); - exit (1); - } - - /* Check the NT header signature ... */ - if (nt_header->Signature != IMAGE_NT_SIGNATURE) - { - printf ("Invalid IMAGE_NT_SIGNATURE 0x%lx in %s...bailing.\n", - nt_header->Signature, p_infile->name); - exit (1); - } - - /* Locate the ".data" and ".bss" sections for Emacs. (Note that the - actual section names are probably different from these, and might - actually be the same section.) - - We do this as follows: first we determine the virtual address - ranges in this process for the data and bss variables that we wish - to preserve. Then we map these VAs to the section entries in the - source image. Finally, we determine the new size of the raw data - area for the bss section, so we can make the new image the correct - size. */ - - /* We arrange for the Emacs initialized data to be in a separate - section if possible, because we cannot rely on my_begdata and - my_edata marking out the full extent of the initialized data, at - least on the Alpha where the linker freely reorders variables - across libraries. If we can arrange for this, all we need to do is - find the start and size of the EMDATA section. */ - data_section = find_section ("EMDATA", nt_header); - if (data_section) - { - data_start = (char *) nt_header->OptionalHeader.ImageBase + - data_section->VirtualAddress; - data_size = data_section->Misc.VirtualSize; - } - else - { - /* Fallback on the old method if compiler doesn't support the - data_set #pragma (or its equivalent). */ - data_start = my_begdata; - data_size = my_edata - my_begdata; - data_section = rva_to_section (PTR_TO_RVA (my_begdata), nt_header); - if (data_section != rva_to_section (PTR_TO_RVA (my_edata), nt_header)) - { - printf ("Initialized data is not in a single section...bailing\n"); - exit (1); - } - } - - /* As noted in lastfile.c, the Alpha (but not the Intel) MSVC linker - globally segregates all static and public bss data (ie. across all - linked modules, not just per module), so we must take both static - and public bss areas into account to determine the true extent of - the bss area used by Emacs. - - To be strictly correct, we dump the static and public bss areas - used by Emacs separately if non-overlapping (since otherwise we are - dumping bss data belonging to system libraries, eg. the static bss - system data on the Alpha). */ - - bss_start = my_begbss; - bss_size = my_endbss - my_begbss; - bss_section = rva_to_section (PTR_TO_RVA (my_begbss), nt_header); - if (bss_section != rva_to_section (PTR_TO_RVA (my_endbss), nt_header)) - { - printf ("Uninitialized data is not in a single section...bailing\n"); - exit (1); - } - /* Compute how much the .bss section's raw data will grow. */ - extra_bss_size = - ROUND_UP (RVA_TO_SECTION_OFFSET (PTR_TO_RVA (my_endbss), bss_section), - nt_header->OptionalHeader.FileAlignment) - - bss_section->SizeOfRawData; - - bss_start_static = my_begbss_static; - bss_size_static = my_endbss_static - my_begbss_static; - bss_section_static = rva_to_section (PTR_TO_RVA (my_begbss_static), nt_header); - if (bss_section_static != rva_to_section (PTR_TO_RVA (my_endbss_static), nt_header)) - { - printf ("Uninitialized static data is not in a single section...bailing\n"); - exit (1); - } - /* Compute how much the static .bss section's raw data will grow. */ - extra_bss_size_static = - ROUND_UP (RVA_TO_SECTION_OFFSET (PTR_TO_RVA (my_endbss_static), bss_section_static), - nt_header->OptionalHeader.FileAlignment) - - bss_section_static->SizeOfRawData; - - /* Combine the bss sections into one if they overlap. */ -#ifdef _ALPHA_ - overlap = 1; /* force all bss data to be dumped */ -#else - overlap = 0; -#endif - if (bss_start < bss_start_static) - { - if (bss_start_static < bss_start + bss_size) - overlap = 1; - } - else - { - if (bss_start < bss_start_static + bss_size_static) - overlap = 1; - } - if (overlap) - { - if (bss_section != bss_section_static) - { - printf ("BSS data not in a single section...bailing\n"); - exit (1); - } - bss_start = min (bss_start, bss_start_static); - bss_size = max (my_endbss, my_endbss_static) - bss_start; - bss_section_static = 0; - extra_bss_size = max (extra_bss_size, extra_bss_size_static); - extra_bss_size_static = 0; - } -} - -/* Format to print a DWORD_PTR value. */ -#if defined MINGW_W64 && defined _WIN64 -# define pDWP "16llx" -#else -# define pDWP "08lx" -#endif - -/* The dump routines. */ - -void -copy_executable_and_dump_data (file_data *p_infile, - file_data *p_outfile) -{ - unsigned char *dst, *dst_save; - PIMAGE_DOS_HEADER dos_header; - PIMAGE_NT_HEADERS nt_header; - PIMAGE_NT_HEADERS dst_nt_header; - PIMAGE_SECTION_HEADER section; - PIMAGE_SECTION_HEADER dst_section; - DWORD_PTR offset; - int i; - int be_verbose = GetEnvironmentVariable ("DEBUG_DUMP", NULL, 0) > 0; - -#define COPY_CHUNK(message, src, size, verbose) \ - do { \ - unsigned char *s = (void *)(src); \ - DWORD_PTR count = (size); \ - if (verbose) \ - { \ - printf ("%s\n", (message)); \ - printf ("\t0x%"pDWP" Offset in input file.\n", (DWORD_PTR)(s - p_infile->file_base)); \ - printf ("\t0x%"pDWP" Offset in output file.\n", (DWORD_PTR)(dst - p_outfile->file_base)); \ - printf ("\t0x%"pDWP" Size in bytes.\n", count); \ - } \ - memcpy (dst, s, count); \ - dst += count; \ - } while (0) - -#define COPY_PROC_CHUNK(message, src, size, verbose) \ - do { \ - unsigned char *s = (void *)(src); \ - DWORD_PTR count = (size); \ - if (verbose) \ - { \ - printf ("%s\n", (message)); \ - printf ("\t0x%p Address in process.\n", s); \ - printf ("\t0x%p Base output file.\n", p_outfile->file_base); \ - printf ("\t0x%"pDWP" Offset in output file.\n", (DWORD_PTR)(dst - p_outfile->file_base)); \ - printf ("\t0x%p Address in output file.\n", dst); \ - printf ("\t0x%"pDWP" Size in bytes.\n", count); \ - } \ - memcpy (dst, s, count); \ - dst += count; \ - } while (0) - -#define DST_TO_OFFSET() PTR_TO_OFFSET (dst, p_outfile) -#define ROUND_UP_DST(align) \ - (dst = p_outfile->file_base + ROUND_UP (DST_TO_OFFSET (), (align))) -#define ROUND_UP_DST_AND_ZERO(align) \ - do { \ - unsigned char *newdst = p_outfile->file_base \ - + ROUND_UP (DST_TO_OFFSET (), (align)); \ - /* Zero the alignment slop; it may actually initialize real data. */ \ - memset (dst, 0, newdst - dst); \ - dst = newdst; \ - } while (0) - - /* Copy the source image sequentially, ie. section by section after - copying the headers and section table, to simplify the process of - dumping the raw data for the bss and heap sections. - - Note that dst is updated implicitly by each COPY_CHUNK. */ - - dos_header = (PIMAGE_DOS_HEADER) p_infile->file_base; - nt_header = (PIMAGE_NT_HEADERS) (((DWORD_PTR) dos_header) + - dos_header->e_lfanew); - section = IMAGE_FIRST_SECTION (nt_header); - - dst = (unsigned char *) p_outfile->file_base; - - COPY_CHUNK ("Copying DOS header...", dos_header, - (DWORD_PTR) nt_header - (DWORD_PTR) dos_header, be_verbose); - dst_nt_header = (PIMAGE_NT_HEADERS) dst; - COPY_CHUNK ("Copying NT header...", nt_header, - (DWORD_PTR) section - (DWORD_PTR) nt_header, be_verbose); - dst_section = (PIMAGE_SECTION_HEADER) dst; - COPY_CHUNK ("Copying section table...", section, - nt_header->FileHeader.NumberOfSections * sizeof (*section), - be_verbose); - - /* Align the first section's raw data area, and set the header size - field accordingly. */ - ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment); - dst_nt_header->OptionalHeader.SizeOfHeaders = DST_TO_OFFSET (); - - for (i = 0; i < nt_header->FileHeader.NumberOfSections; i++) - { - char msg[100]; - /* Windows section names are fixed 8-char strings, only - zero-terminated if the name is shorter than 8 characters. */ - sprintf (msg, "Copying raw data for %.8s...", section->Name); - - dst_save = dst; - - /* Update the file-relative offset for this section's raw data (if - it has any) in case things have been relocated; we will update - the other offsets below once we know where everything is. */ - if (dst_section->PointerToRawData) - dst_section->PointerToRawData = DST_TO_OFFSET (); - - /* Can always copy the original raw data. */ - COPY_CHUNK - (msg, OFFSET_TO_PTR (section->PointerToRawData, p_infile), - section->SizeOfRawData, be_verbose); - /* Ensure alignment slop is zeroed. */ - ROUND_UP_DST_AND_ZERO (dst_nt_header->OptionalHeader.FileAlignment); - - /* Note that various sections below may be aliases. */ - if (section == data_section) - { - dst = dst_save - + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (data_start), dst_section); - COPY_PROC_CHUNK ("Dumping initialized data...", - data_start, data_size, be_verbose); - dst = dst_save + dst_section->SizeOfRawData; - } - if (section == bss_section) - { - /* Dump contents of bss variables, adjusting the section's raw - data size as necessary. */ - dst = dst_save - + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (bss_start), dst_section); - COPY_PROC_CHUNK ("Dumping bss data...", bss_start, - bss_size, be_verbose); - ROUND_UP_DST (dst_nt_header->OptionalHeader.FileAlignment); - dst_section->PointerToRawData = PTR_TO_OFFSET (dst_save, p_outfile); - /* Determine new size of raw data area. */ - dst = max (dst, dst_save + dst_section->SizeOfRawData); - dst_section->SizeOfRawData = dst - dst_save; - dst_section->Characteristics &= ~IMAGE_SCN_CNT_UNINITIALIZED_DATA; - dst_section->Characteristics |= IMAGE_SCN_CNT_INITIALIZED_DATA; - } - if (section == bss_section_static) - { - /* Dump contents of static bss variables, adjusting the - section's raw data size as necessary. */ - dst = dst_save - + RVA_TO_SECTION_OFFSET (PTR_TO_RVA (bss_start_static), dst_section); - COPY_PROC_CHUNK ("Dumping static bss data...", bss_start_static, - bss_size_static, be_verbose); - ROUND_UP_DST (dst_nt_header->OptionalHeader.FileAlignment); - dst_section->PointerToRawData = PTR_TO_OFFSET (dst_save, p_outfile); - /* Determine new size of raw data area. */ - dst = max (dst, dst_save + dst_section->SizeOfRawData); - dst_section->SizeOfRawData = dst - dst_save; - dst_section->Characteristics &= ~IMAGE_SCN_CNT_UNINITIALIZED_DATA; - dst_section->Characteristics |= IMAGE_SCN_CNT_INITIALIZED_DATA; - } - - /* Align the section's raw data area. */ - ROUND_UP_DST (dst_nt_header->OptionalHeader.FileAlignment); - - section++; - dst_section++; - } - - /* Copy remainder of source image. */ - do - section--; - while (section->PointerToRawData == 0); - offset = ROUND_UP (section->PointerToRawData + section->SizeOfRawData, - nt_header->OptionalHeader.FileAlignment); - COPY_CHUNK - ("Copying remainder of executable...", - OFFSET_TO_PTR (offset, p_infile), - p_infile->size - offset, be_verbose); - - /* Final size for new image. */ - p_outfile->size = DST_TO_OFFSET (); - - /* Now patch up remaining file-relative offsets. */ - section = IMAGE_FIRST_SECTION (nt_header); - dst_section = IMAGE_FIRST_SECTION (dst_nt_header); - -#define ADJUST_OFFSET(var) \ - do { \ - if ((var) != 0) \ - (var) = relocate_offset ((var), nt_header, dst_nt_header); \ - } while (0) - - dst_nt_header->OptionalHeader.SizeOfInitializedData = 0; - dst_nt_header->OptionalHeader.SizeOfUninitializedData = 0; - for (i = 0; i < dst_nt_header->FileHeader.NumberOfSections; i++) - { - /* Recompute data sizes for completeness. */ - if (dst_section[i].Characteristics & IMAGE_SCN_CNT_INITIALIZED_DATA) - dst_nt_header->OptionalHeader.SizeOfInitializedData += - ROUND_UP (dst_section[i].Misc.VirtualSize, dst_nt_header->OptionalHeader.FileAlignment); - else if (dst_section[i].Characteristics & IMAGE_SCN_CNT_UNINITIALIZED_DATA) - dst_nt_header->OptionalHeader.SizeOfUninitializedData += - ROUND_UP (dst_section[i].Misc.VirtualSize, dst_nt_header->OptionalHeader.FileAlignment); - - ADJUST_OFFSET (dst_section[i].PointerToLinenumbers); - } - - ADJUST_OFFSET (dst_nt_header->FileHeader.PointerToSymbolTable); - - /* Update offsets in debug directory entries. */ - { - IMAGE_DATA_DIRECTORY debug_dir = - dst_nt_header->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_DEBUG]; - PIMAGE_DEBUG_DIRECTORY debug_entry; - - section = rva_to_section (debug_dir.VirtualAddress, dst_nt_header); - if (section) - { - debug_entry = (PIMAGE_DEBUG_DIRECTORY) - (RVA_TO_OFFSET (debug_dir.VirtualAddress, section) + p_outfile->file_base); - debug_dir.Size /= sizeof (IMAGE_DEBUG_DIRECTORY); - - for (i = 0; i < debug_dir.Size; i++, debug_entry++) - ADJUST_OFFSET (debug_entry->PointerToRawData); - } - } -} - - -/* Dump out .data and .bss sections into a new executable. */ -void -unexec (const char *new_name, const char *old_name) -{ - file_data in_file, out_file; - char out_filename[MAX_PATH], in_filename[MAX_PATH], new_name_a[MAX_PATH]; - unsigned long size; - char *p; - char *q; - - /* Ignore old_name, and get our actual location from the OS. */ - if (!GetModuleFileNameA (NULL, in_filename, MAX_PATH)) - abort (); - - /* Can't use dostounix_filename here, since that needs its file name - argument encoded in UTF-8. */ - for (p = in_filename; *p; p = CharNextA (p)) - if (*p == '\\') - *p = '/'; - - strcpy (out_filename, in_filename); - filename_to_ansi (new_name, new_name_a); - - /* Change the base of the output filename to match the requested name. */ - if ((p = strrchr (out_filename, '/')) == NULL) - abort (); - /* The filenames have already been expanded, and will be in Unix - format, so it is safe to expect an absolute name. */ - if ((q = strrchr (new_name_a, '/')) == NULL) - abort (); - strcpy (p, q); - -#ifdef ENABLE_CHECKING - report_temacs_memory_usage (); -#endif - - /* Make sure that the output filename has the ".exe" extension...patch - it up if not. */ - p = out_filename + strlen (out_filename) - 4; - if (strcmp (p, ".exe")) - strcat (out_filename, ".exe"); - - printf ("Dumping from %s\n", in_filename); - printf (" to %s\n", out_filename); - - /* Open the undumped executable file. */ - if (!open_input_file (&in_file, in_filename)) - { - printf ("Failed to open %s (%lu)...bailing.\n", - in_filename, GetLastError ()); - exit (1); - } - - /* Get the interesting section info, like start and size of .bss... */ - get_section_info (&in_file); - - /* The size of the dumped executable is the size of the original - executable plus the size of the heap and the size of the .bss section. */ - size = in_file.size + - extra_bss_size + - extra_bss_size_static; - if (!open_output_file (&out_file, out_filename, size)) - { - printf ("Failed to open %s (%lu)...bailing.\n", - out_filename, GetLastError ()); - exit (1); - } - - copy_executable_and_dump_data (&in_file, &out_file); - - /* Patch up header fields; profiler is picky about this. */ - { - PIMAGE_DOS_HEADER dos_header; - PIMAGE_NT_HEADERS nt_header; - HANDLE hImagehelp = LoadLibrary ("imagehlp.dll"); - DWORD headersum; - DWORD checksum; - - dos_header = (PIMAGE_DOS_HEADER) out_file.file_base; - nt_header = (PIMAGE_NT_HEADERS) ((char *) dos_header + dos_header->e_lfanew); - - nt_header->OptionalHeader.CheckSum = 0; - /* nt_header->FileHeader.TimeDateStamp = time (NULL); */ - /* dos_header->e_cp = size / 512; */ - /* nt_header->OptionalHeader.SizeOfImage = size; */ - - pfnCheckSumMappedFile = (void *) GetProcAddress (hImagehelp, "CheckSumMappedFile"); - if (pfnCheckSumMappedFile) - { - /* nt_header->FileHeader.TimeDateStamp = time (NULL); */ - pfnCheckSumMappedFile (out_file.file_base, - out_file.size, - &headersum, - &checksum); - nt_header->OptionalHeader.CheckSum = checksum; - } - FreeLibrary (hImagehelp); - } - - close_file_data (&in_file); - close_file_data (&out_file); -} - -/* eof */ From 15e2b14f03796467fab8e8086d293a5813afaa5b Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 20 Aug 2024 18:31:05 +0000 Subject: [PATCH 02/57] Unexec removal: Main part * configure.ac: Remove unexec-specific parts. (EMACS_CONFIG_FEATURES): Always report that we do not have the UNEXEC feature. (AC_ECHO): No longer display a line about the unexec feature. * lisp/loadup.el: * lisp/startup.el: Remove unexec-specific code. * src/Makefile.in (base_obj): Drop 'UNEXEC_OBJ'. * src/alloc.c (staticvec): Never initialize this variable. (BLOCK_ALIGN): Always allow large blocks. (mmap_lisp_allowed_p): Remove unexec-specific code. * src/buffer.c (init_buffer): * src/conf_post.h (ADDRESS_SANITIZER): * src/emacs.c (load_pdump, main): Remove unexec-specific code. (Fdump_emacs): Remove function. (syms_of_emacs): Remove 'Fdump_emacs'. * src/lastfile.c: Remove unexec-specific code. * src/lisp.h (gflags): Remove unexec-specific flags. (will_dump_p, will_bootstrap_p, will_dump_with_unexec_p) (dumped_with_unexec_p, definitely_will_not_unexec_p): Remove or adjust predicates. (SUBR_SECTION_ATTRIBUTE): Remove unexec-specific definition. * src/pdumper.c (Fdump_emacs_portable): Remove unexec-specific warning. * src/process.c (init_process_emacs): Remove !unexec condition * src/sysdep.c (maybe_disable_address_randomization): Adjust comment. (init_signals): * src/timefns.c (init_timefns): Remove unexec-specific code. * src/w32heap.c (report_temacs_memory_usage): Remove function. * src/w32heap.h: Adjust comment. * src/w32image.c (globals_of_w32image): Remove unexec-specific code. --- configure.ac | 246 +----------------------------------------------- lisp/loadup.el | 6 +- lisp/startup.el | 4 +- src/Makefile.in | 8 +- src/alloc.c | 22 +---- src/buffer.c | 41 -------- src/conf_post.h | 24 ----- src/emacs.c | 169 +-------------------------------- src/lastfile.c | 11 --- src/lisp.h | 65 +------------ src/pdumper.c | 6 -- src/process.c | 67 ++++++------- src/sysdep.c | 10 +- src/timefns.c | 29 ------ src/w32heap.c | 25 ----- src/w32heap.h | 2 +- src/w32image.c | 2 - 17 files changed, 55 insertions(+), 682 deletions(-) diff --git a/configure.ac b/configure.ac index 1c7545ef984..4808c4fa9c1 100644 --- a/configure.ac +++ b/configure.ac @@ -444,28 +444,13 @@ this option's value should be 'yes' or 'no'.]) ;; ], [with_pdumper=auto]) -AC_ARG_WITH([unexec], - AS_HELP_STRING( - [--with-unexec=VALUE], - [enable unexec support unconditionally - ('yes', 'no', or 'auto': default 'auto')]), - [ case "${withval}" in - yes|no|auto) val=$withval ;; - *) AC_MSG_ERROR( - ['--with-unexec=$withval' is invalid; -this option's value should be 'yes' or 'no'.]) ;; - esac - with_unexec=$val - ], - [with_unexec=auto]) - AC_ARG_WITH([dumping],[AS_HELP_STRING([--with-dumping=VALUE], [kind of dumping to use for initial Emacs build -(VALUE one of: pdumper, unexec, none; default pdumper)])], +(VALUE one of: pdumper, none; default pdumper)])], [ case "${withval}" in - pdumper|unexec|none) val=$withval ;; + pdumper|none) val=$withval ;; *) AC_MSG_ERROR(['--with-dumping=$withval is invalid; -this option's value should be 'pdumper', 'unexec', or 'none'.]) +this option's value should be 'pdumper' or 'none'.]) ;; esac with_dumping=$val @@ -480,22 +465,10 @@ if test "$with_pdumper" = "auto"; then fi fi -if test "$with_unexec" = "auto"; then - if test "$with_dumping" = "unexec"; then - with_unexec=yes - else - with_unexec=no - fi -fi - if test "$with_dumping" = "pdumper" && test "$with_pdumper" = "no"; then AC_MSG_ERROR(['--with-dumping=pdumper' requires pdumper support]) fi -if test "$with_dumping" = "unexec" && test "$with_unexec" = "no"; then - AC_MSG_ERROR(['--with-dumping=unexec' requires unexec support]) -fi - if test "$with_pdumper" = "yes"; then AC_DEFINE([HAVE_PDUMPER], [1], [Define to build with portable dumper support]) @@ -2072,10 +2045,6 @@ AC_PATH_PROG([GZIP_PROG], [gzip]) test $with_compress_install != yes && test -n "$GZIP_PROG" && \ GZIP_PROG=" # $GZIP_PROG # (disabled by configure --without-compress-install)" -if test "$with_dumping" = "unexec" && test "$opsys" = "nacl"; then - AC_MSG_ERROR([nacl is not compatible with --with-dumping=unexec]) -fi - AC_CACHE_CHECK([for 'find' args to delete a file], [emacs_cv_find_delete], [if touch conftest.tmp && find conftest.tmp -delete 2>/dev/null && @@ -2088,48 +2057,6 @@ AC_SUBST([FIND_DELETE]) PAXCTL_dumped= PAXCTL_notdumped= -if test $with_unexec = yes && test $opsys = gnu-linux; then - if test "${SETFATTR+set}" != set; then - AC_CACHE_CHECK([for setfattr], - [emacs_cv_prog_setfattr], - [touch conftest.tmp - if (setfattr -n user.pax.flags conftest.tmp) >/dev/null 2>&1; then - emacs_cv_prog_setfattr=yes - else - emacs_cv_prog_setfattr=no - fi]) - if test "$emacs_cv_prog_setfattr" = yes; then - PAXCTL_notdumped='$(SETFATTR) -n user.pax.flags -v er' - SETFATTR=setfattr - else - SETFATTR= - fi - fi - case $opsys,$PAXCTL_notdumped,$emacs_uname_r in - gnu-linux,,* | netbsd,,[0-7].*) - AC_PATH_PROG([PAXCTL], [paxctl], [], - [$PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin]) - if test -n "$PAXCTL"; then - if test "$opsys" = netbsd; then - PAXCTL_dumped='$(PAXCTL) +a' - PAXCTL_notdumped=$PAXCTL_dumped - else - AC_MSG_CHECKING([whether binaries have a PT_PAX_FLAGS header]) - AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], - [if $PAXCTL -v conftest$EXEEXT >/dev/null 2>&1; then - AC_MSG_RESULT([yes]) - else - AC_MSG_RESULT([no]) - PAXCTL= - fi]) - if test -n "$PAXCTL"; then - PAXCTL_dumped='$(PAXCTL) -zex' - PAXCTL_notdumped='$(PAXCTL) -r' - fi - fi - fi;; - esac -fi AC_SUBST([PAXCTL_dumped]) AC_SUBST([PAXCTL_notdumped]) AC_SUBST([SETFATTR]) @@ -2196,37 +2123,6 @@ else ac_link="$ac_link $NON_GCC_LINK_TEST_OPTIONS" fi -dnl On some platforms using GNU ld, linking temacs needs -znocombreloc. -dnl Although this has something to do with dumping, the details are unknown. -dnl If the flag is used but not needed, -dnl Emacs should still work (albeit a bit more slowly), -dnl so use the flag everywhere that it is supported. -dnl When testing whether the flag works, treat GCC specially -dnl since it just gives a non-fatal 'unrecognized option' -dnl if not built to support GNU ld. -if test "$GCC" = yes; then - LDFLAGS_NOCOMBRELOC="-Wl,-znocombreloc" -else - LDFLAGS_NOCOMBRELOC="-znocombreloc" -fi - -AC_CACHE_CHECK([for -znocombreloc], [emacs_cv_znocombreloc], - [if test $with_unexec = no; then - emacs_cv_znocombreloc='not needed' - else - save_LDFLAGS=$LDFLAGS - LDFLAGS="$LDFLAGS $LDFLAGS_NOCOMBRELOC" - AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], - [emacs_cv_znocombreloc=yes], [emacs_cv_znocombreloc=no]) - LDFLAGS=$save_LDFLAGS - fi]) - -case $emacs_cv_znocombreloc in - no*) - LDFLAGS_NOCOMBRELOC= ;; -esac - - AC_CACHE_CHECK([whether addresses are sanitized], [emacs_cv_sanitize_address], [AC_COMPILE_IFELSE( @@ -2242,48 +2138,8 @@ AC_CACHE_CHECK([whether addresses are sanitized], [emacs_cv_sanitize_address=yes], [emacs_cv_sanitize_address=no])]) -if test $with_unexec = yes; then - AC_DEFINE([HAVE_UNEXEC], [1], [Define if Emacs supports unexec.]) - if test "$emacs_cv_sanitize_address" = yes; then - AC_MSG_WARN([[Addresses are sanitized; suggest --without-unexec]]) - fi -fi - - -UNEXEC_OBJ= -test $with_unexec = yes && -case "$opsys" in - # MSDOS uses unexcoff.o - aix4-2) - UNEXEC_OBJ=unexaix.o - ;; - cygwin) - UNEXEC_OBJ=unexcw.o - ;; - darwin) - UNEXEC_OBJ=unexmacosx.o - ;; - hpux10-20 | hpux11) - UNEXEC_OBJ=unexhp9k800.o - ;; - mingw32) - UNEXEC_OBJ=unexw32.o - ;; - solaris) - # Use the Solaris dldump() function, called from unexsol.c, to dump - # emacs, instead of the generic ELF dump code found in unexelf.c. - # The resulting binary has a complete symbol table, and is better - # for debugging and other observability tools (debuggers, pstack, etc). - UNEXEC_OBJ=unexsol.o - ;; - *) - UNEXEC_OBJ=unexelf.o - ;; -esac -AC_SUBST([UNEXEC_OBJ]) - LD_SWITCH_SYSTEM= -test "$with_unexec" = no || case "$opsys" in +case "$opsys" in freebsd|dragonfly) ## Let 'ld' find image libs and similar things in /usr/local/lib. ## The system compiler, GCC, has apparently been modified to not @@ -2331,22 +2187,6 @@ esac C_SWITCH_MACHINE= -test $with_unexec = yes && -case $canonical in - alpha*) - ## With ELF, make sure that all common symbols get allocated to in the - ## data section. Otherwise, the dump of temacs may miss variables in - ## the shared library that have been initialized. For example, with - ## GNU libc, __malloc_initialized would normally be resolved to the - ## shared library's .bss section, which is fatal. - if test "x$GCC" = "xyes"; then - C_SWITCH_MACHINE="-fno-common" - else - AC_MSG_ERROR([Non-GCC compilers are not supported.]) - fi - ;; -esac - AC_CACHE_CHECK([for flags to work around GCC bug 58416], [emacs_cv_gcc_bug_58416_CFLAGS], [emacs_cv_gcc_bug_58416_CFLAGS='none needed' @@ -3379,21 +3219,6 @@ system_malloc=yes dnl This must be before the test of $ac_cv_func_sbrk below. AC_CHECK_FUNCS_ONCE([sbrk]) -test $with_unexec = yes && -case "$opsys" in - ## darwin ld insists on the use of malloc routines in the System framework. - darwin | mingw32 | nacl | solaris) ;; - cygwin | qnxnto | freebsd) - hybrid_malloc=yes - system_malloc= ;; - *) test "$ac_cv_func_sbrk" = yes && system_malloc=$emacs_cv_sanitize_address;; -esac - -if test "${system_malloc}" != yes && test "${doug_lea_malloc}" != yes \ - && test "${UNEXEC_OBJ}" = unexelf.o; then - hybrid_malloc=yes -fi - GMALLOC_OBJ= HYBRID_MALLOC= if test "${system_malloc}" = "yes"; then @@ -5268,15 +5093,9 @@ if test "${with_native_compilation}" = "default"; then # Check if libgccjit really works. AC_RUN_IFELSE([libgccjit_smoke_test], [], [libgccjit_broken]) fi - if test "$with_unexec" = yes; then - with_native_compilation=no - fi fi if test "${with_native_compilation}" != "no"; then - if test "$with_unexec" = yes; then - AC_MSG_ERROR(['--with-native-compilation' is not compatible with unexec]) - fi if test "${HAVE_ZLIB}" = no; then AC_MSG_ERROR(['--with-native-compilation' requires zlib]) fi @@ -6085,19 +5904,6 @@ dnl No need to check for posix_memalign if aligned_alloc works. AC_CHECK_FUNCS([aligned_alloc posix_memalign], [break]) AC_CHECK_DECLS([aligned_alloc], [], [], [[#include ]]) -case $with_unexec,$canonical in - yes,alpha*) - AC_CHECK_DECL([__ELF__], [], - [AC_MSG_ERROR([Non-ELF systems are not supported on this platform.])]);; -esac - -if test "$with_unexec" = yes && test "$opsys" = "haiku"; then - dnl A serious attempt was actually made to port unexec to Haiku. - dnl Something in libstdc++ seems to prevent it from working. - AC_MSG_ERROR([Haiku is not supported by the legacy unexec dumper. -Please use the portable dumper instead.]) -fi - # Dump loading. Android lacks posix_madvise. AC_CHECK_FUNCS([posix_madvise madvise]) @@ -7543,9 +7349,6 @@ case "$opsys" in ## about 14 to about 34. Setting it high gets us plenty of slop and ## only costs about 1.5K of wasted binary space. headerpad_extra=1000 - if test "$with_unexec" = yes; then - LD_SWITCH_SYSTEM_TEMACS="-fno-pie $LD_SWITCH_SYSTEM_TEMACS -Xlinker -headerpad -Xlinker $headerpad_extra" - fi ## This is here because src/Makefile.in did some extra fiddling around ## with LD_SWITCH_SYSTEM. It seems cleaner to put this in @@ -7571,49 +7374,11 @@ case "$opsys" in x86_64-*-*) LD_SWITCH_SYSTEM_TEMACS="-Wl,-stack,0x00800000 -Wl,-heap,0x00100000 -Wl,-image-base,0x400000000 -Wl,-entry,__start -Wl,-Map,./temacs.map" ;; *) LD_SWITCH_SYSTEM_TEMACS="-Wl,-stack,0x00800000 -Wl,-heap,0x00100000 -Wl,-image-base,0x01000000 -Wl,-entry,__start -Wl,-Map,./temacs.map" ;; esac - ## If they want unexec, disable Windows ASLR for the Emacs binary - if test "$with_dumping" = "unexec"; then - case "$canonical" in - x86_64-*-*) LD_SWITCH_SYSTEM_TEMACS="$LD_SWITCH_SYSTEM_TEMACS -Wl,-disable-dynamicbase -Wl,-disable-high-entropy-va -Wl,-default-image-base-low" ;; - *) LD_SWITCH_SYSTEM_TEMACS="$LD_SWITCH_SYSTEM_TEMACS -Wl,-disable-dynamicbase" ;; - esac - fi ;; *) LD_SWITCH_SYSTEM_TEMACS= ;; esac -# -no-pie or -nopie fixes a temacs segfault on Gentoo, OpenBSD, -# Ubuntu, and other systems with "hardened" GCC configurations for -# some reason (Bug#18784). We don't know why this works, but not -# segfaulting is better than segfaulting. Use ac_c_werror_flag=yes -# when trying the option, otherwise clang keeps warning that it does -# not understand it, and pre-4.6 GCC has a similar problem -# (Bug#20338). Prefer -no-pie to -nopie, as -no-pie is the -# spelling used by GCC 6.1.0 and later (Bug#24682). -AC_CACHE_CHECK( - [for $CC option to disable position independent executables], - [emacs_cv_prog_cc_no_pie], - [if test $with_unexec = no; then - emacs_cv_prog_cc_no_pie='not needed' - else - emacs_save_c_werror_flag=$ac_c_werror_flag - emacs_save_LDFLAGS=$LDFLAGS - ac_c_werror_flag=yes - for emacs_cv_prog_cc_no_pie in -no-pie -nopie no; do - test $emacs_cv_prog_cc_no_pie = no && break - LDFLAGS="$emacs_save_LDFLAGS $emacs_cv_prog_cc_no_pie" - AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], [break]) - done - ac_c_werror_flag=$emacs_save_c_werror_flag - LDFLAGS=$emacs_save_LDFLAGS - fi]) -case $emacs_cv_prog_cc_no_pie in - -*) - LD_SWITCH_SYSTEM_TEMACS="$LD_SWITCH_SYSTEM_TEMACS $emacs_cv_prog_cc_no_pie" - ;; -esac - if test x$ac_enable_profiling != x ; then case $opsys in *freebsd | gnu-linux) ;; @@ -7756,7 +7521,7 @@ for opt in ACL BE_APP CAIRO DBUS FREETYPE GCONF GIF GLIB GMP GNUTLS GPM GSETTING case $opt in PDUMPER) val=${with_pdumper} ;; - UNEXEC) val=${with_unexec} ;; + UNEXEC) val=no ;; GLIB) val=${emacs_cv_links_glib} ;; NOTIFY|ACL) eval val=\${${opt}_SUMMARY} ;; TOOLKIT_SCROLL_BARS|X_TOOLKIT) eval val=\${USE_$opt} ;; @@ -7832,7 +7597,6 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D Does Emacs support Xwidgets? ${HAVE_XWIDGETS} Does Emacs have threading support in lisp? ${threads_enabled} Does Emacs support the portable dumper? ${with_pdumper} - Does Emacs support legacy unexec dumping? ${with_unexec} Which dumping strategy does Emacs use? ${with_dumping} Does Emacs have native lisp compiler? ${HAVE_NATIVE_COMP} Does Emacs use version 2 of the X Input Extension? ${HAVE_XINPUT2} diff --git a/lisp/loadup.el b/lisp/loadup.el index 613833c4184..8307152a2fa 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -57,7 +57,7 @@ ;; Add subdirectories to the load-path for files that might get ;; autoloaded when bootstrapping or running Emacs normally. ;; This is because PATH_DUMPLOADSEARCH is just "../lisp". -(if (or (member dump-mode '("bootstrap" "pbootstrap")) +(if (or (member dump-mode '("pbootstrap")) ;; FIXME this is irritatingly fragile. (and (stringp (nth 4 command-line-args)) (string-match "^unidata-gen\\(\\.elc?\\)?$" @@ -635,8 +635,6 @@ directory got moved. This is set to be a pair in the form of: (error nil)))))) (if dump-mode (let ((output (cond ((equal dump-mode "pdump") "emacs.pdmp") - ((equal dump-mode "dump") "emacs") - ((equal dump-mode "bootstrap") "emacs") ((equal dump-mode "pbootstrap") "bootstrap-emacs.pdmp") (t (error "Unrecognized dump mode %s" dump-mode))))) (when (and (featurep 'native-compile) @@ -680,7 +678,7 @@ directory got moved. This is set to be a pair in the form of: (eq system-type 'android)) ;; Don't bother adding another name if we're just ;; building bootstrap-emacs. - (member dump-mode '("pbootstrap" "bootstrap")))) + (member dump-mode '("pbootstrap")))) (let ((name (format "emacs-%s.%d" emacs-version emacs-build-number)) (exe (if (eq system-type 'windows-nt) ".exe" ""))) (while (string-match "[^-+_.a-zA-Z0-9]+" name) diff --git a/lisp/startup.el b/lisp/startup.el index 3436409a35e..e9618dc9f6a 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1104,7 +1104,7 @@ init-file, or to a default value if loading is not possible." ;; Else, perhaps the user init file was compiled (when (and (equal (file-name-extension user-init-file) "eln") ;; The next test is for builds without native - ;; compilation support or builds with unexec. + ;; compilation support. (boundp 'comp-eln-to-el-h)) (if-let* ((source (gethash (file-name-nondirectory user-init-file) @@ -2523,7 +2523,7 @@ A fancy display is used on graphic displays, normal otherwise." (defalias 'about-emacs #'display-about-screen) (defalias 'display-splash-screen #'display-startup-screen) -;; This avoids byte-compiler warning in the unexec build. +;; This avoids byte-compiler warning in non-pdumper builds. (declare-function pdumper-stats "pdumper.c" ()) (defun command-line-1 (args-left) diff --git a/src/Makefile.in b/src/Makefile.in index c278924ef94..c35fb3a1bc4 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -386,8 +386,6 @@ RUN_TEMACS = ./temacs # Whether builds should contain details. '--no-build-details' or empty. BUILD_DETAILS = @BUILD_DETAILS@ -UNEXEC_OBJ = @UNEXEC_OBJ@ - HAIKU_OBJ = @HAIKU_OBJ@ HAIKU_CXX_OBJ = @HAIKU_CXX_OBJ@ HAIKU_LIBS = @HAIKU_LIBS@ @@ -471,9 +469,9 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ cmds.o casetab.o casefiddle.o indent.o search.o regex-emacs.o undo.o \ alloc.o pdumper.o data.o doc.o editfns.o callint.o \ eval.o floatfns.o fns.o sort.o font.o print.o lread.o $(MODULES_OBJ) \ - syntax.o $(UNEXEC_OBJ) bytecode.o comp.o $(DYNLIB_OBJ) \ - process.o gnutls.o callproc.o \ - region-cache.o sound.o timefns.o atimer.o \ + syntax.o bytecode.o comp.o $(DYNLIB_OBJ) \ + process.o gnutls.o callproc.o \ + region-cache.o sound.o timefns.o atimer.o \ doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \ $(XWIDGETS_OBJ) \ profiler.o decompress.o \ diff --git a/src/alloc.c b/src/alloc.c index 4fab0d54248..eb2e9fae783 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -266,7 +266,7 @@ voidfuncptr __MALLOC_HOOK_VOLATILE __malloc_initialize_hook EXTERNALLY_VISIBLE #endif -#if defined DOUG_LEA_MALLOC || defined HAVE_UNEXEC +#if defined DOUG_LEA_MALLOC /* Allocator-related actions to do just before and after unexec. */ @@ -570,15 +570,9 @@ static void mem_delete (struct mem_node *); static void mem_delete_fixup (struct mem_node *); static struct mem_node *mem_find (void *); -/* Addresses of staticpro'd variables. Initialize it to a nonzero - value if we might unexec; otherwise some compilers put it into - BSS. */ +/* Addresses of staticpro'd variables. */ -Lisp_Object const *staticvec[NSTATICS] -#ifdef HAVE_UNEXEC -= {&Vpurify_flag} -#endif - ; +Lisp_Object const *staticvec[NSTATICS]; /* Index of next unused slot in staticvec. */ @@ -631,10 +625,8 @@ mmap_lisp_allowed_p (void) { /* If we can't store all memory addresses in our lisp objects, it's risky to let the heap use mmap and give us addresses from all - over our address space. We also can't use mmap for lisp objects - if we might dump: unexec doesn't preserve the contents of mmapped - regions. */ - return pointers_fit_in_lispobj_p () && !will_dump_with_unexec_p (); + over our address space. */ + return pointers_fit_in_lispobj_p (); } #endif @@ -1071,11 +1063,7 @@ lisp_free (void *block) BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */ /* Byte alignment of storage blocks. */ -#ifdef HAVE_UNEXEC -# define BLOCK_ALIGN (1 << 10) -#else /* !HAVE_UNEXEC */ # define BLOCK_ALIGN (1 << 15) -#endif static_assert (POWER_OF_2 (BLOCK_ALIGN)); /* Use aligned_alloc if it or a simple substitute is available. diff --git a/src/buffer.c b/src/buffer.c index 2955ee6399b..663a47ec72f 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -4892,47 +4892,6 @@ init_buffer (void) { Lisp_Object temp; -#ifdef USE_MMAP_FOR_BUFFERS - if (dumped_with_unexec_p ()) - { - Lisp_Object tail, buffer; - -#ifndef WINDOWSNT - /* These must be reset in the dumped Emacs, to avoid stale - references to mmap'ed memory from before the dump. - - WINDOWSNT doesn't need this because it doesn't track mmap'ed - regions by hand (see w32heap.c, which uses system APIs for - that purpose), and thus doesn't use mmap_regions. */ - mmap_regions = NULL; - mmap_fd = -1; -#endif - - /* The dumped buffers reference addresses of buffer text - recorded by temacs, that cannot be used by the dumped Emacs. - We map new memory for their text here. - - Implementation notes: the buffers we carry from temacs are: - " prin1", "*scratch*", " *Minibuf-0*", "*Messages*", and - " *code-conversion-work*". They are created by - init_buffer_once and init_window_once (which are not called - in the dumped Emacs), and by the first call to coding.c - routines. Since FOR_EACH_LIVE_BUFFER only walks the buffers - in Vbuffer_alist, any buffer we carry from temacs that is - not in the alist (a.k.a. "magic invisible buffers") should - be handled here explicitly. */ - FOR_EACH_LIVE_BUFFER (tail, buffer) - { - struct buffer *b = XBUFFER (buffer); - b->text->beg = NULL; - enlarge_buffer_text (b, 0); - } - /* The " prin1" buffer is not in Vbuffer_alist. */ - XBUFFER (Vprin1_to_string_buffer)->text->beg = NULL; - enlarge_buffer_text (XBUFFER (Vprin1_to_string_buffer), 0); - } -#endif /* USE_MMAP_FOR_BUFFERS */ - AUTO_STRING (scratch, "*scratch*"); Fset_buffer (Fget_buffer_create (scratch, Qnil)); if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters))) diff --git a/src/conf_post.h b/src/conf_post.h index f2353803074..8d523c62eee 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -93,30 +93,6 @@ typedef bool bool_bf; # define ADDRESS_SANITIZER false #endif -#ifdef emacs -/* We include stdlib.h here, because Gnulib's stdlib.h might redirect - 'free' to its replacement, and we want to avoid that in unexec - builds. Including it here will render its inclusion after config.h - a no-op. */ -# if (defined DARWIN_OS && defined HAVE_UNEXEC) || defined HYBRID_MALLOC -# include -# endif -#endif - -#if defined DARWIN_OS && defined emacs && defined HAVE_UNEXEC -# undef malloc -# define malloc unexec_malloc -# undef realloc -# define realloc unexec_realloc -# undef free -# define free unexec_free - -extern void *unexec_malloc (size_t); -extern void *unexec_realloc (void *, size_t); -extern void unexec_free (void *); - -#endif - /* If HYBRID_MALLOC is defined (e.g., on Cygwin), emacs will use gmalloc before dumping and the system malloc after dumping. hybrid_malloc and friends, defined in gmalloc.c, are wrappers that diff --git a/src/emacs.c b/src/emacs.c index bdd9eee10c4..4e6f286d888 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -196,11 +196,6 @@ bool running_asynch_code; bool display_arg; #endif -#if defined GNU_LINUX && defined HAVE_UNEXEC -/* The gap between BSS end and heap start as far as we can tell. */ -static uintmax_t heap_bss_diff; -#endif - /* To run as a background daemon under Cocoa or Windows, we must do a fork+exec, not a simple fork. @@ -912,14 +907,6 @@ load_pdump (int argc, char **argv, char *dump_file) #endif ; - /* TODO: maybe more thoroughly scrub process environment in order to - make this use case (loading a dump file in an unexeced emacs) - possible? Right now, we assume that things we don't touch are - zero-initialized, and in an unexeced Emacs, this assumption - doesn't hold. */ - if (initialized) - fatal ("cannot load dump file in unexeced Emacs"); - /* Look for an explicitly-specified dump file. */ const char *path_exec = PATH_EXEC; dump_file = NULL; @@ -1318,53 +1305,34 @@ main (int argc, char **argv) #endif /* Look for this argument first, before any heap allocation, so we - can set heap flags properly if we're going to unexec. */ + can set heap flags properly if we're going to dump. */ if (!initialized && temacs) { -#ifdef HAVE_UNEXEC - if (strcmp (temacs, "dump") == 0 || - strcmp (temacs, "bootstrap") == 0) - gflags.will_dump_with_unexec_ = true; -#endif #ifdef HAVE_PDUMPER if (strcmp (temacs, "pdump") == 0 || strcmp (temacs, "pbootstrap") == 0) gflags.will_dump_with_pdumper_ = true; -#endif -#if defined HAVE_PDUMPER || defined HAVE_UNEXEC if (strcmp (temacs, "bootstrap") == 0 || strcmp (temacs, "pbootstrap") == 0) gflags.will_bootstrap_ = true; gflags.will_dump_ = - will_dump_with_pdumper_p () || - will_dump_with_unexec_p (); + will_dump_with_pdumper_p (); if (will_dump_p ()) dump_mode = temacs; #endif if (!dump_mode) fatal ("Invalid temacs mode '%s'", temacs); } - else if (temacs) - { - fatal ("--temacs not supported for unexeced emacs"); - } else { eassert (!temacs); -#ifndef HAVE_UNEXEC eassert (!initialized); -#endif #ifdef HAVE_PDUMPER if (!initialized) attempt_load_pdump = true; #endif } -#ifdef HAVE_UNEXEC - if (!will_dump_with_unexec_p ()) - gflags.will_not_unexec_ = true; -#endif - #ifdef WINDOWSNT /* Grab our malloc arena space now, before anything important happens. This relies on the static heap being needed only in @@ -1427,25 +1395,12 @@ main (int argc, char **argv) argc = maybe_disable_address_randomization (argc, argv); -#if defined GNU_LINUX && defined HAVE_UNEXEC - if (!initialized) - { - char *heap_start = my_heap_start (); - heap_bss_diff = heap_start - max (my_endbss, my_endbss_static); - } -#endif #ifdef RUN_TIME_REMAP if (initialized) run_time_remap (argv[0]); #endif -/* If using unexmacosx.c (set by s/darwin.h), we must do this. */ -#if defined DARWIN_OS && defined HAVE_UNEXEC - if (!initialized) - unexec_init_emacs_zone (); -#endif - init_standard_fds (); atexit (close_output_streams); @@ -1627,10 +1582,7 @@ main (int argc, char **argv) #endif /* MSDOS */ /* Set locale, so that initial error messages are localized properly. - However, skip this if LC_ALL is "C", as it's not needed in that case. - Skipping helps if dumping with unexec, to ensure that the dumped - Emacs does not have its system locale tables initialized, as that - might cause screwups when the dumped Emacs starts up. */ + However, skip this if LC_ALL is "C", as it's not needed in that case. */ char *lc_all = getenv ("LC_ALL"); if (! (lc_all && strcmp (lc_all, "C") == 0)) { @@ -3155,117 +3107,6 @@ shut_down_emacs (int sig, Lisp_Object stuff) } - -#ifdef HAVE_UNEXEC - -#include "unexec.h" - -DEFUN ("dump-emacs", Fdump_emacs, Sdump_emacs, 2, 2, 0, - doc: /* Dump current state of Emacs into executable file FILENAME. -Take symbols from SYMFILE (presumably the file you executed to run Emacs). -This is used in the file `loadup.el' when building Emacs. - -You must run Emacs in batch mode in order to dump it. */) - (Lisp_Object filename, Lisp_Object symfile) -{ - Lisp_Object tem; - Lisp_Object symbol; - specpdl_ref count = SPECPDL_INDEX (); - - check_pure_size (); - - if (! noninteractive) - error ("Dumping Emacs works only in batch mode"); - - if (dumped_with_unexec_p ()) - error ("Emacs can be dumped using unexec only once"); - - if (definitely_will_not_unexec_p ()) - error ("This Emacs instance was not started in temacs mode"); - -# if defined GNU_LINUX && defined HAVE_UNEXEC - - /* Warn if the gap between BSS end and heap start is larger than this. */ -# define MAX_HEAP_BSS_DIFF (1024 * 1024) - - if (heap_bss_diff > MAX_HEAP_BSS_DIFF) - fprintf (stderr, - ("**************************************************\n" - "Warning: Your system has a gap between BSS and the\n" - "heap (%"PRIuMAX" bytes). This usually means that exec-shield\n" - "or something similar is in effect. The dump may\n" - "fail because of this. See the section about\n" - "exec-shield in etc/PROBLEMS for more information.\n" - "**************************************************\n"), - heap_bss_diff); -# endif - - /* Bind `command-line-processed' to nil before dumping, - so that the dumped Emacs will process its command line - and set up to work with X windows if appropriate. */ - symbol = Qcommand_line_processed; - specbind (symbol, Qnil); - - CHECK_STRING (filename); - filename = Fexpand_file_name (filename, Qnil); - filename = ENCODE_FILE (filename); - if (!NILP (symfile)) - { - CHECK_STRING (symfile); - if (SCHARS (symfile)) - { - symfile = Fexpand_file_name (symfile, Qnil); - symfile = ENCODE_FILE (symfile); - } - } - - tem = Vpurify_flag; - Vpurify_flag = Qnil; - -# ifdef HYBRID_MALLOC - { - static char const fmt[] = "%d of %d static heap bytes used"; - char buf[sizeof fmt + 2 * (INT_STRLEN_BOUND (int) - 2)]; - int max_usage = max_bss_sbrk_ptr - bss_sbrk_buffer; - sprintf (buf, fmt, max_usage, STATIC_HEAP_SIZE); - /* Don't log messages, because at this point buffers cannot be created. */ - message1_nolog (buf); - } -# endif - - fflush (stdout); - /* Tell malloc where start of impure now is. */ - /* Also arrange for warnings when nearly out of space. */ -# if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC && !defined WINDOWSNT - /* On Windows, this was done before dumping, and that once suffices. - Meanwhile, my_edata is not valid on Windows. */ - memory_warnings (my_edata, malloc_warning); -# endif - - struct gflags old_gflags = gflags; - gflags.will_dump_ = false; - gflags.will_dump_with_unexec_ = false; - gflags.dumped_with_unexec_ = true; - - alloc_unexec_pre (); - - unexec (SSDATA (filename), !NILP (symfile) ? SSDATA (symfile) : 0); - - alloc_unexec_post (); - - gflags = old_gflags; - -# ifdef WINDOWSNT - Vlibrary_cache = Qnil; -# endif - - Vpurify_flag = tem; - - return unbind_to (count, Qnil); -} - -#endif - /* Recover from setlocale (LC_ALL, ""). */ void @@ -3565,10 +3406,6 @@ syms_of_emacs (void) DEFSYM (Qcommand_line_processed, "command-line-processed"); DEFSYM (Qsafe_magic, "safe-magic"); -#ifdef HAVE_UNEXEC - defsubr (&Sdump_emacs); -#endif - defsubr (&Skill_emacs); defsubr (&Sinvocation_name); diff --git a/src/lastfile.c b/src/lastfile.c index 48d3ac78634..c6baad4ac01 100644 --- a/src/lastfile.c +++ b/src/lastfile.c @@ -42,14 +42,3 @@ along with GNU Emacs. If not, see . */ || defined WINDOWSNT || defined CYGWIN || defined DARWIN_OS) char my_edata[] = "End of Emacs initialized data"; #endif - -#ifdef HAVE_UNEXEC - -/* Help unexec locate the end of the .bss area used by Emacs (which - isn't always a separate section in NT executables). */ -char my_endbss[1]; - -static char _my_endbss[1]; -char * my_endbss_static = _my_endbss; - -#endif diff --git a/src/lisp.h b/src/lisp.h index 832a1755c04..a7b84b25b81 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -640,20 +640,12 @@ extern struct gflags dump. */ bool dumped_with_pdumper_ : 1; #endif -#ifdef HAVE_UNEXEC - bool will_dump_with_unexec_ : 1; - /* Set in an Emacs process that has been restored from an unexec - dump. */ - bool dumped_with_unexec_ : 1; - /* We promise not to unexec: useful for hybrid malloc. */ - bool will_not_unexec_ : 1; -#endif } gflags; INLINE bool will_dump_p (void) { -#if HAVE_PDUMPER || defined HAVE_UNEXEC +#if HAVE_PDUMPER return gflags.will_dump_; #else return false; @@ -663,7 +655,7 @@ will_dump_p (void) INLINE bool will_bootstrap_p (void) { -#if HAVE_PDUMPER || defined HAVE_UNEXEC +#if HAVE_PDUMPER return gflags.will_bootstrap_; #else return false; @@ -690,39 +682,6 @@ dumped_with_pdumper_p (void) #endif } -INLINE bool -will_dump_with_unexec_p (void) -{ -#ifdef HAVE_UNEXEC - return gflags.will_dump_with_unexec_; -#else - return false; -#endif -} - -INLINE bool -dumped_with_unexec_p (void) -{ -#ifdef HAVE_UNEXEC - return gflags.dumped_with_unexec_; -#else - return false; -#endif -} - -/* This function is the opposite of will_dump_with_unexec_p(), except - that it returns false before main runs. It's important to use - gmalloc for any pre-main allocations if we're going to unexec. */ -INLINE bool -definitely_will_not_unexec_p (void) -{ -#ifdef HAVE_UNEXEC - return gflags.will_not_unexec_; -#else - return true; -#endif -} - /* Defined in floatfns.c. */ extern double extract_float (Lisp_Object); @@ -3443,14 +3402,10 @@ CHECK_SUBR (Lisp_Object x) /* If we're not dumping using the legacy dumper and we might be using the portable dumper, try to bunch all the subr structures together for more efficient dump loading. */ -#ifndef HAVE_UNEXEC -# ifdef DARWIN_OS -# define SUBR_SECTION_ATTRIBUTE ATTRIBUTE_SECTION ("__DATA,subrs") -# else -# define SUBR_SECTION_ATTRIBUTE ATTRIBUTE_SECTION (".subrs") -# endif +#ifdef DARWIN_OS +# define SUBR_SECTION_ATTRIBUTE ATTRIBUTE_SECTION ("__DATA,subrs") #else -# define SUBR_SECTION_ATTRIBUTE +# define SUBR_SECTION_ATTRIBUTE ATTRIBUTE_SECTION (".subrs") #endif /* Define a built-in function for calling from Lisp. @@ -4492,8 +4447,6 @@ extern void mark_objects (Lisp_Object *, ptrdiff_t); #if defined REL_ALLOC && !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC extern void refill_memory_reserve (void); #endif -extern void alloc_unexec_pre (void); -extern void alloc_unexec_post (void); extern void mark_c_stack (char const *, char const *); extern void flush_stack_call_func1 (void (*func) (void *arg), void *arg); extern void mark_memory (void const *start, void const *end); @@ -4927,14 +4880,6 @@ void do_debug_on_call (Lisp_Object code, specpdl_ref count); Lisp_Object funcall_general (Lisp_Object fun, ptrdiff_t numargs, Lisp_Object *args); -/* Defined in unexmacosx.c. */ -#if defined DARWIN_OS && defined HAVE_UNEXEC -extern void unexec_init_emacs_zone (void); -extern void *unexec_malloc (size_t); -extern void *unexec_realloc (void *, size_t); -extern void unexec_free (void *); -#endif - /* The definition of Lisp_Module_Function depends on emacs-module.h, so we don't define it here. It's defined in emacs-module.c. */ diff --git a/src/pdumper.c b/src/pdumper.c index c8baa311854..88e8e810adc 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -4143,12 +4143,6 @@ types. */) "contributing a patch to Emacs."); #endif - if (will_dump_with_unexec_p ()) - error ("This Emacs instance was started under the assumption " - "that it would be dumped with unexec, not the portable " - "dumper. Dumping with the portable dumper may produce " - "unexpected results."); - if (!main_thread_p (current_thread)) error ("This function can be called only in the main thread"); diff --git a/src/process.c b/src/process.c index b71ba3daf2d..dcf08fd9b57 100644 --- a/src/process.c +++ b/src/process.c @@ -8620,50 +8620,39 @@ init_process_emacs (int sockfd) inhibit_sentinels = 0; -#ifdef HAVE_UNEXEC - /* Clear child_signal_read_fd and child_signal_write_fd after dumping, - lest wait_reading_process_output should select on nonexistent file - descriptors which existed in the build process. */ - child_signal_read_fd = -1; - child_signal_write_fd = -1; -#endif /* HAVE_UNEXEC */ - - if (!will_dump_with_unexec_p ()) - { #if defined HAVE_GLIB && !defined WINDOWSNT - /* Tickle Glib's child-handling code. Ask Glib to install a - watch source for Emacs itself which will initialize glib's - private SIGCHLD handler, allowing catch_child_signal to copy - it into lib_child_handler. This is a hacky workaround to get - glib's g_unix_signal_handler into lib_child_handler. + /* Tickle Glib's child-handling code. Ask Glib to install a + watch source for Emacs itself which will initialize glib's + private SIGCHLD handler, allowing catch_child_signal to copy + it into lib_child_handler. This is a hacky workaround to get + glib's g_unix_signal_handler into lib_child_handler. - In Glib 2.37.5 (2013), commit 2e471acf changed Glib to - always install a signal handler when g_child_watch_source_new - is called and not just the first time it's called, and to - reset signal handlers to SIG_DFL when it no longer has a - watcher on that signal. Arrange for Emacs's signal handler - to be reinstalled even if this happens. + In Glib 2.37.5 (2013), commit 2e471acf changed Glib to + always install a signal handler when g_child_watch_source_new + is called and not just the first time it's called, and to + reset signal handlers to SIG_DFL when it no longer has a + watcher on that signal. Arrange for Emacs's signal handler + to be reinstalled even if this happens. - In Glib 2.73.2 (2022), commit f615eef4 changed Glib again, - to not install a signal handler if the system supports - pidfd_open and waitid (as in Linux kernel 5.3+). The hacky - workaround is not needed in this case. */ - GSource *source = g_child_watch_source_new (getpid ()); + In Glib 2.73.2 (2022), commit f615eef4 changed Glib again, + to not install a signal handler if the system supports + pidfd_open and waitid (as in Linux kernel 5.3+). The hacky + workaround is not needed in this case. */ + GSource *source = g_child_watch_source_new (getpid ()); + catch_child_signal (); + g_source_unref (source); + + if (lib_child_handler != dummy_handler) + { + /* The hacky workaround is needed on this platform. */ + signal_handler_t lib_child_handler_glib = lib_child_handler; catch_child_signal (); - g_source_unref (source); - - if (lib_child_handler != dummy_handler) - { - /* The hacky workaround is needed on this platform. */ - signal_handler_t lib_child_handler_glib = lib_child_handler; - catch_child_signal (); - eassert (lib_child_handler == dummy_handler); - lib_child_handler = lib_child_handler_glib; - } -#else - catch_child_signal (); -#endif + eassert (lib_child_handler == dummy_handler); + lib_child_handler = lib_child_handler_glib; } +#else + catch_child_signal (); +#endif #ifdef HAVE_SETRLIMIT /* Don't allocate more than FD_SETSIZE file descriptors for Emacs itself. */ diff --git a/src/sysdep.c b/src/sysdep.c index bb4892af4af..e0ec74d8364 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -165,9 +165,7 @@ maybe_disable_address_randomization (int argc, char **argv) if (argc < 2 || strcmp (argv[1], aslr_disabled_option) != 0) { - /* If dumping via unexec, ASLR must be disabled, as otherwise - data may be scattered and undumpable as a simple executable. - If pdumping, disabling ASLR lessens differences in the .pdmp file. */ + /* If pdumping, disabling ASLR lessens differences in the .pdmp file. */ bool disable_aslr = will_dump_p (); # ifdef __PPC64__ disable_aslr = true; @@ -2036,12 +2034,6 @@ init_signals (void) main_thread_id = pthread_self (); #endif - /* Don't alter signal handlers if dumping with unexec. On some - machines, changing signal handlers sets static data that would make - signals fail to work right when the dumped Emacs is run. */ - if (will_dump_with_unexec_p ()) - return; - sigfillset (&process_fatal_action.sa_mask); process_fatal_action.sa_handler = deliver_fatal_signal; process_fatal_action.sa_flags = emacs_sigaction_flags (); diff --git a/src/timefns.c b/src/timefns.c index f16a34d651b..520a48f2b9b 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -318,37 +318,8 @@ tzlookup (Lisp_Object zone, bool settz) void init_timefns (void) { -#ifdef HAVE_UNEXEC - /* A valid but unlikely setting for the TZ environment variable. - It is OK (though a bit slower) if the user chooses this value. */ - static char dump_tz_string[] = "TZ=UtC0"; - - /* When just dumping out, set the time zone to a known unlikely value - and skip the rest of this function. */ - if (will_dump_with_unexec_p ()) - { - xputenv (dump_tz_string); - tzset (); - return; - } -#endif - char *tz = getenv ("TZ"); -#ifdef HAVE_UNEXEC - /* If the execution TZ happens to be the same as the dump TZ, - change it to some other value and then change it back, - to force the underlying implementation to reload the TZ info. - This is needed on implementations that load TZ info from files, - since the TZ file contents may differ between dump and execution. */ - if (tz && strcmp (tz, &dump_tz_string[tzeqlen]) == 0) - { - ++*tz; - tzset (); - --*tz; - } -#endif - /* Set the time zone rule now, so that the call to putenv is done before multiple threads are active. */ tzlookup (tz ? build_string (tz) : Qwall, true); diff --git a/src/w32heap.c b/src/w32heap.c index 601686f5331..c5777622c56 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -617,31 +617,6 @@ sys_calloc (size_t number, size_t size) return ptr; } -#if defined HAVE_UNEXEC && defined ENABLE_CHECKING -void -report_temacs_memory_usage (void) -{ - DWORD blocks_used = 0; - size_t large_mem_used = 0; - int i; - - for (i = 0; i < blocks_number; i++) - if (blocks[i].occupied) - { - blocks_used++; - large_mem_used += blocks[i].size; - } - - /* Emulate 'message', which writes to stderr in non-interactive - sessions. */ - fprintf (stderr, - "Dump memory usage: Heap: %" PRIu64 " Large blocks(%lu/%lu): %" PRIu64 "/%" PRIu64 "\n", - (unsigned long long)committed, blocks_used, blocks_number, - (unsigned long long)large_mem_used, - (unsigned long long)(dumped_data + DUMPED_HEAP_SIZE - bc_limit)); -} -#endif - /* Emulate getpagesize. */ int getpagesize (void) diff --git a/src/w32heap.h b/src/w32heap.h index 24b02fabbfc..901c9b5a41e 100644 --- a/src/w32heap.h +++ b/src/w32heap.h @@ -1,4 +1,4 @@ -/* Heap management routines (including unexec) for GNU Emacs on Windows NT. +/* Heap management routines for GNU Emacs on Windows NT. Copyright (C) 1994, 2001-2024 Free Software Foundation, Inc. This file is part of GNU Emacs. diff --git a/src/w32image.c b/src/w32image.c index da4d6843ba9..02700338715 100644 --- a/src/w32image.c +++ b/src/w32image.c @@ -634,6 +634,4 @@ syms_of_w32image (void) void globals_of_w32image (void) { - /* This is only needed in an unexec build. */ - memset (&last_encoder, 0, sizeof last_encoder); } From b2bc337a5f8d84978029873ce8e51b8d3d53121a Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 20 Aug 2024 18:40:29 +0000 Subject: [PATCH 03/57] Unexec removal: Remove HYBRID_MALLOC support * src/gmalloc.c (gdefault_morecore): Remove HYBRID_MALLOC code. (allocated_via_gmalloc, hybrid_malloc, hybrid_calloc, hybrid_free_1) (hybrid_free, hybrid_aligned_alloc, hybrid_realloc): Remove functions. * msdos/sed1v2.inp: * msdos/sedlibmk.inp: * src/alloc.c (GC_MALLOC_CHECK, USE_ALIGNED_ALLOC) (refill_memory_reserve, aligned_alloc): * src/emacs.c (main): * src/lastfile.c (my_edata): * src/lisp.h: * src/ralloc.c: * src/sysdep.c (get_current_dir_name_or_unreachable): * src/xdisp.c (decode_mode_spec): Remove HYBRID_MALLOC conditions. * configure.ac (hybrid_malloc, HYBRID_MALLOC): Remove variables and dependent code. * src/conf_post.h (hybrid_malloc, hybrid_calloc, hybrid_free) (hybrid_aligned_alloc, hybrid_realloc): Remove conditional prototypes. * src/Makefile.in (HYBRID_MALLOC): Remove variable. (base_obj): Remove sheap.o (LIBEGNU_ARCHIVE): * lib/Makefile.in (libgnu_a_OBJECTS): Remove libegnu.a support. --- configure.ac | 16 +---- lib/Makefile.in | 10 +-- msdos/sed1v2.inp | 1 - msdos/sedlibmk.inp | 1 - src/Makefile.in | 5 +- src/alloc.c | 28 +++----- src/conf_post.h | 25 ------- src/emacs.c | 7 +- src/gmalloc.c | 167 +++------------------------------------------ src/lastfile.c | 2 +- src/lisp.h | 4 +- src/ralloc.c | 6 +- src/sysdep.c | 4 -- src/xdisp.c | 2 +- 14 files changed, 35 insertions(+), 243 deletions(-) diff --git a/configure.ac b/configure.ac index 4808c4fa9c1..425e9cc4663 100644 --- a/configure.ac +++ b/configure.ac @@ -3213,14 +3213,12 @@ AC_CACHE_CHECK( fi]) doug_lea_malloc=$emacs_cv_var_doug_lea_malloc -hybrid_malloc= system_malloc=yes dnl This must be before the test of $ac_cv_func_sbrk below. AC_CHECK_FUNCS_ONCE([sbrk]) GMALLOC_OBJ= -HYBRID_MALLOC= if test "${system_malloc}" = "yes"; then AC_DEFINE([SYSTEM_MALLOC], [1], [Define to 1 to use the system memory allocator, even if it is not @@ -3229,14 +3227,6 @@ if test "${system_malloc}" = "yes"; then GNU_MALLOC_reason=" (The GNU allocators don't work with this system configuration.)" VMLIMIT_OBJ= -elif test "$hybrid_malloc" = yes; then - AC_DEFINE([HYBRID_MALLOC], [1], - [Define to use gmalloc before dumping and the system malloc after.]) - HYBRID_MALLOC=1 - GNU_MALLOC=no - GNU_MALLOC_reason=" (only before dumping)" - GMALLOC_OBJ=gmalloc.o - VMLIMIT_OBJ= else test "$doug_lea_malloc" != "yes" && GMALLOC_OBJ=gmalloc.o VMLIMIT_OBJ=vm-limit.o @@ -3255,11 +3245,10 @@ else of the main data segment.]) fi fi -AC_SUBST([HYBRID_MALLOC]) AC_SUBST([GMALLOC_OBJ]) AC_SUBST([VMLIMIT_OBJ]) -if test "$doug_lea_malloc" = "yes" && test "$hybrid_malloc" != yes; then +if test "$doug_lea_malloc" = "yes"; then if test "$GNU_MALLOC" = yes ; then GNU_MALLOC_reason=" (Using Doug Lea's new malloc from the GNU C Library.)" @@ -3321,8 +3310,7 @@ if test "$ac_cv_header_pthread_h" && test "$opsys" != "mingw32"; then status += pthread_create (&th, 0, 0, 0); status += pthread_sigmask (SIG_BLOCK, &new_mask, &old_mask); status += pthread_kill (th, 0); - #if ! (defined SYSTEM_MALLOC || defined HYBRID_MALLOC \ - || defined DOUG_LEA_MALLOC) + #if ! (defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC) /* Test for pthread_atfork only if gmalloc uses it, as older-style hosts like MirBSD 10 lack it. */ status += pthread_atfork (noop, noop, noop); diff --git a/lib/Makefile.in b/lib/Makefile.in index a87b7b1f31b..e3d42bd68f5 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in @@ -94,9 +94,8 @@ not_emacs_OBJECTS = regex.o malloc/%.o free.o libgnu_a_OBJECTS = fingerprint.o $(gl_LIBOBJS) \ $(patsubst %.c,%.o,$(filter %.c,$(libgnu_a_SOURCES))) for_emacs_OBJECTS = $(filter-out $(not_emacs_OBJECTS),$(libgnu_a_OBJECTS)) -libegnu_a_OBJECTS = $(patsubst %.o,e-%.o,$(for_emacs_OBJECTS)) -$(libegnu_a_OBJECTS) $(libgnu_a_OBJECTS): $(BUILT_SOURCES) +$(libgnu_a_OBJECTS): $(BUILT_SOURCES) .SUFFIXES: .c .c.o: @@ -104,18 +103,13 @@ $(libegnu_a_OBJECTS) $(libgnu_a_OBJECTS): $(BUILT_SOURCES) e-%.o: %.c $(AM_V_CC)$(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) -Demacs -o $@ $< -all: libgnu.a $(if $(HYBRID_MALLOC),libegnu.a) +all: libgnu.a libgnu.a: $(libgnu_a_OBJECTS) $(AM_V_AR)rm -f $@ $(AM_V_at)$(AR) $(ARFLAGS) $@ $(libgnu_a_OBJECTS) $(AM_V_at)$(RANLIB) $@ -libegnu.a: $(libegnu_a_OBJECTS) - $(AM_V_AR)rm -f $@ - $(AM_V_at)$(AR) $(ARFLAGS) $@ $(libegnu_a_OBJECTS) - $(AM_V_at)$(RANLIB) $@ - ETAGS = ../lib-src/etags$(EXEEXT) $(ETAGS): $(MAKE) -C $(dir $@) $(notdir $@) diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index da056067548..a84cee32927 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -163,7 +163,6 @@ s/ *@WEBP_LIBS@// /^XRANDR_CFLAGS *=/s/@XRANDR_CFLAGS@// /^XINERAMA_LIBS *=/s/@XINERAMA_LIBS@// /^XINERAMA_CFLAGS *=/s/@XINERAMA_CFLAGS@// -/^HYBRID_MALLOC *=/s/@HYBRID_MALLOC@// /^GMALLOC_OBJ *=/s/@GMALLOC_OBJ@/gmalloc.o/ /^VMLIMIT_OBJ *=/s/@VMLIMIT_OBJ@/vm-limit.o/ /^FIRSTFILE_OBJ *=/s/@FIRSTFILE_OBJ@// diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp index 624983798c4..7fb71fcf21a 100644 --- a/msdos/sedlibmk.inp +++ b/msdos/sedlibmk.inp @@ -153,7 +153,6 @@ s/@PACKAGE@/emacs/ /^C_SWITCH_X_SITE *=/s/@C_SWITCH_X_SITE@// /^PROFILING_CFLAGS *=/s/@PROFILING_CFLAGS@// /^GNULIB_WARN_CFLAGS *=/s/@GNULIB_WARN_CFLAGS@// -/^HYBRID_MALLOC *=/s/@HYBRID_MALLOC@// /^WARN_CFLAGS *=/s/@WARN_CFLAGS@// /^WERROR_CFLAGS *=/s/@WERROR_CFLAGS@// /^ANDROID_BUILD_CFLAGS *=/s/@ANDROID_BUILD_CFLAGS@// diff --git a/src/Makefile.in b/src/Makefile.in index c35fb3a1bc4..03c2c8d6e0a 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -306,8 +306,6 @@ XSHAPE_CFLAGS = @XSHAPE_CFLAGS@ ## widget.o if USE_X_TOOLKIT, otherwise empty. WIDGET_OBJ=@WIDGET_OBJ@ -HYBRID_MALLOC = @HYBRID_MALLOC@ - ## cygw32.o if CYGWIN, otherwise empty. CYGWIN_OBJ=@CYGWIN_OBJ@ @@ -477,7 +475,6 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ profiler.o decompress.o \ thread.o systhread.o sqlite.o treesit.o \ itree.o json.o \ - $(if $(HYBRID_MALLOC),sheap.o) \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \ $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) \ $(HAIKU_OBJ) $(PGTK_OBJ) $(ANDROID_OBJ) @@ -718,7 +715,7 @@ globals.h: gl-stamp; @true $(ALLOBJS): globals.h -LIBEGNU_ARCHIVE = $(lib)/lib$(if $(HYBRID_MALLOC),e)gnu.a +LIBEGNU_ARCHIVE = $(lib)/libgnu.a $(LIBEGNU_ARCHIVE): $(config_h) $(MAKE) -C $(dir $@) all diff --git a/src/alloc.c b/src/alloc.c index eb2e9fae783..642cccc97c6 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -127,7 +127,7 @@ along with GNU Emacs. If not, see . */ marked objects. */ #if (defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC \ - || defined HYBRID_MALLOC || GC_CHECK_MARKED_OBJECTS) + || GC_CHECK_MARKED_OBJECTS) #undef GC_MALLOC_CHECK #endif @@ -460,7 +460,7 @@ static void gc_sweep (void); static Lisp_Object make_pure_vector (ptrdiff_t); static void mark_buffer (struct buffer *); -#if !defined REL_ALLOC || defined SYSTEM_MALLOC || defined HYBRID_MALLOC +#if !defined REL_ALLOC || defined SYSTEM_MALLOC static void refill_memory_reserve (void); #endif static void compact_small_strings (void); @@ -644,7 +644,7 @@ struct Lisp_Finalizer doomed_finalizers; Malloc ************************************************************************/ -#if defined SIGDANGER || (!defined SYSTEM_MALLOC && !defined HYBRID_MALLOC) +#if defined SIGDANGER || (!defined SYSTEM_MALLOC) /* Function malloc calls this if it finds we are near exhausting storage. */ @@ -1066,19 +1066,14 @@ lisp_free (void *block) # define BLOCK_ALIGN (1 << 15) static_assert (POWER_OF_2 (BLOCK_ALIGN)); -/* Use aligned_alloc if it or a simple substitute is available. - Aligned allocation is incompatible with unexmacosx.c, so don't use - it on Darwin if HAVE_UNEXEC. */ +/* Use aligned_alloc if it or a simple substitute is available. */ -#if ! (defined DARWIN_OS && defined HAVE_UNEXEC) -# if (defined HAVE_ALIGNED_ALLOC \ - || (defined HYBRID_MALLOC \ - ? defined HAVE_POSIX_MEMALIGN \ - : !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC)) -# define USE_ALIGNED_ALLOC 1 -# elif !defined HYBRID_MALLOC && defined HAVE_POSIX_MEMALIGN -# define USE_ALIGNED_ALLOC 1 -# define aligned_alloc my_aligned_alloc /* Avoid collision with lisp.h. */ +#if (defined HAVE_ALIGNED_ALLOC \ + || (!defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC)) +# define USE_ALIGNED_ALLOC 1 +#elif defined HAVE_POSIX_MEMALIGN +# define USE_ALIGNED_ALLOC 1 +# define aligned_alloc my_aligned_alloc /* Avoid collision with lisp.h. */ static void * aligned_alloc (size_t alignment, size_t size) { @@ -1095,7 +1090,6 @@ aligned_alloc (size_t alignment, size_t size) void *p; return posix_memalign (&p, alignment, size) == 0 ? p : 0; } -# endif #endif /* Padding to leave at the end of a malloc'd block. This is to give @@ -4433,7 +4427,7 @@ memory_full (size_t nbytes) void refill_memory_reserve (void) { -#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC +#if !defined SYSTEM_MALLOC if (spare_memory[0] == 0) spare_memory[0] = malloc (SPARE_MEMORY); if (spare_memory[1] == 0) diff --git a/src/conf_post.h b/src/conf_post.h index 8d523c62eee..94d9342f154 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -93,31 +93,6 @@ typedef bool bool_bf; # define ADDRESS_SANITIZER false #endif -/* If HYBRID_MALLOC is defined (e.g., on Cygwin), emacs will use - gmalloc before dumping and the system malloc after dumping. - hybrid_malloc and friends, defined in gmalloc.c, are wrappers that - accomplish this. */ -#ifdef HYBRID_MALLOC -#ifdef emacs -#undef malloc -#define malloc hybrid_malloc -#undef realloc -#define realloc hybrid_realloc -#undef aligned_alloc -#define aligned_alloc hybrid_aligned_alloc -#undef calloc -#define calloc hybrid_calloc -#undef free -#define free hybrid_free - -extern void *hybrid_malloc (size_t); -extern void *hybrid_calloc (size_t, size_t); -extern void hybrid_free (void *); -extern void *hybrid_aligned_alloc (size_t, size_t); -extern void *hybrid_realloc (void *, size_t); -#endif /* emacs */ -#endif /* HYBRID_MALLOC */ - /* We have to go this route, rather than the old hpux9 approach of renaming the functions via macros. The system's stdlib.h has fully prototyped declarations, which yields a conflicting definition of diff --git a/src/emacs.c b/src/emacs.c index 4e6f286d888..8e606604d6b 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -110,7 +110,6 @@ along with GNU Emacs. If not, see . */ #include "composite.h" #include "dispextern.h" #include "regex-emacs.h" -#include "sheap.h" #include "syntax.h" #include "sysselect.h" #include "systime.h" @@ -1565,7 +1564,7 @@ main (int argc, char **argv) emacs_backtrace (-1); -#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC +#if !defined SYSTEM_MALLOC /* Arrange to get warning messages as memory fills up. */ memory_warnings (0, malloc_warning); @@ -1573,7 +1572,7 @@ main (int argc, char **argv) Also call realloc and free for consistency. */ free (realloc (malloc (4), 4)); -#endif /* not SYSTEM_MALLOC and not HYBRID_MALLOC */ +#endif /* not SYSTEM_MALLOC */ #ifdef MSDOS set_binary_mode (STDIN_FILENO, O_BINARY); @@ -1879,7 +1878,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem } #if defined HAVE_PTHREAD && !defined SYSTEM_MALLOC \ - && !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC + && !defined DOUG_LEA_MALLOC /* Do not make gmalloc thread-safe when creating bootstrap-emacs, as that causes an infinite recursive loop with FreeBSD. See Bug#14569. The part of this bug involving Cygwin is no longer diff --git a/src/gmalloc.c b/src/gmalloc.c index 1faf6506167..8377cb7bf94 100644 --- a/src/gmalloc.c +++ b/src/gmalloc.c @@ -21,7 +21,7 @@ License along with this library. If not, see . #include -#if defined HAVE_PTHREAD && !defined HYBRID_MALLOC +#if defined HAVE_PTHREAD #define USE_PTHREAD #endif @@ -57,13 +57,6 @@ extern void *(*__morecore) (ptrdiff_t); extern void (*__MALLOC_HOOK_VOLATILE __malloc_initialize_hook) (void); #endif /* !defined HAVE_MALLOC_H || glibc >= 2.24 */ -/* If HYBRID_MALLOC is defined, then temacs will use malloc, - realloc... as defined in this file (and renamed gmalloc, - grealloc... via the macros that follow). The dumped emacs, - however, will use the system malloc, realloc.... In other source - files, malloc, realloc... are renamed hybrid_malloc, - hybrid_realloc... via macros in conf_post.h. hybrid_malloc and - friends are wrapper functions defined later in this file. */ #undef malloc #undef realloc #undef calloc @@ -76,19 +69,11 @@ extern void (*__MALLOC_HOOK_VOLATILE __malloc_initialize_hook) (void); #define free gfree #define malloc_info gmalloc_info -#ifdef HYBRID_MALLOC -# include "sheap.h" -#endif - #ifdef __cplusplus extern "C" { #endif -#ifdef HYBRID_MALLOC -#define extern static -#endif - /* Allocate SIZE bytes of memory. */ extern void *malloc (size_t size) ATTRIBUTE_MALLOC_SIZE ((1)); /* Re-allocate the previously allocated block @@ -326,8 +311,6 @@ void (*__MALLOC_HOOK_VOLATILE __malloc_initialize_hook) (void); void (*__MALLOC_HOOK_VOLATILE __after_morecore_hook) (void); void *(*__morecore) (ptrdiff_t); -#ifndef HYBRID_MALLOC - /* Pointer to the base of the first block. */ char *_heapbase; @@ -349,11 +332,9 @@ size_t _bytes_free; /* Are you experienced? */ int __malloc_initialized; -#endif /* HYBRID_MALLOC */ - /* Number of extra blocks to get each time we ask for more core. This reduces the frequency of calling `(*__morecore)'. */ -#if defined DOUG_LEA_MALLOC || defined HYBRID_MALLOC || defined SYSTEM_MALLOC +#if defined DOUG_LEA_MALLOC || defined SYSTEM_MALLOC static #endif size_t __malloc_extra_blocks; @@ -916,7 +897,7 @@ malloc (size_t size) return (hook ? hook : _malloc_internal) (size); } -#if !(defined (_LIBC) || defined (HYBRID_MALLOC)) +#if !(defined (_LIBC)) /* On some ANSI C systems, some libc functions call _malloc, _free and _realloc. Make them use the GNU functions. */ @@ -967,11 +948,8 @@ License along with this library. If not, see . /* Debugging hook for free. */ static void (*__MALLOC_HOOK_VOLATILE gfree_hook) (void *); -#ifndef HYBRID_MALLOC - /* List of blocks allocated by aligned_alloc. */ struct alignlist *_aligned_blocks = NULL; -#endif /* Return memory to the heap. Like `_free_internal' but don't lock mutex. */ @@ -1242,7 +1220,6 @@ free (void *ptr) _free_internal (ptr); } -#ifndef HYBRID_MALLOC /* Define the `cfree' alias for `free'. */ #ifdef weak_alias weak_alias (free, cfree) @@ -1253,7 +1230,6 @@ cfree (void *ptr) free (ptr); } #endif -#endif /* Change the size of a block allocated by `malloc'. Copyright 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Written May 1989 by Mike Haertel. @@ -1496,12 +1472,6 @@ extern void *__sbrk (ptrdiff_t increment); static void * gdefault_morecore (ptrdiff_t increment) { -#ifdef HYBRID_MALLOC - if (!definitely_will_not_unexec_p ()) - { - return bss_sbrk (increment); - } -#endif #ifdef HAVE_SBRK void *result = (void *) __sbrk (increment); if (result != (void *) -1) @@ -1611,7 +1581,6 @@ aligned_alloc (size_t alignment, size_t size) } /* Note that memalign and posix_memalign are not used in Emacs. */ -#ifndef HYBRID_MALLOC /* An obsolete alias for aligned_alloc, for any old libraries that use this alias. */ @@ -1621,8 +1590,6 @@ memalign (size_t alignment, size_t size) return aligned_alloc (alignment, size); } -/* If HYBRID_MALLOC is defined, we may want to use the system - posix_memalign below. */ int posix_memalign (void **memptr, size_t alignment, size_t size) { @@ -1641,7 +1608,6 @@ posix_memalign (void **memptr, size_t alignment, size_t size) return 0; } -#endif /* Allocate memory on a page boundary. Copyright (C) 1991, 92, 93, 94, 96 Free Software Foundation, Inc. @@ -1662,18 +1628,16 @@ License along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ -#ifndef HYBRID_MALLOC - -# ifndef HAVE_MALLOC_H +#ifndef HAVE_MALLOC_H /* Allocate SIZE bytes on a page boundary. */ extern void *valloc (size_t); -# endif +#endif -# if defined _SC_PAGESIZE || !defined HAVE_GETPAGESIZE -# include "getpagesize.h" -# elif !defined getpagesize +#if defined _SC_PAGESIZE || !defined HAVE_GETPAGESIZE +# include "getpagesize.h" +#elif !defined getpagesize extern int getpagesize (void); -# endif +#endif static size_t pagesize; @@ -1685,7 +1649,6 @@ valloc (size_t size) return aligned_alloc (pagesize, size); } -#endif /* HYBRID_MALLOC */ #undef malloc #undef realloc @@ -1693,116 +1656,6 @@ valloc (size_t size) #undef aligned_alloc #undef free -#ifdef HYBRID_MALLOC - -/* Assuming PTR was allocated via the hybrid malloc, return true if - PTR was allocated via gmalloc, not the system malloc. Also, return - true if _heaplimit is zero; this can happen temporarily when - gmalloc calls itself for internal use, and in that case PTR is - already known to be allocated via gmalloc. */ - -static bool -allocated_via_gmalloc (void *ptr) -{ - if (!__malloc_initialized) - return false; - size_t block = BLOCK (ptr); - size_t blockmax = _heaplimit - 1; - return block <= blockmax && _heapinfo[block].busy.type != 0; -} - -/* See the comments near the beginning of this file for explanations - of the following functions. */ - -void * -hybrid_malloc (size_t size) -{ - if (definitely_will_not_unexec_p ()) - return malloc (size); - return gmalloc (size); -} - -void * -hybrid_calloc (size_t nmemb, size_t size) -{ - if (definitely_will_not_unexec_p ()) - return calloc (nmemb, size); - return gcalloc (nmemb, size); -} - -static void -hybrid_free_1 (void *ptr) -{ - if (allocated_via_gmalloc (ptr)) - gfree (ptr); - else - free (ptr); -} - -void -hybrid_free (void *ptr) -{ - /* Stolen from Gnulib, to make sure we preserve errno. */ -#if defined __GNUC__ && !defined __clang__ - int err[2]; - err[0] = errno; - err[1] = errno; - errno = 0; - hybrid_free_1 (ptr); - errno = err[errno == 0]; -#else - int err = errno; - hybrid_free_1 (ptr); - errno = err; -#endif -} - -#if defined HAVE_ALIGNED_ALLOC || defined HAVE_POSIX_MEMALIGN -void * -hybrid_aligned_alloc (size_t alignment, size_t size) -{ - if (!definitely_will_not_unexec_p ()) - return galigned_alloc (alignment, size); - /* The following is copied from alloc.c */ -#ifdef HAVE_ALIGNED_ALLOC - return aligned_alloc (alignment, size); -#else /* HAVE_POSIX_MEMALIGN */ - void *p; - return posix_memalign (&p, alignment, size) == 0 ? p : 0; -#endif -} -#endif - -void * -hybrid_realloc (void *ptr, size_t size) -{ - void *result; - int type; - size_t block, oldsize; - - if (!ptr) - return hybrid_malloc (size); - if (!allocated_via_gmalloc (ptr)) - return realloc (ptr, size); - if (!definitely_will_not_unexec_p ()) - return grealloc (ptr, size); - - /* The dumped emacs is trying to realloc storage allocated before - dumping via gmalloc. Allocate new space and copy the data. Do - not bother with gfree (ptr), as that would just waste time. */ - block = BLOCK (ptr); - type = _heapinfo[block].busy.type; - oldsize = - type < 0 ? _heapinfo[block].busy.info.size * BLOCKSIZE - : (size_t) 1 << type; - result = malloc (size); - if (result) - return memcpy (result, ptr, min (oldsize, size)); - return result; -} - -#else /* ! HYBRID_MALLOC */ - void * malloc (size_t size) { @@ -1833,8 +1686,6 @@ realloc (void *ptr, size_t size) return grealloc (ptr, size); } -#endif /* HYBRID_MALLOC */ - #ifdef GC_MCHECK /* Standard debugging hooks for `malloc'. diff --git a/src/lastfile.c b/src/lastfile.c index c6baad4ac01..9f2b2a04958 100644 --- a/src/lastfile.c +++ b/src/lastfile.c @@ -38,7 +38,7 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" -#if ((!defined SYSTEM_MALLOC && !defined HYBRID_MALLOC) \ +#if (!defined SYSTEM_MALLOC \ || defined WINDOWSNT || defined CYGWIN || defined DARWIN_OS) char my_edata[] = "End of Emacs initialized data"; #endif diff --git a/src/lisp.h b/src/lisp.h index a7b84b25b81..f795cf72da2 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4444,7 +4444,7 @@ extern AVOID buffer_memory_full (ptrdiff_t); extern bool survives_gc_p (Lisp_Object); extern void mark_object (Lisp_Object); extern void mark_objects (Lisp_Object *, ptrdiff_t); -#if defined REL_ALLOC && !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC +#if defined REL_ALLOC && !defined SYSTEM_MALLOC extern void refill_memory_reserve (void); #endif extern void mark_c_stack (char const *, char const *); @@ -4687,7 +4687,7 @@ void *hash_table_alloc_bytes (ptrdiff_t nbytes) ATTRIBUTE_MALLOC_SIZE ((1)); void hash_table_free_bytes (void *p, ptrdiff_t nbytes); /* Defined in gmalloc.c. */ -#if !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC && !defined SYSTEM_MALLOC +#if !defined DOUG_LEA_MALLOC && !defined SYSTEM_MALLOC extern size_t __malloc_extra_blocks; #endif #if !HAVE_DECL_ALIGNED_ALLOC diff --git a/src/ralloc.c b/src/ralloc.c index 5724ae65d33..f7688561662 100644 --- a/src/ralloc.c +++ b/src/ralloc.c @@ -1162,7 +1162,7 @@ r_alloc_init (void) r_alloc_initialized = 1; page_size = PAGE; -#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC +#if !defined SYSTEM_MALLOC real_morecore = __morecore; __morecore = r_alloc_sbrk; @@ -1181,7 +1181,7 @@ r_alloc_init (void) mallopt (M_TOP_PAD, 64 * 4096); unblock_input (); #else -#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC +#if !defined SYSTEM_MALLOC /* Give GNU malloc's morecore some hysteresis so that we move all the relocatable blocks much less often. The number used to be 64, but alloc.c would override that with 32 in code that was @@ -1194,7 +1194,7 @@ r_alloc_init (void) #endif #endif -#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC +#if !defined SYSTEM_MALLOC first_heap->end = (void *) PAGE_ROUNDUP (first_heap->start); /* The extra call to real_morecore guarantees that the end of the diff --git a/src/sysdep.c b/src/sysdep.c index e0ec74d8364..93e3e1bd5bf 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -287,11 +287,7 @@ get_current_dir_name_or_unreachable (void) #endif # if HAVE_GET_CURRENT_DIR_NAME && !BROKEN_GET_CURRENT_DIR_NAME -# ifdef HYBRID_MALLOC - bool use_libc = will_dump_with_unexec_p (); -# else bool use_libc = true; -# endif if (use_libc) { /* For an unreachable directory, this returns a string that starts diff --git a/src/xdisp.c b/src/xdisp.c index 7b0e2644078..d5ec3e404d0 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -28751,7 +28751,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, } case 'e': -#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC +#if !defined SYSTEM_MALLOC { if (NILP (Vmemory_full)) return ""; From aab5a2fe4c4164019b8b5bf09cce835b2aa8549c Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 20 Aug 2024 18:48:42 +0000 Subject: [PATCH 04/57] Unexec removal: Adjust and simplify W32-specific code * src/emacs.c (main): Unconditionally call 'init_heap' without an argument. Adjust comment. * src/w32heap.c (dumped_data, DUMPED_HEAP_SIZE): Remove definitions. (heap): Remove variable. (dumped_data_commit): Remove function. (init_heap): Drop unexec-specific code. --- src/emacs.c | 25 +------ src/w32heap.c | 197 ++++++++++---------------------------------------- 2 files changed, 41 insertions(+), 181 deletions(-) diff --git a/src/emacs.c b/src/emacs.c index 8e606604d6b..eba103bd807 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1334,26 +1334,8 @@ main (int argc, char **argv) #ifdef WINDOWSNT /* Grab our malloc arena space now, before anything important - happens. This relies on the static heap being needed only in - temacs and only if we are going to dump with unexec. */ - bool use_dynamic_heap = true; - if (temacs) - { - char *temacs_str = NULL, *p; - for (p = argv[0]; (p = strstr (p, "temacs")) != NULL; p++) - temacs_str = p; - if (temacs_str != NULL - && (temacs_str == argv[0] || IS_DIRECTORY_SEP (temacs_str[-1]))) - { - /* Note that gflags are set at this point only if we have been - called with the --temacs=METHOD option. We assume here that - temacs is always called that way, otherwise the functions - that rely on gflags, like will_dump_with_pdumper_p below, - will not do their job. */ - use_dynamic_heap = will_dump_with_pdumper_p (); - } - } - init_heap (use_dynamic_heap); + happens. */ + init_heap (); initial_cmdline = GetCommandLine (); #endif #if defined WINDOWSNT || defined HAVE_NTGUI @@ -1881,8 +1863,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem && !defined DOUG_LEA_MALLOC /* Do not make gmalloc thread-safe when creating bootstrap-emacs, as that causes an infinite recursive loop with FreeBSD. See - Bug#14569. The part of this bug involving Cygwin is no longer - relevant, now that Cygwin defines HYBRID_MALLOC. */ + Bug#14569. */ if (!noninteractive || !will_dump_p ()) malloc_enable_thread (); #endif diff --git a/src/w32heap.c b/src/w32heap.c index c5777622c56..f850fe1cf19 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -28,15 +28,6 @@ Memory allocation scheme for w32/w64: - Buffers are mmap'ed using a very simple emulation of mmap/munmap - - During the temacs phase, if unexec is to be used: - * we use a private heap declared to be stored into the `dumped_data' - * unfortunately, this heap cannot be made growable, so the size of - blocks it can allocate is limited to (0x80000 - pagesize) - * the blocks that are larger than this are allocated from the end - of the `dumped_data' array; there are not so many of them. - We use a very simple first-fit scheme to reuse those blocks. - * we check that the private heap does not cross the area used - by the bigger chunks. - During the emacs phase, or always if pdumper is used: * we create a private heap for new memory blocks * we make sure that we never free a block that has been dumped. @@ -95,40 +86,6 @@ typedef struct _RTL_HEAP_PARAMETERS { SIZE_T Reserved[ 2 ]; } RTL_HEAP_PARAMETERS, *PRTL_HEAP_PARAMETERS; -/* We reserve space for dumping emacs lisp byte-code inside a static - array. By storing it in an array, the generic mechanism in - unexecw32.c will be able to dump it without the need to add a - special segment to the executable. In order to be able to do this - without losing too much space, we need to create a Windows heap at - the specific address of the static array. The RtlCreateHeap - available inside the NT kernel since XP will do this. It allows the - creation of a non-growable heap at a specific address. So before - dumping, we create a non-growable heap at the address of the - dumped_data[] array. After dumping, we reuse memory allocated - there without being able to free it (but most of it is not meant to - be freed anyway), and we use a new private heap for all new - allocations. */ - -/* FIXME: Most of the space reserved for dumped_data[] is only used by - the 1st bootstrap-emacs.exe built while bootstrapping. Once the - preloaded Lisp files are byte-compiled, the next loadup uses less - than half of the size stated below. It would be nice to find a way - to build only the first bootstrap-emacs.exe with the large size, - and reset that to a lower value afterwards. */ -#ifndef HAVE_UNEXEC -/* We don't use dumped_data[], so define to a small size that won't - matter. */ -# define DUMPED_HEAP_SIZE 10 -#else -# if defined _WIN64 || defined WIDE_EMACS_INT -# define DUMPED_HEAP_SIZE (28*1024*1024) -# else -# define DUMPED_HEAP_SIZE (24*1024*1024) -# endif -#endif - -static unsigned char dumped_data[DUMPED_HEAP_SIZE]; - /* Info for keeping track of our dynamic heap used after dumping. */ unsigned char *data_region_base = NULL; unsigned char *data_region_end = NULL; @@ -178,12 +135,6 @@ static struct static DWORD blocks_number = 0; static unsigned char *bc_limit; -/* Handle for the private heap: - - inside the dumped_data[] array before dump with unexec, - - outside of it after dump, or always if pdumper is used. -*/ -HANDLE heap = NULL; - /* We redirect the standard allocation functions. */ malloc_fn the_malloc_fn; realloc_fn the_realloc_fn; @@ -213,30 +164,6 @@ heap_realloc (void *ptr, size_t size) It would be if the memory was shared. https://stackoverflow.com/questions/307060/what-is-the-purpose-of-allocating-pages-in-the-pagefile-with-createfilemapping */ -/* This is the function to commit memory when the heap allocator - claims for new memory. Before dumping with unexec, we allocate - space from the fixed size dumped_data[] array. -*/ -static NTSTATUS NTAPI -dumped_data_commit (PVOID Base, PVOID *CommitAddress, PSIZE_T CommitSize) -{ - /* This is used before dumping. - - The private heap is stored at dumped_data[] address. - We commit contiguous areas of the dumped_data array - as requests arrive. */ - *CommitAddress = data_region_base + committed; - committed += *CommitSize; - /* Check that the private heap area does not overlap the big chunks area. */ - if (((unsigned char *)(*CommitAddress)) + *CommitSize >= bc_limit) - { - fprintf (stderr, - "dumped_data_commit: memory exhausted.\nEnlarge dumped_data[]!\n"); - exit (-1); - } - return 0; -} - /* Heap creation. */ /* We want to turn on Low Fragmentation Heap for XP and older systems. @@ -250,99 +177,51 @@ typedef WINBASEAPI BOOL (WINAPI * HeapSetInformation_Proc)(HANDLE,HEAP_INFORMATI #endif void -init_heap (bool use_dynamic_heap) +init_heap (void) { - /* FIXME: Remove the condition, the 'else' branch below, and all the - related definitions and code, including dumped_data[], when unexec - support is removed from Emacs. */ - if (use_dynamic_heap) - { - /* After dumping, use a new private heap. We explicitly enable - the low fragmentation heap (LFH) here, for the sake of pre - Vista versions. Note: this will harmlessly fail on Vista and - later, where the low-fragmentation heap is enabled by - default. It will also fail on pre-Vista versions when Emacs - is run under a debugger; set _NO_DEBUG_HEAP=1 in the - environment before starting GDB to get low fragmentation heap - on XP and older systems, for the price of losing "certain - heap debug options"; for the details see - https://msdn.microsoft.com/en-us/library/windows/desktop/aa366705%28v=vs.85%29.aspx. */ - data_region_end = data_region_base; + /* After dumping, use a new private heap. We explicitly enable + the low fragmentation heap (LFH) here, for the sake of pre + Vista versions. Note: this will harmlessly fail on Vista and + later, where the low-fragmentation heap is enabled by + default. It will also fail on pre-Vista versions when Emacs + is run under a debugger; set _NO_DEBUG_HEAP=1 in the + environment before starting GDB to get low fragmentation heap + on XP and older systems, for the price of losing "certain + heap debug options"; for the details see + https://msdn.microsoft.com/en-us/library/windows/desktop/aa366705%28v=vs.85%29.aspx. */ + data_region_end = data_region_base; - /* Create the private heap. */ - heap = HeapCreate (0, 0, 0); + /* Create the private heap. */ + heap = HeapCreate (0, 0, 0); #ifndef MINGW_W64 - unsigned long enable_lfh = 2; - /* Set the low-fragmentation heap for OS before Vista. */ - HMODULE hm_kernel32dll = LoadLibrary ("kernel32.dll"); - HeapSetInformation_Proc s_pfn_Heap_Set_Information = - (HeapSetInformation_Proc) get_proc_addr (hm_kernel32dll, - "HeapSetInformation"); - if (s_pfn_Heap_Set_Information != NULL) - { - if (s_pfn_Heap_Set_Information ((PVOID) heap, - HeapCompatibilityInformation, - &enable_lfh, sizeof(enable_lfh)) == 0) - DebPrint (("Enabling Low Fragmentation Heap failed: error %ld\n", - GetLastError ())); - } + unsigned long enable_lfh = 2; + /* Set the low-fragmentation heap for OS before Vista. */ + HMODULE hm_kernel32dll = LoadLibrary ("kernel32.dll"); + HeapSetInformation_Proc s_pfn_Heap_Set_Information = + (HeapSetInformation_Proc) get_proc_addr (hm_kernel32dll, + "HeapSetInformation"); + if (s_pfn_Heap_Set_Information != NULL) + { + if (s_pfn_Heap_Set_Information ((PVOID) heap, + HeapCompatibilityInformation, + &enable_lfh, sizeof(enable_lfh)) == 0) + DebPrint (("Enabling Low Fragmentation Heap failed: error %ld\n", + GetLastError ())); + } #endif - if (os_subtype == OS_SUBTYPE_9X) - { - the_malloc_fn = malloc_after_dump_9x; - the_realloc_fn = realloc_after_dump_9x; - the_free_fn = free_after_dump_9x; - } - else - { - the_malloc_fn = malloc_after_dump; - the_realloc_fn = realloc_after_dump; - the_free_fn = free_after_dump; - } - } - else /* Before dumping with unexec: use static heap. */ + if (os_subtype == OS_SUBTYPE_9X) { - /* Find the RtlCreateHeap function. Headers for this function - are provided with the w32 DDK, but the function is available - in ntdll.dll since XP. */ - HMODULE hm_ntdll = LoadLibrary ("ntdll.dll"); - RtlCreateHeap_Proc s_pfn_Rtl_Create_Heap - = (RtlCreateHeap_Proc) get_proc_addr (hm_ntdll, "RtlCreateHeap"); - /* Specific parameters for the private heap. */ - RTL_HEAP_PARAMETERS params; - ZeroMemory (¶ms, sizeof(params)); - params.Length = sizeof(RTL_HEAP_PARAMETERS); - - data_region_base = (unsigned char *)ROUND_UP (dumped_data, 0x1000); - data_region_end = bc_limit = dumped_data + DUMPED_HEAP_SIZE; - - params.InitialCommit = committed = 0x1000; - params.InitialReserve = sizeof(dumped_data); - /* Use our own routine to commit memory from the dumped_data - array. */ - params.CommitRoutine = &dumped_data_commit; - - /* Create the private heap. */ - if (s_pfn_Rtl_Create_Heap == NULL) - { - fprintf (stderr, "Cannot build Emacs without RtlCreateHeap being available; exiting.\n"); - exit (-1); - } - heap = s_pfn_Rtl_Create_Heap (0, data_region_base, 0, 0, NULL, ¶ms); - - if (os_subtype == OS_SUBTYPE_9X) - { - fprintf (stderr, "Cannot dump Emacs on Windows 9X; exiting.\n"); - exit (-1); - } - else - { - the_malloc_fn = malloc_before_dump; - the_realloc_fn = realloc_before_dump; - the_free_fn = free_before_dump; - } + the_malloc_fn = malloc_after_dump_9x; + the_realloc_fn = realloc_after_dump_9x; + the_free_fn = free_after_dump_9x; + } + else + { + the_malloc_fn = malloc_after_dump; + the_realloc_fn = realloc_after_dump; + the_free_fn = free_after_dump; } /* Update system version information to match current system. */ From d359858b5d02e60c1d46c26750e5510c2606916a Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 20 Aug 2024 18:52:04 +0000 Subject: [PATCH 05/57] Pure storage removal: Delete puresize.h * puresize.h: Delete file. --- src/puresize.h | 115 ------------------------------------------------- 1 file changed, 115 deletions(-) delete mode 100644 src/puresize.h diff --git a/src/puresize.h b/src/puresize.h deleted file mode 100644 index d7d8f0b4eec..00000000000 --- a/src/puresize.h +++ /dev/null @@ -1,115 +0,0 @@ -/* How much read-only Lisp storage a dumped Emacs needs. - Copyright (C) 1993, 2001-2024 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see . */ - -#ifndef EMACS_PURESIZE_H -#define EMACS_PURESIZE_H - -#include "lisp.h" - -INLINE_HEADER_BEGIN - -/* Define PURESIZE, the number of bytes of pure Lisp code to leave space for. - - At one point, this was defined in config.h, meaning that changing - PURESIZE would make Make recompile all of Emacs. But only a few - files actually use PURESIZE, so we split it out to its own .h file. - - Make sure to include this file after config.h, since that tells us - whether we are running X windows, which tells us how much pure - storage to allocate. */ - -/* First define a measure of the amount of data we have. */ - -/* A system configuration file may set this to request a certain extra - amount of storage. This is a lot more update-robust that defining - BASE_PURESIZE or even PURESIZE directly. */ -#ifndef SYSTEM_PURESIZE_EXTRA -#define SYSTEM_PURESIZE_EXTRA 0 -#endif - -#ifndef SITELOAD_PURESIZE_EXTRA -#define SITELOAD_PURESIZE_EXTRA 0 -#endif - -#ifndef BASE_PURESIZE -#define BASE_PURESIZE (3100000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) -#endif - -/* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */ -#ifndef PURESIZE_RATIO -#if EMACS_INT_MAX >> 31 != 0 -#if PTRDIFF_MAX >> 31 != 0 -#define PURESIZE_RATIO 10 / 6 /* Don't surround with `()'. */ -#else -#define PURESIZE_RATIO 8 / 6 /* Don't surround with `()'. */ -#endif -#else -#define PURESIZE_RATIO 1 -#endif -#endif - -#ifdef ENABLE_CHECKING -/* ENABLE_CHECKING somehow increases the purespace used, probably because - it tends to cause some macro arguments to be evaluated twice. This is - a bug, but it's difficult to track it down. */ -#define PURESIZE_CHECKING_RATIO 12 / 10 /* Don't surround with `()'. */ -#else -#define PURESIZE_CHECKING_RATIO 1 -#endif - -/* This is the actual size in bytes to allocate. */ -#ifndef PURESIZE -#define PURESIZE (BASE_PURESIZE * PURESIZE_RATIO * PURESIZE_CHECKING_RATIO) -#endif - -extern AVOID pure_write_error (Lisp_Object); - -extern EMACS_INT pure[]; - -/* The puresize_h_* macros are private to this include file. */ - -/* True if PTR is pure. */ - -#define puresize_h_PURE_P(ptr) \ - ((uintptr_t) (ptr) - (uintptr_t) pure <= PURESIZE) - -INLINE bool -PURE_P (void *ptr) -{ - return puresize_h_PURE_P (ptr); -} - -/* Signal an error if OBJ is pure. PTR is OBJ untagged. */ - -#define puresize_h_CHECK_IMPURE(obj, ptr) \ - (PURE_P (ptr) ? pure_write_error (obj) : (void) 0) - -INLINE void -CHECK_IMPURE (Lisp_Object obj, void *ptr) -{ - puresize_h_CHECK_IMPURE (obj, ptr); -} - -#if DEFINE_KEY_OPS_AS_MACROS -# define PURE_P(ptr) puresize_h_PURE_P (ptr) -# define CHECK_IMPURE(obj, ptr) puresize_h_CHECK_IMPURE (obj, ptr) -#endif - -INLINE_HEADER_END - -#endif /* EMACS_PURESIZE_H */ From f84ccff5a6275782a37534ed55b706db35f228ac Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 20 Aug 2024 18:52:35 +0000 Subject: [PATCH 06/57] Pure storage removal: Main part * src/alloc.c (pure, PUREBEG, purebeg, pure_size) (pure_bytes_used_before_overflow, pure_bytes_used_lisp) (pure_bytes_used_non_lisp): Remove definitions. (init_strings): Make empty strings impure. (cons_listn): Drop 'cons' argument. (pure_listn): Remove function. (init_vectors): Allocate zero vector manually to avoid freelist issues. (pure_alloc, check_pure_size, find_string_data_in_pure) (make_pure_string, make_pure_c_string, pure_cons, make_pure_float) (make_pure_bignum, make_pure_vector, purecopy_hash_table): Remove functions. (purecopy): Reduce to hash consing our argument. (init_alloc_once_for_pdumper): Adjust to lack of pure space. (pure-bytes-used): Adjust docstring to mark as obsolete. (purify-flag): Keep for hash consing, but adjust docstring. * src/bytecode.c: * src/comp.c: Don't include "puresize.h". * src/conf_post.h (SYSTEM_PURESIZE_EXTRA): Remove definition. * src/data.c (pure_write_error): Remove function. * src/deps.mk: Remove puresize.h dependency throughout. * src/emacs.c: * src/fns.c: * src/intervals.c: * src/keymap.c: Don't include "puresize.h". * src/lisp.h (struct Lisp_Hash_Table): Adjust comment. (pure_listn, pure_list, build_pure_c_string): Remove. * src/w32heap.c (FREEABLE_P): Don't do use 'dumped_data'. (malloc_before_dump, realloc_before_dump, free_before_dump): Remove functions. * src/w32heap.h: Adjust prototype. * lisp/loadup.el: * lisp/startup.el: Remove purespace code. --- lisp/loadup.el | 14 +- lisp/startup.el | 27 +-- src/alloc.c | 520 ++++++------------------------------------------ src/bytecode.c | 1 - src/comp.c | 1 - src/conf_post.h | 33 --- src/data.c | 7 - src/deps.mk | 10 +- src/emacs.c | 1 - src/fns.c | 1 - src/intervals.c | 1 - src/keymap.c | 1 - src/lisp.h | 18 +- src/w32heap.c | 135 +------------ src/w32heap.h | 2 +- 15 files changed, 85 insertions(+), 687 deletions(-) diff --git a/lisp/loadup.el b/lisp/loadup.el index 8307152a2fa..1ba25d967b5 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -184,12 +184,6 @@ (file-error (load "ldefs-boot.el"))) -(let ((new (make-hash-table :test #'equal))) - ;; Now that loaddefs has populated definition-prefixes, purify its contents. - (maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new)) - definition-prefixes) - (setq definition-prefixes new)) - (load "button") ;After loaddefs, because of define-minor-mode! (when (interpreted-function-p (symbol-function 'add-hook)) @@ -503,11 +497,6 @@ lost after dumping"))) ;; Avoid storing references to build directory in the binary. (setq custom-current-group-alist nil) -;; We keep the load-history data in PURE space. -;; Make sure that the spine of the list is not in pure space because it can -;; be destructively mutated in lread.c:build_load_history. -(setq load-history (mapcar #'purecopy load-history)) - (set-buffer-modified-p nil) (remove-hook 'after-load-functions (lambda (_) (garbage-collect))) @@ -659,8 +648,7 @@ directory got moved. This is set to be a pair in the form of: (dump-emacs-portable (expand-file-name output invocation-directory)) (dump-emacs output (if (eq system-type 'ms-dos) "temacs.exe" - "temacs")) - (message "%d pure bytes used" pure-bytes-used)) + "temacs"))) (setq success t)) (unless success (ignore-errors diff --git a/lisp/startup.el b/lisp/startup.el index e9618dc9f6a..5926d816cc4 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -355,7 +355,7 @@ looked for. Setting `init-file-user' does not prevent Emacs from loading `site-start.el'. The only way to do that is to use `--no-site-file'.") -(defcustom site-run-file (purecopy "site-start") +(defcustom site-run-file "site-start" "File containing site-wide run-time initializations. This file is loaded at run-time before `user-init-file'. It contains inits that need to be in place for the entire site, but which, due to @@ -430,10 +430,6 @@ from being initialized." (defvar pure-space-overflow nil "Non-nil if building Emacs overflowed pure space.") -(defvar pure-space-overflow-message (purecopy "\ -Warning Warning!!! Pure space overflow !!!Warning Warning -\(See the node Pure Storage in the Lisp manual for details.)\n")) - (defcustom tutorial-directory (file-name-as-directory (expand-file-name "tutorials" data-directory)) "Directory containing the Emacs TUTORIAL files." @@ -1693,11 +1689,11 @@ Changed settings will be marked as \"CHANGED outside of Customize\"." `((changed ((t :background ,color))))) (put 'cursor 'face-modified t)))) -(defcustom initial-scratch-message (purecopy "\ +(defcustom initial-scratch-message "\ ;; This buffer is for text that is not saved, and for Lisp evaluation. ;; To create a file, visit it with `\\[find-file]' and enter text in its buffer. -") +" "Initial documentation displayed in *scratch* buffer at startup. If this is nil, no message will be displayed." :type '(choice (text :tag "Message") @@ -2096,8 +2092,6 @@ splash screen in another window." (erase-buffer) (setq default-directory command-line-default-directory) (make-local-variable 'startup-screen-inhibit-startup-screen) - (if pure-space-overflow - (insert pure-space-overflow-message)) ;; Insert the permissions notice if the user has yet to grant Emacs ;; storage permissions. (when (fboundp 'android-before-splash-screen) @@ -2139,8 +2133,6 @@ splash screen in another window." (setq buffer-undo-list t) (let ((inhibit-read-only t)) (erase-buffer) - (if pure-space-overflow - (insert pure-space-overflow-message)) (fancy-splash-head) (dolist (text fancy-about-text) (apply #'fancy-splash-insert text) @@ -2206,8 +2198,6 @@ splash screen in another window." (setq default-directory command-line-default-directory) (setq-local tab-width 8) - (if pure-space-overflow - (insert pure-space-overflow-message)) ;; Insert the permissions notice if the user has yet to grant ;; Emacs storage permissions. (when (fboundp 'android-before-splash-screen) @@ -2529,17 +2519,6 @@ A fancy display is used on graphic displays, normal otherwise." (defun command-line-1 (args-left) "A subroutine of `command-line'." (display-startup-echo-area-message) - (when (and pure-space-overflow - (not noninteractive) - ;; If we were dumped with pdumper, we don't care about - ;; pure-space overflow. - (or (not (fboundp 'pdumper-stats)) - (null (pdumper-stats)))) - (display-warning - 'initialization - "Building Emacs overflowed pure space.\ - (See the node Pure Storage in the Lisp manual for details.)" - :warning)) ;; `displayable-buffers' is a list of buffers that may be displayed, ;; which includes files parsed from the command line arguments and diff --git a/src/alloc.c b/src/alloc.c index 642cccc97c6..a9df5ca885f 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -33,7 +33,6 @@ along with GNU Emacs. If not, see . */ #include "bignum.h" #include "dispextern.h" #include "intervals.h" -#include "puresize.h" #include "sysstdio.h" #include "systime.h" #include "character.h" @@ -380,33 +379,6 @@ static char *spare_memory[7]; #define SPARE_MEMORY (1 << 14) -/* Initialize it to a nonzero value to force it into data space - (rather than bss space). That way unexec will remap it into text - space (pure), on some systems. We have not implemented the - remapping on more recent systems because this is less important - nowadays than in the days of small memories and timesharing. */ - -EMACS_INT pure[(PURESIZE + sizeof (EMACS_INT) - 1) / sizeof (EMACS_INT)] = {1,}; -#define PUREBEG (char *) pure - -/* Pointer to the pure area, and its size. */ - -static char *purebeg; -static ptrdiff_t pure_size; - -/* Number of bytes of pure storage used before pure storage overflowed. - If this is non-zero, this implies that an overflow occurred. */ - -static ptrdiff_t pure_bytes_used_before_overflow; - -/* Index in pure at which next pure Lisp object will be allocated.. */ - -static ptrdiff_t pure_bytes_used_lisp; - -/* Number of bytes allocated for non-Lisp objects in pure storage. */ - -static ptrdiff_t pure_bytes_used_non_lisp; - /* If positive, garbage collection is inhibited. Otherwise, zero. */ intptr_t garbage_collection_inhibited; @@ -457,7 +429,6 @@ static struct Lisp_Vector *allocate_clear_vector (ptrdiff_t, bool); static void unchain_finalizer (struct Lisp_Finalizer *); static void mark_terminals (void); static void gc_sweep (void); -static Lisp_Object make_pure_vector (ptrdiff_t); static void mark_buffer (struct buffer *); #if !defined REL_ALLOC || defined SYSTEM_MALLOC @@ -578,15 +549,13 @@ Lisp_Object const *staticvec[NSTATICS]; int staticidx; -static void *pure_alloc (size_t, int); - -/* Return PTR rounded up to the next multiple of ALIGNMENT. */ - +#ifndef HAVE_ALIGNED_ALLOC static void * pointer_align (void *ptr, int alignment) { return (void *) ROUNDUP ((uintptr_t) ptr, alignment); } +#endif /* Extract the pointer hidden within O. */ @@ -1720,12 +1689,30 @@ static ptrdiff_t const STRING_BYTES_MAX = /* Initialize string allocation. Called from init_alloc_once. */ +static struct Lisp_String *allocate_string (void); +static void +allocate_string_data (struct Lisp_String *s, + EMACS_INT nchars, EMACS_INT nbytes, bool clearit, + bool immovable); + static void init_strings (void) { - empty_unibyte_string = make_pure_string ("", 0, 0, 0); + /* String allocation code will return one of 'empty_*ibyte_string' + when asked to construct a new 0-length string, so in order to build + those special cases, we have to do it "by hand". */ + struct Lisp_String *ems = allocate_string (); + struct Lisp_String *eus = allocate_string (); + ems->u.s.intervals = NULL; + eus->u.s.intervals = NULL; + allocate_string_data (ems, 0, 0, false, false); + allocate_string_data (eus, 0, 0, false, false); + /* We can't use 'STRING_SET_UNIBYTE' because this one includes a hack + * to redirect its arg to 'empty_unibyte_string' when nbytes == 0. */ + eus->u.s.size_byte = -1; + XSETSTRING (empty_multibyte_string, ems); + XSETSTRING (empty_unibyte_string, eus); staticpro (&empty_unibyte_string); - empty_multibyte_string = make_pure_string ("", 0, 0, 1); staticpro (&empty_multibyte_string); } @@ -2924,17 +2911,16 @@ list5 (Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, } /* Make a list of COUNT Lisp_Objects, where ARG is the first one. - Use CONS to construct the pairs. AP has any remaining args. */ + AP has any remaining args. */ static Lisp_Object -cons_listn (ptrdiff_t count, Lisp_Object arg, - Lisp_Object (*cons) (Lisp_Object, Lisp_Object), va_list ap) +cons_listn (ptrdiff_t count, Lisp_Object arg, va_list ap) { eassume (0 < count); - Lisp_Object val = cons (arg, Qnil); + Lisp_Object val = Fcons (arg, Qnil); Lisp_Object tail = val; for (ptrdiff_t i = 1; i < count; i++) { - Lisp_Object elem = cons (va_arg (ap, Lisp_Object), Qnil); + Lisp_Object elem = Fcons (va_arg (ap, Lisp_Object), Qnil); XSETCDR (tail, elem); tail = elem; } @@ -2947,18 +2933,7 @@ listn (ptrdiff_t count, Lisp_Object arg1, ...) { va_list ap; va_start (ap, arg1); - Lisp_Object val = cons_listn (count, arg1, Fcons, ap); - va_end (ap); - return val; -} - -/* Make a pure list of COUNT Lisp_Objects, where ARG1 is the first one. */ -Lisp_Object -pure_listn (ptrdiff_t count, Lisp_Object arg1, ...) -{ - va_list ap; - va_start (ap, arg1); - Lisp_Object val = cons_listn (count, arg1, pure_cons, ap); + Lisp_Object val = cons_listn (count, arg1, ap); va_end (ap); return val; } @@ -3139,7 +3114,7 @@ static ptrdiff_t last_inserted_vector_free_idx = VECTOR_FREE_LIST_ARRAY_SIZE; static struct large_vector *large_vectors; -/* The only vector with 0 slots, allocated from pure space. */ +/* The only vector with 0 slots. */ Lisp_Object zero_vector; @@ -3191,14 +3166,8 @@ allocate_vector_block (void) return block; } -/* Called once to initialize vector allocation. */ - -static void -init_vectors (void) -{ - zero_vector = make_pure_vector (0); - staticpro (&zero_vector); -} +static struct Lisp_Vector * +allocate_vector_from_block (ptrdiff_t nbytes); /* Memory footprint in bytes of a pseudovector other than a bool-vector. */ static ptrdiff_t @@ -3211,6 +3180,31 @@ pseudovector_nbytes (const union vectorlike_header *hdr) return vroundup (header_size + word_size * nwords); } +/* Called once to initialize vector allocation. */ + +static void +init_vectors (void) +{ + /* The normal vector allocation code refuses to allocate a 0-length vector + because we use the first field of vectors internally when they're on + the free list, so we can't put a zero-length vector on the free list. + This is not a problem for 'zero_vector' since it's always reachable. + An alternative approach would be to allocate zero_vector outside of the + normal heap, e.g. as a static object, and then to "hide" it from the GC, + for example by marking it by hand at the beginning of the GC and unmarking + it by hand at the end. */ + struct vector_block *block = allocate_vector_block (); + struct Lisp_Vector *zv = (struct Lisp_Vector *)block->data; + zv->header.size = 0; + ssize_t nbytes = pseudovector_nbytes (&zv->header); + ssize_t restbytes = VECTOR_BLOCK_BYTES - nbytes; + eassert (restbytes % roundup_size == 0); + setup_on_free_list (ADVANCE (zv, nbytes), restbytes); + + zero_vector = make_lisp_ptr (zv, Lisp_Vectorlike); + staticpro (&zero_vector); +} + /* Allocate vector from a vector block. */ static struct Lisp_Vector * @@ -5657,320 +5651,8 @@ hash_table_free_bytes (void *p, ptrdiff_t nbytes) } -/*********************************************************************** - Pure Storage Management - ***********************************************************************/ - -/* Allocate room for SIZE bytes from pure Lisp storage and return a - pointer to it. TYPE is the Lisp type for which the memory is - allocated. TYPE < 0 means it's not used for a Lisp object, - and that the result should have an alignment of -TYPE. - - The bytes are initially zero. - - If pure space is exhausted, allocate space from the heap. This is - merely an expedient to let Emacs warn that pure space was exhausted - and that Emacs should be rebuilt with a larger pure space. */ - -static void * -pure_alloc (size_t size, int type) -{ - void *result; - static bool pure_overflow_warned = false; - - again: - if (type >= 0) - { - /* Allocate space for a Lisp object from the beginning of the free - space with taking account of alignment. */ - result = pointer_align (purebeg + pure_bytes_used_lisp, LISP_ALIGNMENT); - pure_bytes_used_lisp = ((char *)result - (char *)purebeg) + size; - } - else - { - /* Allocate space for a non-Lisp object from the end of the free - space. */ - ptrdiff_t unaligned_non_lisp = pure_bytes_used_non_lisp + size; - char *unaligned = purebeg + pure_size - unaligned_non_lisp; - int decr = (intptr_t) unaligned & (-1 - type); - pure_bytes_used_non_lisp = unaligned_non_lisp + decr; - result = unaligned - decr; - } - pure_bytes_used = pure_bytes_used_lisp + pure_bytes_used_non_lisp; - - if (pure_bytes_used <= pure_size) - return result; - - if (!pure_overflow_warned) - { - message ("Pure Lisp storage overflowed"); - pure_overflow_warned = true; - } - - /* Don't allocate a large amount here, - because it might get mmap'd and then its address - might not be usable. */ - int small_amount = 10000; - eassert (size <= small_amount - LISP_ALIGNMENT); - purebeg = xzalloc (small_amount); - pure_size = small_amount; - pure_bytes_used_before_overflow += pure_bytes_used - size; - pure_bytes_used = 0; - pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0; - - /* Can't GC if pure storage overflowed because we can't determine - if something is a pure object or not. */ - garbage_collection_inhibited++; - goto again; -} - -/* Print a warning if PURESIZE is too small. */ - -void -check_pure_size (void) -{ - if (pure_bytes_used_before_overflow) - message (("emacs:0:Pure Lisp storage overflow (approx. %jd" - " bytes needed)"), - pure_bytes_used + pure_bytes_used_before_overflow); -} - -/* Find the byte sequence {DATA[0], ..., DATA[NBYTES-1], '\0'} from - the non-Lisp data pool of the pure storage, and return its start - address. Return NULL if not found. */ - -static char * -find_string_data_in_pure (const char *data, ptrdiff_t nbytes) -{ - int i; - ptrdiff_t skip, bm_skip[256], last_char_skip, infinity, start, start_max; - const unsigned char *p; - char *non_lisp_beg; - - if (pure_bytes_used_non_lisp <= nbytes) - return NULL; - - /* The Android GCC generates code like: - - 0xa539e755 <+52>: lea 0x430(%esp),%esi -=> 0xa539e75c <+59>: movdqa %xmm0,0x0(%ebp) - 0xa539e761 <+64>: add $0x10,%ebp - - but data is not aligned appropriately, so a GP fault results. */ - -#if defined __i386__ \ - && defined HAVE_ANDROID \ - && !defined ANDROID_STUBIFY \ - && !defined (__clang__) - if ((intptr_t) data & 15) - return NULL; -#endif - - /* Set up the Boyer-Moore table. */ - skip = nbytes + 1; - for (i = 0; i < 256; i++) - bm_skip[i] = skip; - - p = (const unsigned char *) data; - while (--skip > 0) - bm_skip[*p++] = skip; - - last_char_skip = bm_skip['\0']; - - non_lisp_beg = purebeg + pure_size - pure_bytes_used_non_lisp; - start_max = pure_bytes_used_non_lisp - (nbytes + 1); - - /* See the comments in the function `boyer_moore' (search.c) for the - use of `infinity'. */ - infinity = pure_bytes_used_non_lisp + 1; - bm_skip['\0'] = infinity; - - p = (const unsigned char *) non_lisp_beg + nbytes; - start = 0; - do - { - /* Check the last character (== '\0'). */ - do - { - start += bm_skip[*(p + start)]; - } - while (start <= start_max); - - if (start < infinity) - /* Couldn't find the last character. */ - return NULL; - - /* No less than `infinity' means we could find the last - character at `p[start - infinity]'. */ - start -= infinity; - - /* Check the remaining characters. */ - if (memcmp (data, non_lisp_beg + start, nbytes) == 0) - /* Found. */ - return non_lisp_beg + start; - - start += last_char_skip; - } - while (start <= start_max); - - return NULL; -} - - -/* Return a string allocated in pure space. DATA is a buffer holding - NCHARS characters, and NBYTES bytes of string data. MULTIBYTE - means make the result string multibyte. - - Must get an error if pure storage is full, since if it cannot hold - a large string it may be able to hold conses that point to that - string; then the string is not protected from gc. */ - -Lisp_Object -make_pure_string (const char *data, - ptrdiff_t nchars, ptrdiff_t nbytes, bool multibyte) -{ - Lisp_Object string; - struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String); - s->u.s.data = (unsigned char *) find_string_data_in_pure (data, nbytes); - if (s->u.s.data == NULL) - { - s->u.s.data = pure_alloc (nbytes + 1, -1); - memcpy (s->u.s.data, data, nbytes); - s->u.s.data[nbytes] = '\0'; - } - s->u.s.size = nchars; - s->u.s.size_byte = multibyte ? nbytes : -1; - s->u.s.intervals = NULL; - XSETSTRING (string, s); - return string; -} - -/* Return a string allocated in pure space. Do not - allocate the string data, just point to DATA. */ - -Lisp_Object -make_pure_c_string (const char *data, ptrdiff_t nchars) -{ - Lisp_Object string; - struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String); - s->u.s.size = nchars; - s->u.s.size_byte = -2; - s->u.s.data = (unsigned char *) data; - s->u.s.intervals = NULL; - XSETSTRING (string, s); - return string; -} - static Lisp_Object purecopy (Lisp_Object obj); -/* Return a cons allocated from pure space. Give it pure copies - of CAR as car and CDR as cdr. */ - -Lisp_Object -pure_cons (Lisp_Object car, Lisp_Object cdr) -{ - Lisp_Object new; - struct Lisp_Cons *p = pure_alloc (sizeof *p, Lisp_Cons); - XSETCONS (new, p); - XSETCAR (new, purecopy (car)); - XSETCDR (new, purecopy (cdr)); - return new; -} - - -/* Value is a float object with value NUM allocated from pure space. */ - -static Lisp_Object -make_pure_float (double num) -{ - Lisp_Object new; - struct Lisp_Float *p = pure_alloc (sizeof *p, Lisp_Float); - XSETFLOAT (new, p); - XFLOAT_INIT (new, num); - return new; -} - -/* Value is a bignum object with value VALUE allocated from pure - space. */ - -static Lisp_Object -make_pure_bignum (Lisp_Object value) -{ - mpz_t const *n = xbignum_val (value); - size_t i, nlimbs = mpz_size (*n); - size_t nbytes = nlimbs * sizeof (mp_limb_t); - mp_limb_t *pure_limbs; - mp_size_t new_size; - - struct Lisp_Bignum *b = pure_alloc (sizeof *b, Lisp_Vectorlike); - XSETPVECTYPESIZE (b, PVEC_BIGNUM, 0, VECSIZE (struct Lisp_Bignum)); - - int limb_alignment = alignof (mp_limb_t); - pure_limbs = pure_alloc (nbytes, - limb_alignment); - for (i = 0; i < nlimbs; ++i) - pure_limbs[i] = mpz_getlimbn (*n, i); - - new_size = nlimbs; - if (mpz_sgn (*n) < 0) - new_size = -new_size; - - mpz_roinit_n (b->value, pure_limbs, new_size); - - return make_lisp_ptr (b, Lisp_Vectorlike); -} - -/* Return a vector with room for LEN Lisp_Objects allocated from - pure space. */ - -static Lisp_Object -make_pure_vector (ptrdiff_t len) -{ - Lisp_Object new; - size_t size = header_size + len * word_size; - struct Lisp_Vector *p = pure_alloc (size, Lisp_Vectorlike); - XSETVECTOR (new, p); - XVECTOR (new)->header.size = len; - return new; -} - -/* Copy all contents and parameters of TABLE to a new table allocated - from pure space, return the purified table. */ -static struct Lisp_Hash_Table * -purecopy_hash_table (struct Lisp_Hash_Table *table) -{ - eassert (table->weakness == Weak_None); - eassert (table->purecopy); - - struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike); - *pure = *table; - pure->mutable = false; - - if (table->table_size > 0) - { - ptrdiff_t hash_bytes = table->table_size * sizeof *table->hash; - pure->hash = pure_alloc (hash_bytes, -(int)sizeof *table->hash); - memcpy (pure->hash, table->hash, hash_bytes); - - ptrdiff_t next_bytes = table->table_size * sizeof *table->next; - pure->next = pure_alloc (next_bytes, -(int)sizeof *table->next); - memcpy (pure->next, table->next, next_bytes); - - ptrdiff_t nvalues = table->table_size * 2; - ptrdiff_t kv_bytes = nvalues * sizeof *table->key_and_value; - pure->key_and_value = pure_alloc (kv_bytes, - -(int)sizeof *table->key_and_value); - for (ptrdiff_t i = 0; i < nvalues; i++) - pure->key_and_value[i] = purecopy (table->key_and_value[i]); - - ptrdiff_t index_bytes = hash_table_index_size (table) - * sizeof *table->index; - pure->index = pure_alloc (index_bytes, -(int)sizeof *table->index); - memcpy (pure->index, table->index, index_bytes); - } - - return pure; -} - DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, doc: /* Make a copy of object OBJ in pure storage. Recursively copies contents of vectors and cons cells. @@ -5996,89 +5678,17 @@ static struct pinned_object static Lisp_Object purecopy (Lisp_Object obj) { - if (FIXNUMP (obj) - || (! SYMBOLP (obj) && PURE_P (XPNTR (obj))) - || SUBRP (obj)) - return obj; /* Already pure. */ - - if (STRINGP (obj) && XSTRING (obj)->u.s.intervals) - message_with_string ("Dropping text-properties while making string `%s' pure", - obj, true); + if (FIXNUMP (obj) || SUBRP (obj)) + return obj; /* No need to hash. */ if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */ { Lisp_Object tmp = Fgethash (obj, Vpurify_flag, Qnil); if (!NILP (tmp)) return tmp; + Fputhash (obj, obj, Vpurify_flag); } - if (CONSP (obj)) - obj = pure_cons (XCAR (obj), XCDR (obj)); - else if (FLOATP (obj)) - obj = make_pure_float (XFLOAT_DATA (obj)); - else if (STRINGP (obj)) - obj = make_pure_string (SSDATA (obj), SCHARS (obj), - SBYTES (obj), - STRING_MULTIBYTE (obj)); - else if (HASH_TABLE_P (obj)) - { - struct Lisp_Hash_Table *table = XHASH_TABLE (obj); - /* Do not purify hash tables which haven't been defined with - :purecopy as non-nil or are weak - they aren't guaranteed to - not change. */ - if (table->weakness != Weak_None || !table->purecopy) - { - /* Instead, add the hash table to the list of pinned objects, - so that it will be marked during GC. */ - struct pinned_object *o = xmalloc (sizeof *o); - o->object = obj; - o->next = pinned_objects; - pinned_objects = o; - return obj; /* Don't hash cons it. */ - } - - obj = make_lisp_hash_table (purecopy_hash_table (table)); - } - else if (CLOSUREP (obj) || VECTORP (obj) || RECORDP (obj)) - { - struct Lisp_Vector *objp = XVECTOR (obj); - ptrdiff_t nbytes = vector_nbytes (objp); - struct Lisp_Vector *vec = pure_alloc (nbytes, Lisp_Vectorlike); - register ptrdiff_t i; - ptrdiff_t size = ASIZE (obj); - if (size & PSEUDOVECTOR_FLAG) - size &= PSEUDOVECTOR_SIZE_MASK; - memcpy (vec, objp, nbytes); - for (i = 0; i < size; i++) - vec->contents[i] = purecopy (vec->contents[i]); - /* Byte code strings must be pinned. */ - if (CLOSUREP (obj) && size >= 2 && STRINGP (vec->contents[1]) - && !STRING_MULTIBYTE (vec->contents[1])) - pin_string (vec->contents[1]); - XSETVECTOR (obj, vec); - } - else if (BARE_SYMBOL_P (obj)) - { - if (!XBARE_SYMBOL (obj)->u.s.pinned && !c_symbol_p (XBARE_SYMBOL (obj))) - { /* We can't purify them, but they appear in many pure objects. - Mark them as `pinned' so we know to mark them at every GC cycle. */ - XBARE_SYMBOL (obj)->u.s.pinned = true; - symbol_block_pinned = symbol_block; - } - /* Don't hash-cons it. */ - return obj; - } - else if (BIGNUMP (obj)) - obj = make_pure_bignum (obj); - else - { - AUTO_STRING (fmt, "Don't know how to purify: %S"); - Fsignal (Qerror, list1 (CALLN (Fformat, fmt, obj))); - } - - if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */ - Fputhash (obj, obj, Vpurify_flag); - return obj; } @@ -8093,8 +7703,6 @@ init_alloc_once (void) static void init_alloc_once_for_pdumper (void) { - purebeg = PUREBEG; - pure_size = PURESIZE; mem_init (); #ifdef DOUG_LEA_MALLOC @@ -8148,7 +7756,7 @@ If this portion is smaller than `gc-cons-threshold', this is ignored. */); Vgc_cons_percentage = make_float (0.1); DEFVAR_INT ("pure-bytes-used", pure_bytes_used, - doc: /* Number of bytes of shareable Lisp data allocated so far. */); + doc: /* No longer used. */); DEFVAR_INT ("cons-cells-consed", cons_cells_consed, doc: /* Number of cons cells that have been consed so far. */); @@ -8174,9 +7782,13 @@ If this portion is smaller than `gc-cons-threshold', this is ignored. */); DEFVAR_LISP ("purify-flag", Vpurify_flag, doc: /* Non-nil means loading Lisp code in order to dump an executable. -This means that certain objects should be allocated in shared (pure) space. -It can also be set to a hash-table, in which case this table is used to -do hash-consing of the objects allocated to pure space. */); +This used to mean that certain objects should be allocated in shared (pure) +space. It can also be set to a hash-table, in which case this table is used +to do hash-consing of the objects allocated to pure space. +The hash-consing still applies, but objects are not allocated in pure +storage any more. +This flag is still used in a few places not to decide where objects are +allocated but to know if we're in the preload phase of Emacs's build. */); DEFVAR_BOOL ("garbage-collection-messages", garbage_collection_messages, doc: /* Non-nil means display messages at start and end of garbage collection. */); diff --git a/src/bytecode.c b/src/bytecode.c index 48a29c22d55..f719b036d14 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -27,7 +27,6 @@ along with GNU Emacs. If not, see . */ #include "keyboard.h" #include "syntax.h" #include "window.h" -#include "puresize.h" /* Define BYTE_CODE_SAFE true to enable some minor sanity checking, useful for debugging the byte compiler. It defaults to false. */ diff --git a/src/comp.c b/src/comp.c index cee2859c2eb..e89385de1d6 100644 --- a/src/comp.c +++ b/src/comp.c @@ -31,7 +31,6 @@ along with GNU Emacs. If not, see . */ #include #include -#include "puresize.h" #include "window.h" #include "dynlib.h" #include "buffer.h" diff --git a/src/conf_post.h b/src/conf_post.h index 94d9342f154..3963fb9b878 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -157,41 +157,8 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */ /* DATA_START is needed by vm-limit.c and unexcoff.c. */ #define DATA_START (&etext + 1) - -/* Define one of these for easier conditionals. */ -#ifdef HAVE_X_WINDOWS -/* We need a little extra space, see ../../lisp/loadup.el and the - commentary below, in the non-X branch. The 140KB number was - measured on GNU/Linux and on MS-Windows. */ -#define SYSTEM_PURESIZE_EXTRA (-170000+140000) -#else -/* We need a little extra space, see ../../lisp/loadup.el. - As of 20091024, DOS-specific files use up 62KB of pure space. But - overall, we end up wasting 130KB of pure space, because - BASE_PURESIZE starts at 1.47MB, while we need only 1.3MB (including - non-DOS specific files and load history; the latter is about 55K, - but depends on the depth of the top-level Emacs directory in the - directory tree). Given the unknown policy of different DPMI - hosts regarding loading of untouched pages, I'm not going to risk - enlarging Emacs footprint by another 100+ KBytes. */ -#define SYSTEM_PURESIZE_EXTRA (-170000+90000) -#endif #endif /* MSDOS */ -/* macOS / GNUstep need a bit more pure memory. Of the existing knobs, - SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems. */ -#ifdef HAVE_NS -#if defined NS_IMPL_GNUSTEP -# define SYSTEM_PURESIZE_EXTRA 30000 -#elif defined DARWIN_OS -# define SYSTEM_PURESIZE_EXTRA 200000 -#endif -#endif - -#ifdef CYGWIN -#define SYSTEM_PURESIZE_EXTRA 50000 -#endif - #if defined HAVE_NTGUI && !defined DebPrint # ifdef EMACSDEBUG extern void _DebPrint (const char *fmt, ...); diff --git a/src/data.c b/src/data.c index 66cf34c1e60..95c1d857964 100644 --- a/src/data.c +++ b/src/data.c @@ -27,7 +27,6 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" #include "bignum.h" -#include "puresize.h" #include "character.h" #include "buffer.h" #include "keyboard.h" @@ -135,12 +134,6 @@ wrong_type_argument (Lisp_Object predicate, Lisp_Object value) xsignal2 (Qwrong_type_argument, predicate, value); } -void -pure_write_error (Lisp_Object obj) -{ - xsignal2 (Qerror, build_string ("Attempt to modify read-only object"), obj); -} - void args_out_of_range (Lisp_Object a1, Lisp_Object a2) { diff --git a/src/deps.mk b/src/deps.mk index 65536729014..decb6670473 100644 --- a/src/deps.mk +++ b/src/deps.mk @@ -132,10 +132,10 @@ insdel.o: insdel.c window.h buffer.h $(INTERVALS_H) blockinput.h character.h \ keyboard.o: keyboard.c termchar.h termhooks.h termopts.h buffer.h character.h \ commands.h frame.h window.h macros.h disptab.h keyboard.h syssignal.h \ systime.h syntax.h $(INTERVALS_H) blockinput.h atimer.h composite.h \ - xterm.h puresize.h msdos.h keymap.h w32term.h nsterm.h nsgui.h coding.h \ + xterm.h msdos.h keymap.h w32term.h nsterm.h nsgui.h coding.h \ process.h ../lib/unistd.h gnutls.h lisp.h globals.h $(config_h) keymap.o: keymap.c buffer.h commands.h keyboard.h termhooks.h blockinput.h \ - atimer.h systime.h puresize.h character.h charset.h $(INTERVALS_H) \ + atimer.h systime.h character.h charset.h $(INTERVALS_H) \ keymap.h window.h coding.h frame.h lisp.h globals.h $(config_h) lastfile.o: lastfile.c $(config_h) macros.o: macros.c window.h buffer.h commands.h macros.h keyboard.h msdos.h \ @@ -267,12 +267,12 @@ xsettings.o: xterm.h xsettings.h lisp.h frame.h termhooks.h $(config_h) \ atimer.h termopts.h globals.h ## The files of Lisp proper. -alloc.o: alloc.c process.h frame.h window.h buffer.h puresize.h syssignal.h \ +alloc.o: alloc.c process.h frame.h window.h buffer.h syssignal.h \ keyboard.h blockinput.h atimer.h systime.h character.h lisp.h $(config_h) \ $(INTERVALS_H) termhooks.h gnutls.h coding.h ../lib/unistd.h globals.h bytecode.o: bytecode.c buffer.h syntax.h character.h window.h dispextern.h \ lisp.h globals.h $(config_h) msdos.h -data.o: data.c buffer.h puresize.h character.h syssignal.h keyboard.h frame.h \ +data.o: data.c buffer.h character.h syssignal.h keyboard.h frame.h \ termhooks.h systime.h coding.h composite.h dispextern.h font.h ccl.h \ lisp.h globals.h $(config_h) msdos.h eval.o: eval.c commands.h keyboard.h blockinput.h atimer.h systime.h frame.h \ @@ -295,7 +295,7 @@ lread.o: lread.c commands.h keyboard.h buffer.h epaths.h character.h \ composite.o: composite.c composite.h buffer.h character.h coding.h font.h \ ccl.h frame.h termhooks.h $(INTERVALS_H) window.h \ lisp.h globals.h $(config_h) -intervals.o: intervals.c buffer.h $(INTERVALS_H) keyboard.h puresize.h \ +intervals.o: intervals.c buffer.h $(INTERVALS_H) keyboard.h \ keymap.h lisp.h globals.h $(config_h) systime.h coding.h textprop.o: textprop.c buffer.h window.h $(INTERVALS_H) \ lisp.h globals.h $(config_h) diff --git a/src/emacs.c b/src/emacs.c index eba103bd807..496a107d49d 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -113,7 +113,6 @@ along with GNU Emacs. If not, see . */ #include "syntax.h" #include "sysselect.h" #include "systime.h" -#include "puresize.h" #include "getpagesize.h" #include "gnutls.h" diff --git a/src/fns.c b/src/fns.c index ef6922c137b..cf337dc0808 100644 --- a/src/fns.c +++ b/src/fns.c @@ -36,7 +36,6 @@ along with GNU Emacs. If not, see . */ #include "buffer.h" #include "intervals.h" #include "window.h" -#include "puresize.h" #include "gnutls.h" #ifdef HAVE_TREE_SITTER diff --git a/src/intervals.c b/src/intervals.c index c7a1f81e4ee..cebb77a3614 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -44,7 +44,6 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" #include "intervals.h" #include "buffer.h" -#include "puresize.h" #include "keymap.h" /* Test for membership, allowing for t (actually any non-cons) to mean the diff --git a/src/keymap.c b/src/keymap.c index 7249d8252f9..7f464ed9159 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -50,7 +50,6 @@ along with GNU Emacs. If not, see . */ #include "keyboard.h" #include "termhooks.h" #include "blockinput.h" -#include "puresize.h" #include "intervals.h" #include "keymap.h" #include "window.h" diff --git a/src/lisp.h b/src/lisp.h index f795cf72da2..4df3c999d73 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2628,8 +2628,8 @@ struct Lisp_Hash_Table bool_bf purecopy : 1; /* True if the table is mutable. Ordinarily tables are mutable, but - pure tables are not, and while a table is being mutated it is - immutable for recursive attempts to mutate it. */ + some tables are not: while a table is being mutated it is immutable + for recursive attempts to mutate it. */ bool_bf mutable : 1; /* Next weak hash table if this is a weak hash table. The head of @@ -4436,7 +4436,6 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t, /* Defined in alloc.c. */ extern intptr_t garbage_collection_inhibited; extern void *my_heap_start (void); -extern void check_pure_size (void); unsigned char *resize_string_data (Lisp_Object, ptrdiff_t, int, int); extern void malloc_warning (const char *); extern AVOID memory_full (size_t); @@ -4499,11 +4498,8 @@ extern Lisp_Object list4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object listn (ptrdiff_t, Lisp_Object, ...); -extern Lisp_Object pure_listn (ptrdiff_t, Lisp_Object, ...); #define list(...) \ listn (ARRAYELTS (((Lisp_Object []) {__VA_ARGS__})), __VA_ARGS__) -#define pure_list(...) \ - pure_listn (ARRAYELTS (((Lisp_Object []) {__VA_ARGS__})), __VA_ARGS__) enum gc_root_type { @@ -4577,18 +4573,8 @@ extern Lisp_Object make_uninit_multibyte_string (EMACS_INT, EMACS_INT); extern Lisp_Object make_string_from_bytes (const char *, ptrdiff_t, ptrdiff_t); extern Lisp_Object make_specified_string (const char *, ptrdiff_t, ptrdiff_t, bool); -extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, bool); -extern Lisp_Object make_pure_c_string (const char *, ptrdiff_t); extern void pin_string (Lisp_Object string); -/* Make a string allocated in pure space, use STR as string data. */ - -INLINE Lisp_Object -build_pure_c_string (const char *str) -{ - return make_pure_c_string (str, strlen (str)); -} - /* Make a string from the data at STR, treating it as multibyte if the data warrants. */ diff --git a/src/w32heap.c b/src/w32heap.c index f850fe1cf19..6a063e5d7f1 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -135,6 +135,12 @@ static struct static DWORD blocks_number = 0; static unsigned char *bc_limit; +/* Handle for the private heap: + - inside the dumped_data[] array before dump with unexec, + - outside of it after dump, or always if pdumper is used. +*/ +HANDLE heap = NULL; + /* We redirect the standard allocation functions. */ malloc_fn the_malloc_fn; realloc_fn the_realloc_fn; @@ -237,9 +243,7 @@ init_heap (void) /* FREEABLE_P checks if the block can be safely freed. */ #define FREEABLE_P(addr) \ - ((DWORD_PTR)(unsigned char *)(addr) > 0 \ - && ((unsigned char *)(addr) < dumped_data \ - || (unsigned char *)(addr) >= dumped_data + DUMPED_HEAP_SIZE)) + ((DWORD_PTR)(unsigned char *)(addr) > 0) void * malloc_after_dump (size_t size) @@ -258,65 +262,6 @@ malloc_after_dump (size_t size) return p; } -/* FIXME: The *_before_dump functions should be removed when pdumper - becomes the only dumping method. */ -void * -malloc_before_dump (size_t size) -{ - void *p; - - /* Before dumping. The private heap can handle only requests for - less than MaxBlockSize. */ - if (size < MaxBlockSize) - { - /* Use the private heap if possible. */ - p = heap_alloc (size); - } - else - { - /* Find the first big chunk that can hold the requested size. */ - int i = 0; - - for (i = 0; i < blocks_number; i++) - { - if (blocks[i].occupied == 0 && blocks[i].size >= size) - break; - } - if (i < blocks_number) - { - /* If found, use it. */ - p = blocks[i].address; - blocks[i].occupied = TRUE; - } - else - { - /* Allocate a new big chunk from the end of the dumped_data - array. */ - if (blocks_number >= MAX_BLOCKS) - { - fprintf (stderr, - "malloc_before_dump: no more big chunks available.\nEnlarge MAX_BLOCKS!\n"); - exit (-1); - } - bc_limit -= size; - bc_limit = (unsigned char *)ROUND_DOWN (bc_limit, 0x10); - p = bc_limit; - blocks[blocks_number].address = p; - blocks[blocks_number].size = size; - blocks[blocks_number].occupied = TRUE; - blocks_number++; - /* Check that areas do not overlap. */ - if (bc_limit < dumped_data + committed) - { - fprintf (stderr, - "malloc_before_dump: memory exhausted.\nEnlarge dumped_data[]!\n"); - exit (-1); - } - } - } - return p; -} - /* Re-allocate the previously allocated block in ptr, making the new block SIZE bytes long. */ void * @@ -349,39 +294,6 @@ realloc_after_dump (void *ptr, size_t size) return p; } -void * -realloc_before_dump (void *ptr, size_t size) -{ - void *p; - - /* Before dumping. */ - if (dumped_data < (unsigned char *)ptr - && (unsigned char *)ptr < bc_limit && size <= MaxBlockSize) - { - p = heap_realloc (ptr, size); - } - else - { - /* In this case, either the new block is too large for the heap, - or the old block was already too large. In both cases, - malloc_before_dump() and free_before_dump() will take care of - reallocation. */ - p = malloc_before_dump (size); - /* If SIZE is below MaxBlockSize, malloc_before_dump will try to - allocate it in the fixed heap. If that fails, we could have - kept the block in its original place, above bc_limit, instead - of failing the call as below. But this doesn't seem to be - worth the added complexity, as loadup allocates only a very - small number of large blocks, and never reallocates them. */ - if (p && ptr) - { - CopyMemory (p, ptr, size); - free_before_dump (ptr); - } - } - return p; -} - /* Free a block allocated by `malloc', `realloc' or `calloc'. */ void free_after_dump (void *ptr) @@ -394,39 +306,6 @@ free_after_dump (void *ptr) } } -void -free_before_dump (void *ptr) -{ - if (!ptr) - return; - - /* Before dumping. */ - if (dumped_data < (unsigned char *)ptr - && (unsigned char *)ptr < bc_limit) - { - /* Free the block if it is allocated in the private heap. */ - HeapFree (heap, 0, ptr); - } - else - { - /* Look for the big chunk. */ - int i; - - for (i = 0; i < blocks_number; i++) - { - if (blocks[i].address == ptr) - { - /* Reset block occupation if found. */ - blocks[i].occupied = 0; - break; - } - /* What if the block is not found? We should trigger an - error here. */ - eassert (i < blocks_number); - } - } -} - /* On Windows 9X, HeapAlloc may return pointers that are not aligned on 8-byte boundary, alignment which is required by the Lisp memory management. To circumvent this problem, manually enforce alignment diff --git a/src/w32heap.h b/src/w32heap.h index 901c9b5a41e..01ec13c7122 100644 --- a/src/w32heap.h +++ b/src/w32heap.h @@ -42,7 +42,7 @@ extern void report_temacs_memory_usage (void); extern void *sbrk (ptrdiff_t size); /* Initialize heap structures for sbrk on startup. */ -extern void init_heap (bool); +extern void init_heap (void); /* ----------------------------------------------------------------- */ /* Useful routines for manipulating memory-mapped files. */ From 5ec86966638885a0f8df8afa28a01ca103ad2a49 Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 20 Aug 2024 19:00:20 +0000 Subject: [PATCH 07/57] Pure storage removal: Replace calls to removed functions * src/alloc.c (string_bytes, pin_string, valid_lisp_object_p) (process_mark_stack, survives_gc_p, syms_of_alloc): * src/androidterm.c (android_term_init): Replace call to 'build_pure_c_string'. * src/buffer.c (init_buffer_once, syms_of_buffer): * src/bytecode.c (exec_byte_code): * src/callint.c (syms_of_callint): * src/callproc.c (syms_of_callproc): * src/category.c (Fdefine_category): * src/coding.c (syms_of_coding): * src/comp.c (Fcomp__compile_ctxt_to_file0) (maybe_defer_native_compilation, syms_of_comp): * src/data.c (Fsetcar, Fsetcdr, Fdefalias, Faset, syms_of_data): * src/dbusbind.c (syms_of_dbusbind): * src/doc.c (Fsnarf_documentation): * src/emacs-module.c (syms_of_module): * src/eval.c (Finternal__define_uninitialized_variable) (Fdefconst_1, define_error, syms_of_eval): * src/fileio.c (syms_of_fileio): * src/fns.c (Ffillarray, Fclear_string, check_mutable_hash_table): * src/fontset.c (syms_of_fontset): * src/frame.c (make_initial_frame): * src/haikufns.c (syms_of_haikufns): * src/intervals.c (create_root_interval): * src/keyboard.c (syms_of_keyboard): * src/keymap.c (Fmake_sparse_keymap, Fset_keymap_parent) (store_in_keymap, syms_of_keymap): * src/lisp.h: * src/lread.c (Fload, read0, intern_c_string_1, define_symbol) (Fintern, defsubr, syms_of_lread): * src/pdumper.c (Fdump_emacs_portable): * src/pgtkfns.c (syms_of_pgtkfns): * src/pgtkterm.c (syms_of_pgtkterm): * src/process.c (syms_of_process): * src/search.c (syms_of_search): * src/sqlite.c (syms_of_sqlite): * src/syntax.c (syms_of_syntax): * src/treesit.c (syms_of_treesit): * src/w32fns.c (syms_of_w32fns): * src/xdisp.c (syms_of_xdisp): * src/xfaces.c (syms_of_xfaces): * src/xfns.c (syms_of_xfns): * src/xftfont.c (syms_of_xftfont): * src/xterm.c (syms_of_xterm): Remove calls to 'PURE_P', 'CHECK_IMPURE', 'Fpurecopy', and replace calls to 'build_pure_c_string', 'pure_list', 'pure_listn', etc., by impure equivalents. --- src/alloc.c | 21 ++++++++------------- src/androidterm.c | 2 +- src/buffer.c | 16 ++++++++-------- src/bytecode.c | 2 -- src/callint.c | 8 ++++---- src/callproc.c | 28 ++++++++++++++-------------- src/category.c | 2 -- src/coding.c | 18 +++++++++--------- src/comp.c | 37 ++++++++++++++++++------------------- src/data.c | 31 +++++++++++-------------------- src/dbusbind.c | 4 ++-- src/doc.c | 1 - src/emacs-module.c | 26 +++++++++++++------------- src/eval.c | 10 +++------- src/fileio.c | 28 ++++++++++++++-------------- src/fns.c | 3 --- src/fontset.c | 4 ++-- src/frame.c | 2 +- src/haikufns.c | 2 +- src/intervals.c | 1 - src/keyboard.c | 6 +++--- src/keymap.c | 34 ++++++++++++++-------------------- src/lisp.h | 1 - src/lread.c | 38 +++++++++++++++----------------------- src/pdumper.c | 2 -- src/pgtkfns.c | 4 ++-- src/pgtkterm.c | 2 +- src/process.c | 4 ++-- src/search.c | 12 ++++++------ src/sqlite.c | 8 ++++---- src/syntax.c | 4 ++-- src/treesit.c | 36 ++++++++++++++++++------------------ src/w32fns.c | 4 ++-- src/xdisp.c | 16 ++++++++-------- src/xfaces.c | 2 +- src/xfns.c | 9 +++++---- src/xftfont.c | 2 +- src/xterm.c | 2 +- 38 files changed, 194 insertions(+), 238 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index a9df5ca885f..ff491719547 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1765,7 +1765,7 @@ string_bytes (struct Lisp_String *s) ptrdiff_t nbytes = (s->u.s.size_byte < 0 ? s->u.s.size & ~ARRAY_MARK_FLAG : s->u.s.size_byte); - if (!PURE_P (s) && !pdumper_object_p (s) && s->u.s.data + if (!pdumper_object_p (s) && s->u.s.data && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s))) emacs_abort (); return nbytes; @@ -2612,7 +2612,7 @@ pin_string (Lisp_Object string) unsigned char *data = s->u.s.data; if (!(size > LARGE_STRING_BYTES - || PURE_P (data) || pdumper_object_p (data) + || pdumper_object_p (data) || s->u.s.size_byte == -3)) { eassert (s->u.s.size_byte == -1); @@ -5570,8 +5570,6 @@ valid_lisp_object_p (Lisp_Object obj) return 1; void *p = XPNTR (obj); - if (PURE_P (p)) - return 1; if (BARE_SYMBOL_P (obj) && c_symbol_p (p)) return ((char *) p - (char *) lispsym) % sizeof lispsym[0] == 0; @@ -6756,8 +6754,6 @@ process_mark_stack (ptrdiff_t base_sp) Lisp_Object obj = mark_stack_pop (); mark_obj: ; void *po = XPNTR (obj); - if (PURE_P (po)) - continue; #if GC_REMEMBER_LAST_MARKED last_marked[last_marked_index++] = obj; @@ -7001,8 +6997,7 @@ process_mark_stack (ptrdiff_t base_sp) break; default: emacs_abort (); } - if (!PURE_P (XSTRING (ptr->u.s.name))) - set_string_marked (XSTRING (ptr->u.s.name)); + set_string_marked (XSTRING (ptr->u.s.name)); mark_interval_tree (string_intervals (ptr->u.s.name)); /* Inner loop to mark next symbol in this bucket, if any. */ po = ptr = ptr->u.s.next; @@ -7135,7 +7130,7 @@ survives_gc_p (Lisp_Object obj) emacs_abort (); } - return survives_p || PURE_P (XPNTR (obj)); + return survives_p; } @@ -7804,10 +7799,10 @@ allocated but to know if we're in the preload phase of Emacs's build. */); /* We build this in advance because if we wait until we need it, we might not be able to allocate the memory to hold it. */ Vmemory_signal_data - = pure_list (Qerror, - build_pure_c_string ("Memory exhausted--use" - " M-x save-some-buffers then" - " exit and restart Emacs")); + = list (Qerror, + build_string ("Memory exhausted--use" + " M-x save-some-buffers then" + " exit and restart Emacs")); DEFVAR_LISP ("memory-full", Vmemory_full, doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); diff --git a/src/androidterm.c b/src/androidterm.c index 4561f2d1df3..c0470176489 100644 --- a/src/androidterm.c +++ b/src/androidterm.c @@ -6632,7 +6632,7 @@ android_term_init (void) x_display_list = dpyinfo; dpyinfo->name_list_element - = Fcons (build_pure_c_string ("android"), Qnil); + = Fcons (build_string ("android"), Qnil); color_file = Fexpand_file_name (build_string ("rgb.txt"), Vdata_directory); diff --git a/src/buffer.c b/src/buffer.c index 663a47ec72f..c6e7d9679ae 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -4788,8 +4788,8 @@ init_buffer_once (void) set_buffer_intervals (&buffer_defaults, NULL); set_buffer_intervals (&buffer_local_symbols, NULL); /* This is not strictly necessary, but let's make them initialized. */ - bset_name (&buffer_defaults, build_pure_c_string (" *buffer-defaults*")); - bset_name (&buffer_local_symbols, build_pure_c_string (" *buffer-local-symbols*")); + bset_name (&buffer_defaults, build_string (" *buffer-defaults*")); + bset_name (&buffer_local_symbols, build_string (" *buffer-local-symbols*")); BUFFER_PVEC_INIT (&buffer_defaults); BUFFER_PVEC_INIT (&buffer_local_symbols); @@ -4797,7 +4797,7 @@ init_buffer_once (void) /* Must do these before making the first buffer! */ /* real setup is done in bindings.el */ - bset_mode_line_format (&buffer_defaults, build_pure_c_string ("%-")); + bset_mode_line_format (&buffer_defaults, build_string ("%-")); bset_header_line_format (&buffer_defaults, Qnil); bset_tab_line_format (&buffer_defaults, Qnil); bset_abbrev_mode (&buffer_defaults, Qnil); @@ -4865,7 +4865,7 @@ init_buffer_once (void) current_buffer = 0; pdumper_remember_lv_ptr_raw (¤t_buffer, Lisp_Vectorlike); - QSFundamental = build_pure_c_string ("Fundamental"); + QSFundamental = build_string ("Fundamental"); DEFSYM (Qfundamental_mode, "fundamental-mode"); bset_major_mode (&buffer_defaults, Qfundamental_mode); @@ -4879,10 +4879,10 @@ init_buffer_once (void) /* Super-magic invisible buffer. */ Vprin1_to_string_buffer = - Fget_buffer_create (build_pure_c_string (" prin1"), Qt); + Fget_buffer_create (build_string (" prin1"), Qt); Vbuffer_alist = Qnil; - Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*"), Qnil)); + Fset_buffer (Fget_buffer_create (build_string ("*scratch*"), Qnil)); inhibit_modification_hooks = 0; } @@ -5066,9 +5066,9 @@ syms_of_buffer (void) Qoverwrite_mode_binary)); Fput (Qprotected_field, Qerror_conditions, - pure_list (Qprotected_field, Qerror)); + list (Qprotected_field, Qerror)); Fput (Qprotected_field, Qerror_message, - build_pure_c_string ("Attempt to modify a protected field")); + build_string ("Attempt to modify a protected field")); DEFSYM (Qclone_indirect_buffer_hook, "clone-indirect-buffer-hook"); diff --git a/src/bytecode.c b/src/bytecode.c index f719b036d14..75a040a8489 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1638,7 +1638,6 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, record_in_backtrace (Qsetcar, &TOP, 2); wrong_type_argument (Qconsp, cell); } - CHECK_IMPURE (cell, XCONS (cell)); XSETCAR (cell, newval); TOP = newval; NEXT; @@ -1653,7 +1652,6 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template, record_in_backtrace (Qsetcdr, &TOP, 2); wrong_type_argument (Qconsp, cell); } - CHECK_IMPURE (cell, XCONS (cell)); XSETCDR (cell, newval); TOP = newval; NEXT; diff --git a/src/callint.c b/src/callint.c index 1af9666e5a4..02279725bce 100644 --- a/src/callint.c +++ b/src/callint.c @@ -822,10 +822,10 @@ syms_of_callint (void) callint_message = Qnil; staticpro (&callint_message); - preserved_fns = pure_list (intern_c_string ("region-beginning"), - intern_c_string ("region-end"), - intern_c_string ("point"), - intern_c_string ("mark")); + preserved_fns = list (intern_c_string ("region-beginning"), + intern_c_string ("region-end"), + intern_c_string ("point"), + intern_c_string ("mark")); staticpro (&preserved_fns); DEFSYM (Qlist, "list"); diff --git a/src/callproc.c b/src/callproc.c index 3f2c60a2151..361fbebb93f 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -2171,9 +2171,9 @@ See `setenv' and `getenv'. */); Use this instead of calling `ctags' directly, as `ctags' may have been renamed to comply with executable naming restrictions on the system. */); #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY - Vctags_program_name = build_pure_c_string ("ctags"); + Vctags_program_name = build_string ("ctags"); #else - Vctags_program_name = build_pure_c_string ("libctags.so"); + Vctags_program_name = build_string ("libctags.so"); #endif DEFVAR_LISP ("etags-program-name", Vetags_program_name, @@ -2181,9 +2181,9 @@ renamed to comply with executable naming restrictions on the system. */); Use this instead of calling `etags' directly, as `etags' may have been renamed to comply with executable naming restrictions on the system. */); #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY - Vetags_program_name = build_pure_c_string ("etags"); + Vetags_program_name = build_string ("etags"); #else - Vetags_program_name = build_pure_c_string ("libetags.so"); + Vetags_program_name = build_string ("libetags.so"); #endif DEFVAR_LISP ("hexl-program-name", Vhexl_program_name, @@ -2191,9 +2191,9 @@ renamed to comply with executable naming restrictions on the system. */); Use this instead of calling `hexl' directly, as `hexl' may have been renamed to comply with executable naming restrictions on the system. */); #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY - Vhexl_program_name = build_pure_c_string ("hexl"); + Vhexl_program_name = build_string ("hexl"); #else - Vhexl_program_name = build_pure_c_string ("libhexl.so"); + Vhexl_program_name = build_string ("libhexl.so"); #endif DEFVAR_LISP ("emacsclient-program-name", Vemacsclient_program_name, @@ -2202,9 +2202,9 @@ Use this instead of calling `emacsclient' directly, as `emacsclient' may have been renamed to comply with executable naming restrictions on the system. */); #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY - Vemacsclient_program_name = build_pure_c_string ("emacsclient"); + Vemacsclient_program_name = build_string ("emacsclient"); #else - Vemacsclient_program_name = build_pure_c_string ("libemacsclient.so"); + Vemacsclient_program_name = build_string ("libemacsclient.so"); #endif DEFVAR_LISP ("movemail-program-name", Vmovemail_program_name, @@ -2216,9 +2216,9 @@ the system. */); use movemail from another source. */ #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY \ || defined HAVE_MAILUTILS - Vmovemail_program_name = build_pure_c_string ("movemail"); + Vmovemail_program_name = build_string ("movemail"); #else - Vmovemail_program_name = build_pure_c_string ("libmovemail.so"); + Vmovemail_program_name = build_string ("libmovemail.so"); #endif DEFVAR_LISP ("ebrowse-program-name", Vebrowse_program_name, @@ -2227,9 +2227,9 @@ Use this instead of calling `ebrowse' directly, as `ebrowse' may have been renamed to comply with executable naming restrictions on the system. */); #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY - Vebrowse_program_name = build_pure_c_string ("ebrowse"); + Vebrowse_program_name = build_string ("ebrowse"); #else - Vebrowse_program_name = build_pure_c_string ("libebrowse.so"); + Vebrowse_program_name = build_string ("libebrowse.so"); #endif DEFVAR_LISP ("rcs2log-program-name", Vrcs2log_program_name, @@ -2238,9 +2238,9 @@ Use this instead of calling `rcs2log' directly, as `rcs2log' may have been renamed to comply with executable naming restrictions on the system. */); #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY - Vrcs2log_program_name = build_pure_c_string ("rcs2log"); + Vrcs2log_program_name = build_string ("rcs2log"); #else /* HAVE_ANDROID && !ANDROID_STUBIFY */ - Vrcs2log_program_name = build_pure_c_string ("librcs2log.so"); + Vrcs2log_program_name = build_string ("librcs2log.so"); #endif /* !HAVE_ANDROID || ANDROID_STUBIFY */ defsubr (&Scall_process); diff --git a/src/category.c b/src/category.c index 498b6a2a1c9..ef29a1a681a 100644 --- a/src/category.c +++ b/src/category.c @@ -118,8 +118,6 @@ the current buffer's category table. */) if (!NILP (CATEGORY_DOCSTRING (table, XFIXNAT (category)))) error ("Category `%c' is already defined", (int) XFIXNAT (category)); - if (!NILP (Vpurify_flag)) - docstring = Fpurecopy (docstring); SET_CATEGORY_DOCSTRING (table, XFIXNAT (category), docstring); return Qnil; diff --git a/src/coding.c b/src/coding.c index cd5a12972e6..ae7979d86eb 100644 --- a/src/coding.c +++ b/src/coding.c @@ -11766,7 +11766,7 @@ syms_of_coding (void) Vcode_conversion_reused_workbuf = Qnil; staticpro (&Vcode_conversion_workbuf_name); - Vcode_conversion_workbuf_name = build_pure_c_string (" *code-conversion-work*"); + Vcode_conversion_workbuf_name = build_string (" *code-conversion-work*"); reused_workbuf_in_use = false; PDUMPER_REMEMBER_SCALAR (reused_workbuf_in_use); @@ -11830,9 +11830,9 @@ syms_of_coding (void) /* Error signaled when there's a problem with detecting a coding system. */ DEFSYM (Qcoding_system_error, "coding-system-error"); Fput (Qcoding_system_error, Qerror_conditions, - pure_list (Qcoding_system_error, Qerror)); + list (Qcoding_system_error, Qerror)); Fput (Qcoding_system_error, Qerror_message, - build_pure_c_string ("Invalid coding system")); + build_string ("Invalid coding system")); DEFSYM (Qtranslation_table, "translation-table"); Fput (Qtranslation_table, Qchar_table_extra_slots, make_fixnum (2)); @@ -12107,22 +12107,22 @@ used for encoding standard output and error streams. */); DEFVAR_LISP ("eol-mnemonic-unix", eol_mnemonic_unix, doc: /* String displayed in mode line for UNIX-like (LF) end-of-line format. */); - eol_mnemonic_unix = build_pure_c_string (":"); + eol_mnemonic_unix = build_string (":"); DEFVAR_LISP ("eol-mnemonic-dos", eol_mnemonic_dos, doc: /* String displayed in mode line for DOS-like (CRLF) end-of-line format. */); - eol_mnemonic_dos = build_pure_c_string ("\\"); + eol_mnemonic_dos = build_string ("\\"); DEFVAR_LISP ("eol-mnemonic-mac", eol_mnemonic_mac, doc: /* String displayed in mode line for MAC-like (CR) end-of-line format. */); - eol_mnemonic_mac = build_pure_c_string ("/"); + eol_mnemonic_mac = build_string ("/"); DEFVAR_LISP ("eol-mnemonic-undecided", eol_mnemonic_undecided, doc: /* String displayed in mode line when end-of-line format is not yet determined. */); - eol_mnemonic_undecided = build_pure_c_string (":"); + eol_mnemonic_undecided = build_string (":"); DEFVAR_LISP ("enable-character-translation", Venable_character_translation, doc: /* @@ -12262,7 +12262,7 @@ internal character representation. */); intern_c_string (":for-unibyte"), args[coding_arg_for_unibyte] = Qt, intern_c_string (":docstring"), - (build_pure_c_string + (build_string ("Do no conversion.\n" "\n" "When you visit a file with this coding, the file is read into a\n" @@ -12282,7 +12282,7 @@ internal character representation. */); plist[8] = intern_c_string (":charset-list"); plist[9] = args[coding_arg_charset_list] = list1 (Qascii); plist[11] = args[coding_arg_for_unibyte] = Qnil; - plist[13] = build_pure_c_string ("No conversion on encoding, " + plist[13] = build_string ("No conversion on encoding, " "automatic conversion on decoding."); plist[15] = args[coding_arg_eol_type] = Qnil; args[coding_arg_plist] = CALLMANY (Flist, plist); diff --git a/src/comp.c b/src/comp.c index e89385de1d6..e43732f369e 100644 --- a/src/comp.c +++ b/src/comp.c @@ -4961,7 +4961,6 @@ DEFUN ("comp--compile-ctxt-to-file0", Fcomp__compile_ctxt_to_file0, define_GET_SYMBOL_WITH_POSITION (); define_CHECK_TYPE (); define_SYMBOL_WITH_POS_SYM (); - define_CHECK_IMPURE (); define_bool_to_lisp_obj (); define_setcar_setcdr (); define_add1_sub1 (); @@ -5209,10 +5208,10 @@ maybe_defer_native_compilation (Lisp_Object function_name, Lisp_Object src = concat2 (CALL1I (file-name-sans-extension, Vload_true_file_name), - build_pure_c_string (".el")); + build_string (".el")); if (NILP (Ffile_exists_p (src))) { - src = concat2 (src, build_pure_c_string (".gz")); + src = concat2 (src, build_string (".gz")); if (NILP (Ffile_exists_p (src))) return; } @@ -5767,48 +5766,48 @@ natively-compiled one. */); /* To be signaled by the compiler. */ DEFSYM (Qnative_compiler_error, "native-compiler-error"); Fput (Qnative_compiler_error, Qerror_conditions, - pure_list (Qnative_compiler_error, Qerror)); + list (Qnative_compiler_error, Qerror)); Fput (Qnative_compiler_error, Qerror_message, - build_pure_c_string ("Native compiler error")); + build_string ("Native compiler error")); DEFSYM (Qnative_ice, "native-ice"); Fput (Qnative_ice, Qerror_conditions, - pure_list (Qnative_ice, Qnative_compiler_error, Qerror)); + list (Qnative_ice, Qnative_compiler_error, Qerror)); Fput (Qnative_ice, Qerror_message, - build_pure_c_string ("Internal native compiler error")); + build_string ("Internal native compiler error")); /* By the load machinery. */ DEFSYM (Qnative_lisp_load_failed, "native-lisp-load-failed"); Fput (Qnative_lisp_load_failed, Qerror_conditions, - pure_list (Qnative_lisp_load_failed, Qerror)); + list (Qnative_lisp_load_failed, Qerror)); Fput (Qnative_lisp_load_failed, Qerror_message, - build_pure_c_string ("Native elisp load failed")); + build_string ("Native elisp load failed")); DEFSYM (Qnative_lisp_wrong_reloc, "native-lisp-wrong-reloc"); Fput (Qnative_lisp_wrong_reloc, Qerror_conditions, - pure_list (Qnative_lisp_wrong_reloc, Qnative_lisp_load_failed, Qerror)); + list (Qnative_lisp_wrong_reloc, Qnative_lisp_load_failed, Qerror)); Fput (Qnative_lisp_wrong_reloc, Qerror_message, - build_pure_c_string ("Primitive redefined or wrong relocation")); + build_string ("Primitive redefined or wrong relocation")); DEFSYM (Qwrong_register_subr_call, "wrong-register-subr-call"); Fput (Qwrong_register_subr_call, Qerror_conditions, - pure_list (Qwrong_register_subr_call, Qnative_lisp_load_failed, Qerror)); + list (Qwrong_register_subr_call, Qnative_lisp_load_failed, Qerror)); Fput (Qwrong_register_subr_call, Qerror_message, - build_pure_c_string ("comp--register-subr can only be called during " - "native lisp load phase.")); + build_string ("comp--register-subr can only be called during " + "native lisp load phase.")); DEFSYM (Qnative_lisp_file_inconsistent, "native-lisp-file-inconsistent"); Fput (Qnative_lisp_file_inconsistent, Qerror_conditions, - pure_list (Qnative_lisp_file_inconsistent, Qnative_lisp_load_failed, Qerror)); + list (Qnative_lisp_file_inconsistent, Qnative_lisp_load_failed, Qerror)); Fput (Qnative_lisp_file_inconsistent, Qerror_message, - build_pure_c_string ("eln file inconsistent with current runtime " - "configuration, please recompile")); + build_string ("eln file inconsistent with current runtime " + "configuration, please recompile")); DEFSYM (Qcomp_sanitizer_error, "comp-sanitizer-error"); Fput (Qcomp_sanitizer_error, Qerror_conditions, - pure_list (Qcomp_sanitizer_error, Qerror)); + list (Qcomp_sanitizer_error, Qerror)); Fput (Qcomp_sanitizer_error, Qerror_message, - build_pure_c_string ("Native code sanitizer runtime error")); + build_string ("Native code sanitizer runtime error")); DEFSYM (Qnative__compile_async, "native--compile-async"); diff --git a/src/data.c b/src/data.c index 95c1d857964..9492c8041c8 100644 --- a/src/data.c +++ b/src/data.c @@ -687,7 +687,6 @@ DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0, (register Lisp_Object cell, Lisp_Object newcar) { CHECK_CONS (cell); - CHECK_IMPURE (cell, XCONS (cell)); XSETCAR (cell, newcar); return newcar; } @@ -697,7 +696,6 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0, (register Lisp_Object cell, Lisp_Object newcdr) { CHECK_CONS (cell); - CHECK_IMPURE (cell, XCONS (cell)); XSETCDR (cell, newcdr); return newcdr; } @@ -995,10 +993,6 @@ The return value is undefined. */) (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring) { CHECK_SYMBOL (symbol); - if (!NILP (Vpurify_flag) - /* If `definition' is a keymap, immutable (and copying) is wrong. */ - && !KEYMAPP (definition)) - definition = Fpurecopy (definition); defalias (symbol, definition); @@ -2588,7 +2582,6 @@ bool-vector. IDX starts at 0. */) if (VECTORP (array)) { - CHECK_IMPURE (array, XVECTOR (array)); if (idxval < 0 || idxval >= ASIZE (array)) args_out_of_range (array, idx); ASET (array, idxval, newelt); @@ -2606,14 +2599,12 @@ bool-vector. IDX starts at 0. */) } else if (RECORDP (array)) { - CHECK_IMPURE (array, XVECTOR (array)); if (idxval < 0 || idxval >= PVSIZE (array)) args_out_of_range (array, idx); ASET (array, idxval, newelt); } else /* STRINGP */ { - CHECK_IMPURE (array, XSTRING (array)); if (idxval < 0 || idxval >= SCHARS (array)) args_out_of_range (array, idx); CHECK_CHARACTER (newelt); @@ -4072,7 +4063,7 @@ syms_of_data (void) DEFSYM (Qaref, "aref"); DEFSYM (Qaset, "aset"); - error_tail = pure_cons (Qerror, Qnil); + error_tail = Fcons (Qerror, Qnil); /* ERROR is used as a signaler for random errors for which nothing else is right. */ @@ -4080,14 +4071,14 @@ syms_of_data (void) Fput (Qerror, Qerror_conditions, error_tail); Fput (Qerror, Qerror_message, - build_pure_c_string ("error")); + build_string ("error")); #define PUT_ERROR(sym, tail, msg) \ - Fput (sym, Qerror_conditions, pure_cons (sym, tail)); \ - Fput (sym, Qerror_message, build_pure_c_string (msg)) + Fput (sym, Qerror_conditions, Fcons (sym, tail)); \ + Fput (sym, Qerror_message, build_string (msg)) PUT_ERROR (Qquit, Qnil, "Quit"); - PUT_ERROR (Qminibuffer_quit, pure_cons (Qquit, Qnil), "Quit"); + PUT_ERROR (Qminibuffer_quit, Fcons (Qquit, Qnil), "Quit"); PUT_ERROR (Quser_error, error_tail, ""); PUT_ERROR (Qwrong_length_argument, error_tail, "Wrong length argument"); @@ -4114,14 +4105,14 @@ syms_of_data (void) PUT_ERROR (Qno_catch, error_tail, "No catch for tag"); PUT_ERROR (Qend_of_file, error_tail, "End of file during parsing"); - arith_tail = pure_cons (Qarith_error, error_tail); + arith_tail = Fcons (Qarith_error, error_tail); Fput (Qarith_error, Qerror_conditions, arith_tail); - Fput (Qarith_error, Qerror_message, build_pure_c_string ("Arithmetic error")); + Fput (Qarith_error, Qerror_message, build_string ("Arithmetic error")); PUT_ERROR (Qbeginning_of_buffer, error_tail, "Beginning of buffer"); PUT_ERROR (Qend_of_buffer, error_tail, "End of buffer"); PUT_ERROR (Qbuffer_read_only, error_tail, "Buffer is read-only"); - PUT_ERROR (Qtext_read_only, pure_cons (Qbuffer_read_only, error_tail), + PUT_ERROR (Qtext_read_only, Fcons (Qbuffer_read_only, error_tail), "Text is read-only"); PUT_ERROR (Qinhibited_interaction, error_tail, "User interaction while inhibited"); @@ -4144,10 +4135,10 @@ syms_of_data (void) PUT_ERROR (Qunderflow_error, Fcons (Qrange_error, arith_tail), "Arithmetic underflow error"); - recursion_tail = pure_cons (Qrecursion_error, error_tail); + recursion_tail = Fcons (Qrecursion_error, error_tail); Fput (Qrecursion_error, Qerror_conditions, recursion_tail); - Fput (Qrecursion_error, Qerror_message, build_pure_c_string - ("Excessive recursive calling error")); + Fput (Qrecursion_error, Qerror_message, + build_string ("Excessive recursive calling error")); PUT_ERROR (Qexcessive_lisp_nesting, recursion_tail, "Lisp nesting exceeds `max-lisp-eval-depth'"); diff --git a/src/dbusbind.c b/src/dbusbind.c index 1a8bcfdf5d4..ab48936cc87 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1909,7 +1909,7 @@ syms_of_dbusbind (void) Fput (Qdbus_error, Qerror_conditions, list2 (Qdbus_error, Qerror)); Fput (Qdbus_error, Qerror_message, - build_pure_c_string ("D-Bus error")); + build_string ("D-Bus error")); DEFSYM (QD_Bus, "D-Bus"); /* Lisp symbols of the system and session buses. */ @@ -1959,7 +1959,7 @@ syms_of_dbusbind (void) Vdbus_compiled_version, doc: /* The version of D-Bus Emacs is compiled against. */); #ifdef DBUS_VERSION_STRING - Vdbus_compiled_version = build_pure_c_string (DBUS_VERSION_STRING); + Vdbus_compiled_version = build_string (DBUS_VERSION_STRING); #else Vdbus_compiled_version = Qnil; #endif diff --git a/src/doc.c b/src/doc.c index fdb61be2097..6f74a999366 100644 --- a/src/doc.c +++ b/src/doc.c @@ -559,7 +559,6 @@ the same file name is found in the `doc-directory'. */) int i = ARRAYELTS (buildobj); while (0 <= --i) Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files); - Vbuild_files = Fpurecopy (Vbuild_files); } fd = doc_open (name, O_RDONLY, 0); diff --git a/src/emacs-module.c b/src/emacs-module.c index e267ba165fd..d818b6cdeb9 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1713,40 +1713,40 @@ syms_of_module (void) DEFSYM (Qmodule_load_failed, "module-load-failed"); Fput (Qmodule_load_failed, Qerror_conditions, - pure_list (Qmodule_load_failed, Qerror)); + list (Qmodule_load_failed, Qerror)); Fput (Qmodule_load_failed, Qerror_message, - build_pure_c_string ("Module load failed")); + build_string ("Module load failed")); DEFSYM (Qmodule_open_failed, "module-open-failed"); Fput (Qmodule_open_failed, Qerror_conditions, - pure_list (Qmodule_open_failed, Qmodule_load_failed, Qerror)); + list (Qmodule_open_failed, Qmodule_load_failed, Qerror)); Fput (Qmodule_open_failed, Qerror_message, - build_pure_c_string ("Module could not be opened")); + build_string ("Module could not be opened")); DEFSYM (Qmodule_not_gpl_compatible, "module-not-gpl-compatible"); Fput (Qmodule_not_gpl_compatible, Qerror_conditions, - pure_list (Qmodule_not_gpl_compatible, Qmodule_load_failed, Qerror)); + list (Qmodule_not_gpl_compatible, Qmodule_load_failed, Qerror)); Fput (Qmodule_not_gpl_compatible, Qerror_message, - build_pure_c_string ("Module is not GPL compatible")); + build_string ("Module is not GPL compatible")); DEFSYM (Qmissing_module_init_function, "missing-module-init-function"); Fput (Qmissing_module_init_function, Qerror_conditions, - pure_list (Qmissing_module_init_function, Qmodule_load_failed, - Qerror)); + list (Qmissing_module_init_function, Qmodule_load_failed, + Qerror)); Fput (Qmissing_module_init_function, Qerror_message, - build_pure_c_string ("Module does not export an " + build_string ("Module does not export an " "initialization function")); DEFSYM (Qmodule_init_failed, "module-init-failed"); Fput (Qmodule_init_failed, Qerror_conditions, - pure_list (Qmodule_init_failed, Qmodule_load_failed, Qerror)); + list (Qmodule_init_failed, Qmodule_load_failed, Qerror)); Fput (Qmodule_init_failed, Qerror_message, - build_pure_c_string ("Module initialization failed")); + build_string ("Module initialization failed")); DEFSYM (Qinvalid_arity, "invalid-arity"); - Fput (Qinvalid_arity, Qerror_conditions, pure_list (Qinvalid_arity, Qerror)); + Fput (Qinvalid_arity, Qerror_conditions, list (Qinvalid_arity, Qerror)); Fput (Qinvalid_arity, Qerror_message, - build_pure_c_string ("Invalid function arity")); + build_string ("Invalid function arity")); DEFSYM (Qmodule_function_p, "module-function-p"); DEFSYM (Qunicode_string_p, "unicode-string-p"); diff --git a/src/eval.c b/src/eval.c index d0a2abf0089..6d0e8f101d7 100644 --- a/src/eval.c +++ b/src/eval.c @@ -817,8 +817,6 @@ value. */) XSYMBOL (symbol)->u.s.declared_special = true; if (!NILP (doc)) { - if (!NILP (Vpurify_flag)) - doc = Fpurecopy (doc); Fput (symbol, Qvariable_documentation, doc); } LOADHIST_ATTACH (symbol); @@ -967,8 +965,6 @@ More specifically, behaves like (defconst SYM 'INITVALUE DOCSTRING). */) CHECK_SYMBOL (sym); Lisp_Object tem = initvalue; Finternal__define_uninitialized_variable (sym, docstring); - if (!NILP (Vpurify_flag)) - tem = Fpurecopy (tem); Fset_default (sym, tem); /* FIXME: set-default-toplevel-value? */ Fput (sym, Qrisky_local_variable, Qt); /* FIXME: Why? */ return sym; @@ -2001,8 +1997,8 @@ define_error (Lisp_Object name, const char *message, Lisp_Object parent) eassert (CONSP (parent_conditions)); eassert (!NILP (Fmemq (parent, parent_conditions))); eassert (NILP (Fmemq (name, parent_conditions))); - Fput (name, Qerror_conditions, pure_cons (name, parent_conditions)); - Fput (name, Qerror_message, build_pure_c_string (message)); + Fput (name, Qerror_conditions, Fcons (name, parent_conditions)); + Fput (name, Qerror_message, build_string (message)); } /* Use this for arithmetic overflow, e.g., when an integer result is @@ -4477,7 +4473,7 @@ alist of active lexical bindings. */); also use something like Fcons (Qnil, Qnil), but json.c treats any cons cell as error data, so use an uninterned symbol instead. */ Qcatch_all_memory_full - = Fmake_symbol (build_pure_c_string ("catch-all-memory-full")); + = Fmake_symbol (build_string ("catch-all-memory-full")); staticpro (&list_of_t); list_of_t = list1 (Qt); diff --git a/src/fileio.c b/src/fileio.c index 94bb496f22c..30ed2ddeb55 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -6666,39 +6666,39 @@ behaves as if file names were encoded in `utf-8'. */); DEFSYM (Qcar_less_than_car, "car-less-than-car"); Fput (Qfile_error, Qerror_conditions, - Fpurecopy (list2 (Qfile_error, Qerror))); + list2 (Qfile_error, Qerror)); Fput (Qfile_error, Qerror_message, - build_pure_c_string ("File error")); + build_string ("File error")); Fput (Qfile_already_exists, Qerror_conditions, - Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror))); + list3 (Qfile_already_exists, Qfile_error, Qerror)); Fput (Qfile_already_exists, Qerror_message, - build_pure_c_string ("File already exists")); + build_string ("File already exists")); Fput (Qfile_date_error, Qerror_conditions, - Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror))); + list3 (Qfile_date_error, Qfile_error, Qerror)); Fput (Qfile_date_error, Qerror_message, - build_pure_c_string ("Cannot set file date")); + build_string ("Cannot set file date")); Fput (Qfile_missing, Qerror_conditions, - Fpurecopy (list3 (Qfile_missing, Qfile_error, Qerror))); + list3 (Qfile_missing, Qfile_error, Qerror)); Fput (Qfile_missing, Qerror_message, - build_pure_c_string ("File is missing")); + build_string ("File is missing")); Fput (Qpermission_denied, Qerror_conditions, - Fpurecopy (list3 (Qpermission_denied, Qfile_error, Qerror))); + list3 (Qpermission_denied, Qfile_error, Qerror)); Fput (Qpermission_denied, Qerror_message, - build_pure_c_string ("Cannot access file or directory")); + build_string ("Cannot access file or directory")); Fput (Qfile_notify_error, Qerror_conditions, - Fpurecopy (list3 (Qfile_notify_error, Qfile_error, Qerror))); + list3 (Qfile_notify_error, Qfile_error, Qerror)); Fput (Qfile_notify_error, Qerror_message, - build_pure_c_string ("File notification error")); + build_string ("File notification error")); Fput (Qremote_file_error, Qerror_conditions, - Fpurecopy (list3 (Qremote_file_error, Qfile_error, Qerror))); + list3 (Qremote_file_error, Qfile_error, Qerror)); Fput (Qremote_file_error, Qerror_message, - build_pure_c_string ("Remote file error")); + build_string ("Remote file error")); DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist, doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially. diff --git a/src/fns.c b/src/fns.c index cf337dc0808..75fd20a2d79 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3266,7 +3266,6 @@ ARRAY is a vector, string, char-table, or bool-vector. */) size = SCHARS (array); if (size != 0) { - CHECK_IMPURE (array, XSTRING (array)); unsigned char str[MAX_MULTIBYTE_LENGTH]; int len; if (STRING_MULTIBYTE (array)) @@ -3307,7 +3306,6 @@ This makes STRING unibyte and may change its length. */) ptrdiff_t len = SBYTES (string); if (len != 0 || STRING_MULTIBYTE (string)) { - CHECK_IMPURE (string, XSTRING (string)); memset (SDATA (string), 0, len); STRING_SET_CHARS (string, len); STRING_SET_UNIBYTE (string); @@ -5127,7 +5125,6 @@ check_mutable_hash_table (Lisp_Object obj, struct Lisp_Hash_Table *h) { if (!h->mutable) signal_error ("hash table test modifies table", obj); - eassert (!PURE_P (h)); } /* Put an entry into hash table H that associates KEY with VALUE. diff --git a/src/fontset.c b/src/fontset.c index 755942138f7..ea35bb05e74 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -2174,7 +2174,7 @@ syms_of_fontset (void) set_fontset_id (Vdefault_fontset, make_fixnum (0)); set_fontset_name (Vdefault_fontset, - build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default")); + build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default")); ASET (Vfontset_table, 0, Vdefault_fontset); next_fontset_id = 1; PDUMPER_REMEMBER_SCALAR (next_fontset_id); @@ -2232,7 +2232,7 @@ alternate fontnames (if any) are tried instead. */); doc: /* Alist of fontset names vs the aliases. */); Vfontset_alias_alist = list1 (Fcons (FONTSET_NAME (Vdefault_fontset), - build_pure_c_string ("fontset-default"))); + build_string ("fontset-default"))); DEFVAR_LISP ("vertical-centering-font-regexp", Vvertical_centering_font_regexp, diff --git a/src/frame.c b/src/frame.c index f6053fca3ef..78fa41bbe62 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1207,7 +1207,7 @@ make_initial_frame (void) Vframe_list = Fcons (frame, Vframe_list); tty_frame_count = 1; - fset_name (f, build_pure_c_string ("F1")); + fset_name (f, build_string ("F1")); SET_FRAME_VISIBLE (f, 1); diff --git a/src/haikufns.c b/src/haikufns.c index b4b88b434e4..c92dfe64ebc 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -3300,7 +3300,7 @@ invalid color. */); int len = sprintf (cairo_version, "%d.%d.%d", CAIRO_VERSION_MAJOR, CAIRO_VERSION_MINOR, CAIRO_VERSION_MICRO); - Vcairo_version_string = make_pure_string (cairo_version, len, len, false); + Vcairo_version_string = make_specified_string (cairo_version, len, len, false); } #endif diff --git a/src/intervals.c b/src/intervals.c index cebb77a3614..0e4ad249dc1 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -100,7 +100,6 @@ create_root_interval (Lisp_Object parent) } else { - CHECK_IMPURE (parent, XSTRING (parent)); new->total_length = SCHARS (parent); eassert (TOTAL_LENGTH (new) >= 0); set_string_intervals (parent, new); diff --git a/src/keyboard.c b/src/keyboard.c index 6d28dca9aeb..ab6dd65d5fc 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -12841,14 +12841,14 @@ syms_of_keyboard (void) pending_funcalls = Qnil; staticpro (&pending_funcalls); - Vlispy_mouse_stem = build_pure_c_string ("mouse"); + Vlispy_mouse_stem = build_string ("mouse"); staticpro (&Vlispy_mouse_stem); - regular_top_level_message = build_pure_c_string ("Back to top level"); + regular_top_level_message = build_string ("Back to top level"); staticpro (®ular_top_level_message); #ifdef HAVE_STACK_OVERFLOW_HANDLING recover_top_level_message - = build_pure_c_string ("Re-entering top level after C stack overflow"); + = build_string ("Re-entering top level after C stack overflow"); staticpro (&recover_top_level_message); #endif DEFVAR_LISP ("internal--top-level-message", Vinternal__top_level_message, diff --git a/src/keymap.c b/src/keymap.c index 7f464ed9159..a625ec9d8ca 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -120,8 +120,6 @@ in case you use it as a menu with `x-popup-menu'. */) { if (!NILP (string)) { - if (!NILP (Vpurify_flag)) - string = Fpurecopy (string); return list2 (Qkeymap, string); } return list1 (Qkeymap); @@ -300,7 +298,6 @@ Return PARENT. PARENT should be nil or another keymap. */) If we came to the end, add the parent in PREV. */ if (!CONSP (list) || KEYMAPP (list)) { - CHECK_IMPURE (prev, XCONS (prev)); XSETCDR (prev, parent); return parent; } @@ -743,7 +740,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, /* If we are preparing to dump, and DEF is a menu element with a menu item indicator, copy it to ensure it is not pure. */ - if (CONSP (def) && PURE_P (XCONS (def)) + if (CONSP (def) && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def)))) def = Fcons (XCAR (def), XCDR (def)); @@ -787,7 +784,6 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, { if (FIXNATP (idx) && XFIXNAT (idx) < ASIZE (elt)) { - CHECK_IMPURE (elt, XVECTOR (elt)); ASET (elt, XFIXNAT (idx), def); return def; } @@ -845,7 +841,6 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, } else if (EQ (idx, XCAR (elt))) { - CHECK_IMPURE (elt, XCONS (elt)); if (remove) /* Remove the element. */ insertion_point = Fdelq (elt, insertion_point); @@ -900,7 +895,6 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, } else elt = Fcons (idx, def); - CHECK_IMPURE (insertion_point, XCONS (insertion_point)); XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point))); } } @@ -3356,12 +3350,12 @@ syms_of_keymap (void) current_global_map = Qnil; staticpro (¤t_global_map); - exclude_keys = pure_list - (pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")), - pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")), - pure_cons (build_pure_c_string ("RET"), build_pure_c_string ("\\r")), - pure_cons (build_pure_c_string ("ESC"), build_pure_c_string ("\\e")), - pure_cons (build_pure_c_string ("SPC"), build_pure_c_string (" "))); + exclude_keys = list + (Fcons (build_string ("DEL"), build_string ("\\d")), + Fcons (build_string ("TAB"), build_string ("\\t")), + Fcons (build_string ("RET"), build_string ("\\r")), + Fcons (build_string ("ESC"), build_string ("\\e")), + Fcons (build_string ("SPC"), build_string (" "))); staticpro (&exclude_keys); DEFVAR_LISP ("minibuffer-local-map", Vminibuffer_local_map, @@ -3423,13 +3417,13 @@ that describe key bindings. That is why the default is nil. */); DEFSYM (Qmode_line, "mode-line"); staticpro (&Vmouse_events); - Vmouse_events = pure_list (Qmenu_bar, Qtab_bar, Qtool_bar, - Qtab_line, Qheader_line, Qmode_line, - intern_c_string ("mouse-1"), - intern_c_string ("mouse-2"), - intern_c_string ("mouse-3"), - intern_c_string ("mouse-4"), - intern_c_string ("mouse-5")); + Vmouse_events = list (Qmenu_bar, Qtab_bar, Qtool_bar, Qtab_line, + Qheader_line, Qmode_line, + intern_c_string ("mouse-1"), + intern_c_string ("mouse-2"), + intern_c_string ("mouse-3"), + intern_c_string ("mouse-4"), + intern_c_string ("mouse-5")); /* Keymap used for minibuffers when doing completion. */ /* Keymap used for minibuffers when doing completion and require a match. */ diff --git a/src/lisp.h b/src/lisp.h index 4df3c999d73..93469a5c63e 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4584,7 +4584,6 @@ build_string (const char *str) return make_string (str, strlen (str)); } -extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object); extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t) ATTRIBUTE_RETURNS_NONNULL; diff --git a/src/lread.c b/src/lread.c index c25ffb3c4fe..a95abd687ac 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1673,7 +1673,7 @@ Return t if the file exists and loads successfully. */) } if (! NILP (Vpurify_flag)) - Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list); + Vpreloaded_file_list = Fcons (file, Vpreloaded_file_list); if (NILP (nomessage) || force_load_messages) { @@ -4433,10 +4433,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms) if (uninterned_symbol) { Lisp_Object name - = (!NILP (Vpurify_flag) - ? make_pure_string (read_buffer, nchars, nbytes, multibyte) - : make_specified_string (read_buffer, nchars, nbytes, - multibyte)); + = make_specified_string (read_buffer, nchars, nbytes, multibyte); result = Fmake_symbol (name); } else @@ -4968,10 +4965,7 @@ intern_c_string_1 (const char *str, ptrdiff_t len) { Lisp_Object string; - if (NILP (Vpurify_flag)) - string = make_string (str, len); - else - string = make_pure_c_string (str, len); + string = make_string (str, len); tem = intern_driver (string, obarray, tem); } @@ -4994,7 +4988,7 @@ static void define_symbol (Lisp_Object sym, char const *str) { ptrdiff_t len = strlen (str); - Lisp_Object string = make_pure_c_string (str, len); + Lisp_Object string = make_string (str, len); init_symbol (sym, string); /* Qunbound is uninterned, so that it's not confused with any symbol @@ -5038,8 +5032,7 @@ it defaults to the value of `obarray'. */) xfree (longhand); } else - tem = intern_driver (NILP (Vpurify_flag) ? string : Fpurecopy (string), - obarray, tem); + tem = intern_driver (string, obarray, tem); } return tem; } @@ -5483,7 +5476,7 @@ defsubr (union Aligned_Lisp_Subr *aname) set_symbol_function (sym, tem); #ifdef HAVE_NATIVE_COMP eassert (NILP (Vcomp_abi_hash)); - Vcomp_subr_list = Fpurecopy (Fcons (tem, Vcomp_subr_list)); + Vcomp_subr_list = Fcons (tem, Vcomp_subr_list); #endif } @@ -5869,19 +5862,19 @@ This list includes suffixes for both compiled and source Emacs Lisp files. This list should not include the empty string. `load' and related functions try to append these suffixes, in order, to the specified file name if a suffix is allowed or required. */); - Vload_suffixes = list2 (build_pure_c_string (".elc"), - build_pure_c_string (".el")); + Vload_suffixes = list2 (build_string (".elc"), + build_string (".el")); #ifdef HAVE_MODULES - Vload_suffixes = Fcons (build_pure_c_string (MODULES_SUFFIX), Vload_suffixes); + Vload_suffixes = Fcons (build_string (MODULES_SUFFIX), Vload_suffixes); #ifdef MODULES_SECONDARY_SUFFIX Vload_suffixes = - Fcons (build_pure_c_string (MODULES_SECONDARY_SUFFIX), Vload_suffixes); + Fcons (build_string (MODULES_SECONDARY_SUFFIX), Vload_suffixes); #endif #endif DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix, doc: /* Suffix of loadable module file, or nil if modules are not supported. */); #ifdef HAVE_MODULES - Vmodule_file_suffix = build_pure_c_string (MODULES_SUFFIX); + Vmodule_file_suffix = build_string (MODULES_SUFFIX); #else Vmodule_file_suffix = Qnil; #endif @@ -5891,9 +5884,9 @@ to the specified file name if a suffix is allowed or required. */); #ifndef MSDOS Vdynamic_library_suffixes - = Fcons (build_pure_c_string (DYNAMIC_LIB_SECONDARY_SUFFIX), Qnil); + = Fcons (build_string (DYNAMIC_LIB_SECONDARY_SUFFIX), Qnil); Vdynamic_library_suffixes - = Fcons (build_pure_c_string (DYNAMIC_LIB_SUFFIX), + = Fcons (build_string (DYNAMIC_LIB_SUFFIX), Vdynamic_library_suffixes); #else Vdynamic_library_suffixes = Qnil; @@ -6045,8 +6038,7 @@ from the file, and matches them against this regular expression. When the regular expression matches, the file is considered to be safe to load. */); Vbytecomp_version_regexp - = build_pure_c_string - ("^;;;.\\(?:in Emacs version\\|bytecomp version FSF\\)"); + = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)"); DEFSYM (Qlexical_binding, "lexical-binding"); DEFVAR_LISP ("lexical-binding", Vlexical_binding, @@ -6116,7 +6108,7 @@ through `require'. */); #if !IEEE_FLOATING_POINT for (int negative = 0; negative < 2; negative++) { - not_a_number[negative] = build_pure_c_string (&"-0.0e+NaN"[!negative]); + not_a_number[negative] = build_string (&"-0.0e+NaN"[!negative]); staticpro (¬_a_number[negative]); } #endif diff --git a/src/pdumper.c b/src/pdumper.c index 88e8e810adc..1d45e37d67e 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -4153,8 +4153,6 @@ types. */) CALLN (Ffuncall, intern_c_string ("load--fixup-all-elns")); #endif - check_pure_size (); - /* Clear out any detritus in memory. */ do { diff --git a/src/pgtkfns.c b/src/pgtkfns.c index f0fd3000965..42a7609b066 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -3847,7 +3847,7 @@ syms_of_pgtkfns (void) GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION); int len = strlen (ver); - Vgtk_version_string = make_pure_string (ver, len, len, false); + Vgtk_version_string = make_specified_string (ver, len, len, false); g_free (ver); } @@ -3861,7 +3861,7 @@ syms_of_pgtkfns (void) CAIRO_VERSION_MAJOR, CAIRO_VERSION_MINOR, CAIRO_VERSION_MICRO); int len = strlen (ver); - Vcairo_version_string = make_pure_string (ver, len, len, false); + Vcairo_version_string = make_specified_string (ver, len, len, false); g_free (ver); } diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 079945126e0..246604ec18b 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -7422,7 +7422,7 @@ syms_of_pgtkterm (void) DEFSYM (Qlatin_1, "latin-1"); xg_default_icon_file - = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); + = build_string ("icons/hicolor/scalable/apps/emacs.svg"); staticpro (&xg_default_icon_file); DEFSYM (Qx_gtk_map_stock, "x-gtk-map-stock"); diff --git a/src/process.c b/src/process.c index dcf08fd9b57..8075a2fe676 100644 --- a/src/process.c +++ b/src/process.c @@ -8987,7 +8987,7 @@ sentinel or a process filter function has an error. */); const struct socket_options *sopt; #define ADD_SUBFEATURE(key, val) \ - subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures) + subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures) ADD_SUBFEATURE (QCnowait, Qt); #ifdef DATAGRAM_SOCKETS @@ -9009,7 +9009,7 @@ sentinel or a process filter function has an error. */); ADD_SUBFEATURE (QCserver, Qt); for (sopt = socket_options; sopt->name; sopt++) - subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures); + subfeatures = Fcons (intern_c_string (sopt->name), subfeatures); Fprovide (intern_c_string ("make-network-process"), subfeatures); } diff --git a/src/search.c b/src/search.c index 24b1ee6bd3f..668dfee34ec 100644 --- a/src/search.c +++ b/src/search.c @@ -3454,19 +3454,19 @@ syms_of_search (void) DEFSYM (Qinvalid_regexp, "invalid-regexp"); Fput (Qsearch_failed, Qerror_conditions, - pure_list (Qsearch_failed, Qerror)); + list (Qsearch_failed, Qerror)); Fput (Qsearch_failed, Qerror_message, - build_pure_c_string ("Search failed")); + build_string ("Search failed")); Fput (Quser_search_failed, Qerror_conditions, - pure_list (Quser_search_failed, Quser_error, Qsearch_failed, Qerror)); + list (Quser_search_failed, Quser_error, Qsearch_failed, Qerror)); Fput (Quser_search_failed, Qerror_message, - build_pure_c_string ("Search failed")); + build_string ("Search failed")); Fput (Qinvalid_regexp, Qerror_conditions, - pure_list (Qinvalid_regexp, Qerror)); + list (Qinvalid_regexp, Qerror)); Fput (Qinvalid_regexp, Qerror_message, - build_pure_c_string ("Invalid regexp")); + build_string ("Invalid regexp")); re_match_object = Qnil; staticpro (&re_match_object); diff --git a/src/sqlite.c b/src/sqlite.c index 88b02339863..7b43f949a31 100644 --- a/src/sqlite.c +++ b/src/sqlite.c @@ -899,15 +899,15 @@ syms_of_sqlite (void) DEFSYM (Qsqlite_error, "sqlite-error"); Fput (Qsqlite_error, Qerror_conditions, - Fpurecopy (list2 (Qsqlite_error, Qerror))); + list2 (Qsqlite_error, Qerror)); Fput (Qsqlite_error, Qerror_message, - build_pure_c_string ("Database error")); + build_string ("Database error")); DEFSYM (Qsqlite_locked_error, "sqlite-locked-error"); Fput (Qsqlite_locked_error, Qerror_conditions, - Fpurecopy (list3 (Qsqlite_locked_error, Qsqlite_error, Qerror))); + list3 (Qsqlite_locked_error, Qsqlite_error, Qerror)); Fput (Qsqlite_locked_error, Qerror_message, - build_pure_c_string ("Database locked")); + build_string ("Database locked")); DEFSYM (Qsqlitep, "sqlitep"); DEFSYM (Qfalse, "false"); diff --git a/src/syntax.c b/src/syntax.c index a4ad61328e6..88eb579d9f3 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -3739,9 +3739,9 @@ syms_of_syntax (void) DEFSYM (Qscan_error, "scan-error"); Fput (Qscan_error, Qerror_conditions, - pure_list (Qscan_error, Qerror)); + list (Qscan_error, Qerror)); Fput (Qscan_error, Qerror_message, - build_pure_c_string ("Scan error")); + build_string ("Scan error")); DEFVAR_BOOL ("parse-sexp-ignore-comments", parse_sexp_ignore_comments, doc: /* Non-nil means `forward-sexp', etc., should treat comments as whitespace. */); diff --git a/src/treesit.c b/src/treesit.c index 28c94f307c0..f9c5c935adc 100644 --- a/src/treesit.c +++ b/src/treesit.c @@ -4437,43 +4437,43 @@ applies to LANGUAGE-A will be redirected to LANGUAGE-B instead. */); Fmake_variable_buffer_local (Qtreesit_language_remap_alist); staticpro (&Vtreesit_str_libtree_sitter); - Vtreesit_str_libtree_sitter = build_pure_c_string ("libtree-sitter-"); + Vtreesit_str_libtree_sitter = build_string ("libtree-sitter-"); staticpro (&Vtreesit_str_tree_sitter); - Vtreesit_str_tree_sitter = build_pure_c_string ("tree-sitter-"); + Vtreesit_str_tree_sitter = build_string ("tree-sitter-"); #ifndef WINDOWSNT staticpro (&Vtreesit_str_dot_0); - Vtreesit_str_dot_0 = build_pure_c_string (".0"); + Vtreesit_str_dot_0 = build_string (".0"); #endif staticpro (&Vtreesit_str_dot); - Vtreesit_str_dot = build_pure_c_string ("."); + Vtreesit_str_dot = build_string ("."); staticpro (&Vtreesit_str_question_mark); - Vtreesit_str_question_mark = build_pure_c_string ("?"); + Vtreesit_str_question_mark = build_string ("?"); staticpro (&Vtreesit_str_star); - Vtreesit_str_star = build_pure_c_string ("*"); + Vtreesit_str_star = build_string ("*"); staticpro (&Vtreesit_str_plus); - Vtreesit_str_plus = build_pure_c_string ("+"); + Vtreesit_str_plus = build_string ("+"); staticpro (&Vtreesit_str_pound_equal); - Vtreesit_str_pound_equal = build_pure_c_string ("#equal"); + Vtreesit_str_pound_equal = build_string ("#equal"); staticpro (&Vtreesit_str_pound_match); - Vtreesit_str_pound_match = build_pure_c_string ("#match"); + Vtreesit_str_pound_match = build_string ("#match"); staticpro (&Vtreesit_str_pound_pred); - Vtreesit_str_pound_pred = build_pure_c_string ("#pred"); + Vtreesit_str_pound_pred = build_string ("#pred"); staticpro (&Vtreesit_str_open_bracket); - Vtreesit_str_open_bracket = build_pure_c_string ("["); + Vtreesit_str_open_bracket = build_string ("["); staticpro (&Vtreesit_str_close_bracket); - Vtreesit_str_close_bracket = build_pure_c_string ("]"); + Vtreesit_str_close_bracket = build_string ("]"); staticpro (&Vtreesit_str_open_paren); - Vtreesit_str_open_paren = build_pure_c_string ("("); + Vtreesit_str_open_paren = build_string ("("); staticpro (&Vtreesit_str_close_paren); - Vtreesit_str_close_paren = build_pure_c_string (")"); + Vtreesit_str_close_paren = build_string (")"); staticpro (&Vtreesit_str_space); - Vtreesit_str_space = build_pure_c_string (" "); + Vtreesit_str_space = build_string (" "); staticpro (&Vtreesit_str_equal); - Vtreesit_str_equal = build_pure_c_string ("equal"); + Vtreesit_str_equal = build_string ("equal"); staticpro (&Vtreesit_str_match); - Vtreesit_str_match = build_pure_c_string ("match"); + Vtreesit_str_match = build_string ("match"); staticpro (&Vtreesit_str_pred); - Vtreesit_str_pred = build_pure_c_string ("pred"); + Vtreesit_str_pred = build_string ("pred"); defsubr (&Streesit_language_available_p); defsubr (&Streesit_library_abi_version); diff --git a/src/w32fns.c b/src/w32fns.c index e2455b9271e..8f1b851a986 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -11066,9 +11066,9 @@ syms_of_w32fns (void) DEFSYM (Qjson, "json"); Fput (Qundefined_color, Qerror_conditions, - pure_list (Qundefined_color, Qerror)); + list (Qundefined_color, Qerror)); Fput (Qundefined_color, Qerror_message, - build_pure_c_string ("Undefined color")); + build_string ("Undefined color")); staticpro (&w32_grabbed_keys); w32_grabbed_keys = Qnil; diff --git a/src/xdisp.c b/src/xdisp.c index d5ec3e404d0..04f31519cb8 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -37670,7 +37670,7 @@ See also `overlay-arrow-string'. */); DEFVAR_LISP ("overlay-arrow-string", Voverlay_arrow_string, doc: /* String to display as an arrow in text-mode frames. See also `overlay-arrow-position'. */); - Voverlay_arrow_string = build_pure_c_string ("=>"); + Voverlay_arrow_string = build_string ("=>"); DEFVAR_LISP ("overlay-arrow-variable-list", Voverlay_arrow_variable_list, doc: /* List of variables (symbols) which hold markers for overlay arrows. @@ -37803,17 +37803,17 @@ as `mode-line-format' (which see), and is used only on frames for which no explicit name has been set \(see `modify-frame-parameters'). If the value is t, that means use `frame-title-format' for iconified frames. */); - /* Do not nest calls to pure_list. This works around a bug in + /* Do not nest calls to list. This works around a bug in Oracle Developer Studio 12.6. */ Lisp_Object icon_title_name_format - = pure_list (empty_unibyte_string, - build_pure_c_string ("%b - GNU Emacs at "), - intern_c_string ("system-name")); + = list (empty_unibyte_string, + build_string ("%b - GNU Emacs at "), + intern_c_string ("system-name")); Vicon_title_format = Vframe_title_format - = pure_list (intern_c_string ("multiple-frames"), - build_pure_c_string ("%b"), - icon_title_name_format); + = list (intern_c_string ("multiple-frames"), + build_string ("%b"), + icon_title_name_format); DEFVAR_LISP ("message-log-max", Vmessage_log_max, doc: /* Maximum number of lines to keep in the message log buffer. diff --git a/src/xfaces.c b/src/xfaces.c index f6264802fa4..7763fdd4953 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -7525,7 +7525,7 @@ only for this purpose. */); This stipple pattern is used on monochrome displays instead of shades of gray for a face background color. See `set-face-stipple' for possible values for this variable. */); - Vface_default_stipple = build_pure_c_string ("gray3"); + Vface_default_stipple = build_string ("gray3"); DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist, doc: /* An alist of defined terminal colors and their RGB values. diff --git a/src/xfns.c b/src/xfns.c index 3f0d8f3fcd0..941f37f3654 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -10257,9 +10257,9 @@ syms_of_xfns (void) DEFSYM (QXdndActionPrivate, "XdndActionPrivate"); Fput (Qundefined_color, Qerror_conditions, - pure_list (Qundefined_color, Qerror)); + list (Qundefined_color, Qerror)); Fput (Qundefined_color, Qerror_message, - build_pure_c_string ("Undefined color")); + build_string ("Undefined color")); DEFVAR_LISP ("x-pointer-shape", Vx_pointer_shape, doc: /* The shape of the pointer when over text. @@ -10486,7 +10486,7 @@ eliminated in future versions of Emacs. */); char gtk_version[sizeof ".." + 3 * INT_STRLEN_BOUND (int)]; int len = sprintf (gtk_version, "%d.%d.%d", GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION); - Vgtk_version_string = make_pure_string (gtk_version, len, len, false); + Vgtk_version_string = make_specified_string (gtk_version, len, len, false); } #endif /* USE_GTK */ @@ -10500,7 +10500,8 @@ eliminated in future versions of Emacs. */); int len = sprintf (cairo_version, "%d.%d.%d", CAIRO_VERSION_MAJOR, CAIRO_VERSION_MINOR, CAIRO_VERSION_MICRO); - Vcairo_version_string = make_pure_string (cairo_version, len, len, false); + Vcairo_version_string = make_specified_string (cairo_version, len, len, + false); } #endif diff --git a/src/xftfont.c b/src/xftfont.c index 41941509bc2..489a343d4e8 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -810,7 +810,7 @@ do not actually have glyphs with colors that can cause Xft crashes. The font families in this list will not be ignored when `xft-ignore-color-fonts' is non-nil. */); - Vxft_color_font_whitelist = list1 (build_pure_c_string ("Source Code Pro")); + Vxft_color_font_whitelist = list1 (build_string ("Source Code Pro")); pdumper_do_now_and_after_load (syms_of_xftfont_for_pdumper); } diff --git a/src/xterm.c b/src/xterm.c index 0c20d38b0f7..f78b20e0d58 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -32590,7 +32590,7 @@ syms_of_xterm (void) DEFSYM (Qwheel_right, "wheel-right"); #ifdef USE_GTK - xg_default_icon_file = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); + xg_default_icon_file = build_string ("icons/hicolor/scalable/apps/emacs.svg"); staticpro (&xg_default_icon_file); DEFSYM (Qx_gtk_map_stock, "x-gtk-map-stock"); From e1e101c6c10b6e5110c2c47946d477a752828a78 Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 20 Aug 2024 19:02:29 +0000 Subject: [PATCH 08/57] Pure storage removal: Remove support for pinned objects * src/alloc.c (symbol_block_pinned): Remove variable. (init_symbol): Don't initialize 'pinned flag'. (pinned_objects): Remove variable. (mark_pinned_objects, mark_pinned_symbols): Remove functions. (garbage_collect): Don't call 'mark_pinned_objects', 'mark_pinned_symbols'. * src/lisp.h (struct Lisp_Symbol): Remove 'pinned' flag. * src/pdumper.c (dump_symbol): Remove 'pinned' flag from dump. --- src/alloc.c | 47 ----------------------------------------------- src/lisp.h | 3 --- src/pdumper.c | 1 - 3 files changed, 51 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index ff491719547..ea142fb1076 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3898,13 +3898,6 @@ struct symbol_block static struct symbol_block *symbol_block; static int symbol_block_index = SYMBOL_BLOCK_SIZE; -/* Pointer to the first symbol_block that contains pinned symbols. - Tests for 24.4 showed that at dump-time, Emacs contains about 15K symbols, - 10K of which are pinned (and all but 250 of them are interned in obarray), - whereas a "typical session" has in the order of 30K symbols. - `symbol_block_pinned' lets mark_pinned_symbols scan only 15K symbols rather - than 30K to find the 10K symbols we need to mark. */ -static struct symbol_block *symbol_block_pinned; /* List of free symbols. */ @@ -3930,7 +3923,6 @@ init_symbol (Lisp_Object val, Lisp_Object name) p->u.s.interned = SYMBOL_UNINTERNED; p->u.s.trapped_write = SYMBOL_UNTRAPPED_WRITE; p->u.s.declared_special = false; - p->u.s.pinned = false; } DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, @@ -5666,13 +5658,6 @@ Does not copy symbols. Copies strings without text properties. */) return purecopy (obj); } -/* Pinned objects are marked before every GC cycle. */ -static struct pinned_object -{ - Lisp_Object object; - struct pinned_object *next; -} *pinned_objects; - static Lisp_Object purecopy (Lisp_Object obj) { @@ -5882,13 +5867,6 @@ compact_undo_list (Lisp_Object list) return list; } -static void -mark_pinned_objects (void) -{ - for (struct pinned_object *pobj = pinned_objects; pobj; pobj = pobj->next) - mark_object (pobj->object); -} - #if defined HAVE_ANDROID && !defined (__clang__) /* The Android gcc is broken and needs the following version of @@ -5912,29 +5890,6 @@ android_make_lisp_symbol (struct Lisp_Symbol *sym) #endif -static void -mark_pinned_symbols (void) -{ - struct symbol_block *sblk; - int lim; - struct Lisp_Symbol *sym, *end; - - if (symbol_block_pinned == symbol_block) - lim = symbol_block_index; - else - lim = SYMBOL_BLOCK_SIZE; - - for (sblk = symbol_block_pinned; sblk; sblk = sblk->next) - { - sym = sblk->symbols, end = sym + lim; - for (; sym < end; ++sym) - if (sym->u.s.pinned) - mark_object (make_lisp_symbol (sym)); - - lim = SYMBOL_BLOCK_SIZE; - } -} - static void visit_vectorlike_root (struct gc_root_visitor visitor, struct Lisp_Vector *ptr, @@ -6198,8 +6153,6 @@ garbage_collect (void) struct gc_root_visitor visitor = { .visit = mark_object_root_visitor }; visit_static_gc_roots (visitor); - mark_pinned_objects (); - mark_pinned_symbols (); mark_lread (); mark_terminals (); mark_kboards (); diff --git a/src/lisp.h b/src/lisp.h index 93469a5c63e..1370fe7e30f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -797,9 +797,6 @@ struct Lisp_Symbol special (with `defvar' etc), and shouldn't be lexically bound. */ bool_bf declared_special : 1; - /* True if pointed to from purespace and hence can't be GC'd. */ - bool_bf pinned : 1; - /* The symbol's name, as a Lisp string. */ Lisp_Object name; diff --git a/src/pdumper.c b/src/pdumper.c index 1d45e37d67e..5a55dccf09f 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2502,7 +2502,6 @@ dump_symbol (struct dump_context *ctx, DUMP_FIELD_COPY (&out, symbol, u.s.trapped_write); DUMP_FIELD_COPY (&out, symbol, u.s.interned); DUMP_FIELD_COPY (&out, symbol, u.s.declared_special); - DUMP_FIELD_COPY (&out, symbol, u.s.pinned); dump_field_lv (ctx, &out, symbol, &symbol->u.s.name, WEIGHT_STRONG); switch (symbol->u.s.redirect) { From afd61deaaeb5e5e6845bdf995ac5ee9a3479599c Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 20 Aug 2024 19:04:44 +0000 Subject: [PATCH 09/57] Pure storage removal: Remove purecopy hash table flag * lisp/emacs-liqsp/comp.el (comp--jump-table-optimizable): Adjust comment. * src/category.c (hash_get_category_set): * src/emacs-module.c (syms_of_module): * src/fns.c (make_hash_table): Remove 'purecopy' flag and update docstring. (Fmake_hash_table): Ignore ':purecopy' argument. * src/frame.c (make_frame): * src/image.c (xpm_make_color_table_h): * src/lisp.h (struct Lisp_Hash_Table): Drop 'purecopy' flag. * src/pdumper.c (dump_hash_table): Don't dump 'purecopy' flag. * src/print.c (print_object): Don't print 'purecopy' flag * src/json.c (json_parse_object): * src/lread.c (readevalloop, read_internal_start): * src/pgtkterm.c (syms_of_pgtkterm): * src/profiler.c (export_log): * src/xfaces.c (syms_of_xfaces): * src/xterm.c (syms_of_xterm): Adjust calls to 'make_hash_table'. --- lisp/emacs-lisp/comp.el | 2 +- src/category.c | 2 +- src/emacs-module.c | 2 +- src/fns.c | 28 +++++++--------------------- src/frame.c | 2 +- src/image.c | 2 +- src/json.c | 2 +- src/lisp.h | 6 +----- src/lread.c | 8 ++++---- src/pdumper.c | 1 - src/pgtkterm.c | 2 +- src/print.c | 3 --- src/profiler.c | 2 +- src/xfaces.c | 2 +- src/xterm.c | 2 +- 15 files changed, 22 insertions(+), 44 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 2966ed255ac..aea38c60d41 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -1190,7 +1190,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))) diff --git a/src/category.c b/src/category.c index ef29a1a681a..85a2ea0ad0f 100644 --- a/src/category.c +++ b/src/category.c @@ -51,7 +51,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set) if (NILP (XCHAR_TABLE (table)->extras[1])) set_char_table_extras (table, 1, - make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false)); + make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None)); struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); hash_hash_t hash; ptrdiff_t i = hash_lookup_get_hash (h, category_set, &hash); diff --git a/src/emacs-module.c b/src/emacs-module.c index d818b6cdeb9..e3a935236ca 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1709,7 +1709,7 @@ syms_of_module (void) { staticpro (&Vmodule_refs_hash); Vmodule_refs_hash - = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None); DEFSYM (Qmodule_load_failed, "module-load-failed"); Fput (Qmodule_load_failed, Qerror_conditions, diff --git a/src/fns.c b/src/fns.c index 75fd20a2d79..7c2ddb8707c 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4847,15 +4847,11 @@ static const hash_idx_t empty_hash_index_vector[] = {-1}; Give the table initial capacity SIZE, 0 <= SIZE <= MOST_POSITIVE_FIXNUM. - WEAK specifies the weakness of the table. - - If PURECOPY is non-nil, the table can be copied to pure storage via - `purecopy' when Emacs is being dumped. Such tables can no longer be - changed after purecopy. */ + WEAK specifies the weakness of the table. */ Lisp_Object make_hash_table (const struct hash_table_test *test, EMACS_INT size, - hash_table_weakness_t weak, bool purecopy) + hash_table_weakness_t weak) { eassert (SYMBOLP (test->name)); eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX)); @@ -4901,7 +4897,6 @@ make_hash_table (const struct hash_table_test *test, EMACS_INT size, } h->next_weak = NULL; - h->purecopy = purecopy; h->mutable = true; return make_lisp_hash_table (h); } @@ -5735,13 +5730,8 @@ key, value, one of key or value, or both key and value, depending on WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK is nil. -:purecopy PURECOPY -- If PURECOPY is non-nil, the table can be copied -to pure storage when Emacs is being dumped, making the contents of the -table read only. Any further changes to purified tables will result -in an error. - -The keywords arguments :rehash-threshold and :rehash-size are obsolete -and ignored. +The keywords arguments :rehash-threshold, :rehash-size, and :purecopy +are obsolete and ignored. usage: (make-hash-table &rest KEYWORD-ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) @@ -5749,7 +5739,6 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) Lisp_Object test_arg = Qnil; Lisp_Object weakness_arg = Qnil; Lisp_Object size_arg = Qnil; - Lisp_Object purecopy_arg = Qnil; if (nargs & 1) error ("Odd number of arguments"); @@ -5763,9 +5752,8 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) weakness_arg = arg; else if (BASE_EQ (kw, QCsize)) size_arg = arg; - else if (BASE_EQ (kw, QCpurecopy)) - purecopy_arg = arg; - else if (BASE_EQ (kw, QCrehash_threshold) || BASE_EQ (kw, QCrehash_size)) + else if (BASE_EQ (kw, QCrehash_threshold) || BASE_EQ (kw, QCrehash_size) + || BASE_EQ (kw, QCpurecopy)) ; /* ignore obsolete keyword arguments */ else signal_error ("Invalid keyword argument", kw); @@ -5781,8 +5769,6 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) else test = get_hash_table_user_test (test_arg); - bool purecopy = !NILP (purecopy_arg); - EMACS_INT size; if (NILP (size_arg)) size = DEFAULT_HASH_SIZE; @@ -5805,7 +5791,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) else signal_error ("Invalid hash table weakness", weakness_arg); - return make_hash_table (test, size, weak, purecopy); + return make_hash_table (test, size, weak); } diff --git a/src/frame.c b/src/frame.c index 78fa41bbe62..4597dd5cecd 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1043,7 +1043,7 @@ make_frame (bool mini_p) rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f); fset_face_hash_table - (f, make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false)); + (f, make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None)); if (mini_p) { diff --git a/src/image.c b/src/image.c index 0012abcb451..92906f5274c 100644 --- a/src/image.c +++ b/src/image.c @@ -6200,7 +6200,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int, { *put_func = xpm_put_color_table_h; *get_func = xpm_get_color_table_h; - return make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false); + return make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None); } static void diff --git a/src/json.c b/src/json.c index 282dca6e8ff..bfdf7af0ab0 100644 --- a/src/json.c +++ b/src/json.c @@ -1564,7 +1564,7 @@ json_parse_object (struct json_parser *parser) case json_object_hashtable: { EMACS_INT value = (parser->object_workspace_current - first) / 2; - result = make_hash_table (&hashtest_equal, value, Weak_None, false); + result = make_hash_table (&hashtest_equal, value, Weak_None); struct Lisp_Hash_Table *h = XHASH_TABLE (result); for (size_t i = first; i < parser->object_workspace_current; i += 2) { diff --git a/src/lisp.h b/src/lisp.h index 1370fe7e30f..5ebbe4f9860 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2620,10 +2620,6 @@ struct Lisp_Hash_Table /* Hash table test (only used when frozen in dump) */ hash_table_std_test_t frozen_test : 2; - /* True if the table can be purecopied. The table cannot be - changed afterwards. */ - bool_bf purecopy : 1; - /* True if the table is mutable. Ordinarily tables are mutable, but some tables are not: while a table is being mutated it is immutable for recursive attempts to mutate it. */ @@ -4258,7 +4254,7 @@ extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object); Lisp_Object make_hash_table (const struct hash_table_test *, EMACS_INT, - hash_table_weakness_t, bool); + hash_table_weakness_t); Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object); ptrdiff_t hash_lookup_get_hash (struct Lisp_Hash_Table *h, Lisp_Object key, diff --git a/src/lread.c b/src/lread.c index a95abd687ac..8adb862d9a0 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2490,11 +2490,11 @@ readevalloop (Lisp_Object readcharfun, if (! HASH_TABLE_P (read_objects_map) || XHASH_TABLE (read_objects_map)->count) read_objects_map - = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed - = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None); if (!NILP (Vpurify_flag) && c == '(') val = read0 (readcharfun, false); else @@ -2740,11 +2740,11 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end, if (! HASH_TABLE_P (read_objects_map) || XHASH_TABLE (read_objects_map)->count) read_objects_map - = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed - = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false); + = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None); if (STRINGP (stream) || ((CONSP (stream) && STRINGP (XCAR (stream))))) diff --git a/src/pdumper.c b/src/pdumper.c index 5a55dccf09f..5bd0d8ca44a 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2747,7 +2747,6 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object) dump_pseudovector_lisp_fields (ctx, &out->header, &hash->header); DUMP_FIELD_COPY (out, hash, count); DUMP_FIELD_COPY (out, hash, weakness); - DUMP_FIELD_COPY (out, hash, purecopy); DUMP_FIELD_COPY (out, hash, mutable); DUMP_FIELD_COPY (out, hash, frozen_test); if (hash->key_and_value) diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 246604ec18b..5b55c1b488d 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -7485,7 +7485,7 @@ If set to a non-float value, there will be no wait at all. */); DEFVAR_LISP ("pgtk-keysym-table", Vpgtk_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); - Vpgtk_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None, false); + Vpgtk_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None); window_being_scrolled = Qnil; staticpro (&window_being_scrolled); diff --git a/src/print.c b/src/print.c index 8f28b14e8b6..35a2dac6263 100644 --- a/src/print.c +++ b/src/print.c @@ -2605,9 +2605,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) printcharfun, escapeflag); } - if (h->purecopy) - print_c_string (" purecopy t", printcharfun); - ptrdiff_t size = h->count; if (size > 0) { diff --git a/src/profiler.c b/src/profiler.c index 6e1dc46abd3..80173ac735e 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -562,7 +562,7 @@ export_log (struct profiler_log *plog) the log but close enough, and will never confuse two distinct keys in the log. */ Lisp_Object h = make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, - Weak_None, false); + Weak_None); for (int i = 0; i < log->size; i++) { int count = get_log_count (log, i); diff --git a/src/xfaces.c b/src/xfaces.c index 7763fdd4953..9c54fe5b051 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -7518,7 +7518,7 @@ only for this purpose. */); doc: /* Hash table of global face definitions (for internal use only.) */); Vface_new_frame_defaults = /* 33 entries is enough to fit all basic faces */ - make_hash_table (&hashtest_eq, 33, Weak_None, false); + make_hash_table (&hashtest_eq, 33, Weak_None); DEFVAR_LISP ("face-default-stipple", Vface_default_stipple, doc: /* Default stipple pattern used on monochrome displays. diff --git a/src/xterm.c b/src/xterm.c index f78b20e0d58..c723362c91a 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -32739,7 +32739,7 @@ If set to a non-float value, there will be no wait at all. */); DEFVAR_LISP ("x-keysym-table", Vx_keysym_table, doc: /* Hash table of character codes indexed by X keysym codes. */); - Vx_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None, false); + Vx_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None); DEFVAR_BOOL ("x-frame-normalize-before-maximize", x_frame_normalize_before_maximize, From 69fea4f29a1390912e4140a3ebacc50b7338db6f Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 20 Aug 2024 19:08:33 +0000 Subject: [PATCH 10/57] Pure storage removal: Remove docstring hack This should no longer be needed. * src/eval.c (Fautoload): Don't try to work around pure storage bug. --- src/eval.c | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/eval.c b/src/eval.c index 6d0e8f101d7..28aa14c6234 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2314,12 +2314,6 @@ this does nothing and returns nil. */) && !AUTOLOADP (XSYMBOL (function)->u.s.function)) return Qnil; - if (!NILP (Vpurify_flag) && BASE_EQ (docstring, make_fixnum (0))) - /* `read1' in lread.c has found the docstring starting with "\ - and assumed the docstring will be provided by Snarf-documentation, so it - passed us 0 instead. But that leads to accidental sharing in purecopy's - hash-consing, so we use a (hopefully) unique integer instead. */ - docstring = make_ufixnum (XHASH (function)); return Fdefalias (function, list5 (Qautoload, file, docstring, interactive, type), Qnil); From bd2b59f07337c4f5980666875207bf877634b1b3 Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 20 Aug 2024 19:09:14 +0000 Subject: [PATCH 11/57] Pure storage removal: Adjust nativecomp code * lisp/emacs-lisp/comp.el (comp-curr-allocation-class, comp-ctxt) (comp--emit-for-top-level, comp--emit-lambda-for-top-level) (comp--finalize-relocs): Remove 'd-impure' allocation class. * src/comp.c (PURE_RELOC_SYM, DATA_RELOC_IMPURE_SYM) (TEXT_DATA_RELOC_IMPURE_SYM): Remove definitions. (comp_t): Remove 'pure_ptr', 'check_impure', 'data_relocs_impure', 'd_impure_idx'. (helper_link_table): Remove 'pure_write_error'. (obj_to_reloc): Adjust to removal of 'data_relocs_impure'. (emit_PURE_P): Remove function. (declare_imported_data, declare_runtime_imported_funcs) (emit_ctxt_code): Adjust to removed fields. (define_setcar_setcdr): Don't call 'CHECK_IMPURE'. (define_CHECK_IMPURE): Remove function. (Fcomp__compile_ctxt_to_file0, check_comp_unit_relocs, load_comp_unit) (Fcomp__register_lambda): Adjust to removed allocation class 'd-impure'. (syms_of_comp): Don't define 'd-impure'. * src/comp.h (struct Lisp_Native_Comp_Unit): Drop support for allocation class 'd-impure'. * src/lisp.h (allocate_native_comp_unit): * src/pdumper.c (dump_do_dump_relocation): Adjust to struct change. --- lisp/emacs-lisp/comp.el | 36 +++------- src/comp.c | 145 ++-------------------------------------- src/comp.h | 10 ++- src/lisp.h | 2 +- src/pdumper.c | 4 +- 5 files changed, 22 insertions(+), 175 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index aea38c60d41..dbd14b2740d 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -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 @@ -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 @@ -3271,28 +3268,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 +3286,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)) diff --git a/src/comp.c b/src/comp.c index e43732f369e..5e8b49f7ffc 100644 --- a/src/comp.c +++ b/src/comp.c @@ -476,16 +476,13 @@ load_gccjit_if_necessary (bool mandatory) /* C symbols emitted for the load relocation mechanism. */ #define CURRENT_THREAD_RELOC_SYM "current_thread_reloc" #define F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM "f_symbols_with_pos_enabled_reloc" -#define PURE_RELOC_SYM "pure_reloc" #define DATA_RELOC_SYM "d_reloc" -#define DATA_RELOC_IMPURE_SYM "d_reloc_imp" #define DATA_RELOC_EPHEMERAL_SYM "d_reloc_eph" #define FUNC_LINK_TABLE_SYM "freloc_link_table" #define LINK_TABLE_HASH_SYM "freloc_hash" #define COMP_UNIT_SYM "comp_unit" #define TEXT_DATA_RELOC_SYM "text_data_reloc" -#define TEXT_DATA_RELOC_IMPURE_SYM "text_data_reloc_imp" #define TEXT_DATA_RELOC_EPHEMERAL_SYM "text_data_reloc_eph" #define TEXT_OPTIM_QLY_SYM "text_optim_qly" @@ -619,7 +616,6 @@ typedef struct { gcc_jit_type *thread_state_ptr_type; gcc_jit_rvalue *current_thread_ref; /* Other globals. */ - gcc_jit_rvalue *pure_ptr; #ifndef LIBGCCJIT_HAVE_gcc_jit_context_new_bitcast /* This version of libgccjit has really limited support for casting therefore this union will be used for the scope. */ @@ -651,7 +647,6 @@ typedef struct { gcc_jit_function *setcar; gcc_jit_function *setcdr; gcc_jit_function *check_type; - gcc_jit_function *check_impure; gcc_jit_function *maybe_gc_or_quit; Lisp_Object func_blocks_h; /* blk_name -> gcc_block. */ Lisp_Object exported_funcs_h; /* c-func-name -> gcc_jit_function *. */ @@ -659,8 +654,6 @@ typedef struct { Lisp_Object emitter_dispatcher; /* Synthesized struct holding data relocs. */ reloc_array_t data_relocs; - /* Same as before but can't go in pure space. */ - reloc_array_t data_relocs_impure; /* Same as before but content does not survive load phase. */ reloc_array_t data_relocs_ephemeral; /* Global structure holding function relocations. */ @@ -670,7 +663,6 @@ typedef struct { gcc_jit_lvalue *func_relocs_local; gcc_jit_function *memcpy; Lisp_Object d_default_idx; - Lisp_Object d_impure_idx; Lisp_Object d_ephemeral_idx; } comp_t; @@ -708,7 +700,6 @@ helper_sanitizer_assert (Lisp_Object, Lisp_Object); static void *helper_link_table[] = { wrong_type_argument, helper_PSEUDOVECTOR_TYPEP_XUNTAG, - pure_write_error, push_handler, record_unwind_protect_excursion, helper_unbind_n, @@ -939,13 +930,6 @@ obj_to_reloc (Lisp_Object obj) goto found; } - idx = Fgethash (obj, comp.d_impure_idx, Qnil); - if (!NILP (idx)) - { - reloc.array = comp.data_relocs_impure; - goto found; - } - idx = Fgethash (obj, comp.d_ephemeral_idx, Qnil); if (!NILP (idx)) { @@ -1987,28 +1971,6 @@ emit_XSETCDR (gcc_jit_rvalue *c, gcc_jit_rvalue *n) NULL), n); } - -static gcc_jit_rvalue * -emit_PURE_P (gcc_jit_rvalue *ptr) -{ - - emit_comment ("PURE_P"); - - return - gcc_jit_context_new_comparison ( - comp.ctxt, - NULL, - GCC_JIT_COMPARISON_LE, - emit_binary_op ( - GCC_JIT_BINARY_OP_MINUS, - comp.uintptr_type, - ptr, - comp.pure_ptr), - gcc_jit_context_new_rvalue_from_int (comp.ctxt, - comp.uintptr_type, - PURESIZE)); -} - /*************************************/ /* Code emitted by LIMPLE statemes. */ @@ -2925,10 +2887,6 @@ declare_imported_data (void) declare_imported_data_relocs (CALL1I (comp-ctxt-d-default, Vcomp_ctxt), DATA_RELOC_SYM, TEXT_DATA_RELOC_SYM); - comp.data_relocs_impure = - declare_imported_data_relocs (CALL1I (comp-ctxt-d-impure, Vcomp_ctxt), - DATA_RELOC_IMPURE_SYM, - TEXT_DATA_RELOC_IMPURE_SYM); comp.data_relocs_ephemeral = declare_imported_data_relocs (CALL1I (comp-ctxt-d-ephemeral, Vcomp_ctxt), DATA_RELOC_EPHEMERAL_SYM, @@ -2962,8 +2920,6 @@ declare_runtime_imported_funcs (void) args[1] = comp.int_type; ADD_IMPORTED (helper_PSEUDOVECTOR_TYPEP_XUNTAG, comp.bool_type, 2, args); - ADD_IMPORTED (pure_write_error, comp.void_type, 1, NULL); - args[0] = comp.lisp_obj_type; args[1] = comp.int_type; ADD_IMPORTED (push_handler, comp.handler_ptr_type, 2, args); @@ -3039,15 +2995,6 @@ emit_ctxt_code (void) comp.bool_ptr_type, F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM)); - comp.pure_ptr = - gcc_jit_lvalue_as_rvalue ( - gcc_jit_context_new_global ( - comp.ctxt, - NULL, - GCC_JIT_GLOBAL_EXPORTED, - comp.void_ptr_type, - PURE_RELOC_SYM)); - gcc_jit_context_new_global ( comp.ctxt, NULL, @@ -3709,19 +3656,6 @@ define_setcar_setcdr (void) /* CHECK_CONS (cell); */ emit_CHECK_CONS (gcc_jit_param_as_rvalue (cell)); - /* CHECK_IMPURE (cell, XCONS (cell)); */ - gcc_jit_rvalue *args[] = - { gcc_jit_param_as_rvalue (cell), - emit_XCONS (gcc_jit_param_as_rvalue (cell)) }; - - gcc_jit_block_add_eval (entry_block, - NULL, - gcc_jit_context_new_call (comp.ctxt, - NULL, - comp.check_impure, - 2, - args)); - /* XSETCDR (cell, newel); */ if (!i) emit_XSETCAR (gcc_jit_param_as_rvalue (cell), @@ -4025,52 +3959,6 @@ static void define_SYMBOL_WITH_POS_SYM (void) comp.lisp_symbol_with_position_sym)); } -static void -define_CHECK_IMPURE (void) -{ - gcc_jit_param *param[] = - { gcc_jit_context_new_param (comp.ctxt, - NULL, - comp.lisp_obj_type, - "obj"), - gcc_jit_context_new_param (comp.ctxt, - NULL, - comp.void_ptr_type, - "ptr") }; - comp.check_impure = - gcc_jit_context_new_function (comp.ctxt, NULL, - GCC_JIT_FUNCTION_INTERNAL, - comp.void_type, - "CHECK_IMPURE", - 2, - param, - 0); - - DECL_BLOCK (entry_block, comp.check_impure); - DECL_BLOCK (err_block, comp.check_impure); - DECL_BLOCK (ok_block, comp.check_impure); - - comp.block = entry_block; - comp.func = comp.check_impure; - - emit_cond_jump (emit_PURE_P (gcc_jit_param_as_rvalue (param[0])), /* FIXME */ - err_block, - ok_block); - gcc_jit_block_end_with_void_return (ok_block, NULL); - - gcc_jit_rvalue *pure_write_error_arg = - gcc_jit_param_as_rvalue (param[0]); - - comp.block = err_block; - gcc_jit_block_add_eval (comp.block, - NULL, - emit_call (intern_c_string ("pure_write_error"), - comp.void_type, 1,&pure_write_error_arg, - false)); - - gcc_jit_block_end_with_void_return (err_block, NULL); -} - static void define_maybe_gc_or_quit (void) { @@ -4948,8 +4836,6 @@ DEFUN ("comp--compile-ctxt-to-file0", Fcomp__compile_ctxt_to_file0, comp.d_default_idx = CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-default, Vcomp_ctxt)); - comp.d_impure_idx = - CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-impure, Vcomp_ctxt)); comp.d_ephemeral_idx = CALL1I (comp-data-container-idx, CALL1I (comp-ctxt-d-ephemeral, Vcomp_ctxt)); @@ -5281,17 +5167,12 @@ check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u) { dynlib_handle_ptr handle = comp_u->handle; Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); - Lisp_Object *data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM); EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec)); - for (ptrdiff_t i = 0; i < d_vec_len; i++) - if (!EQ (data_relocs[i], AREF (comp_u->data_vec, i))) - return false; - d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec)); for (ptrdiff_t i = 0; i < d_vec_len; i++) { - Lisp_Object x = data_imp_relocs[i]; + Lisp_Object x = data_relocs[i]; if (EQ (x, Qlambda_fixup)) return false; else if (NATIVE_COMP_FUNCTIONP (x)) @@ -5299,7 +5180,7 @@ check_comp_unit_relocs (struct Lisp_Native_Comp_Unit *comp_u) if (NILP (Fgethash (x, comp_u->lambda_gc_guard_h, Qnil))) return false; } - else if (!EQ (x, AREF (comp_u->data_impure_vec, i))) + else if (!EQ (x, AREF (comp_u->data_vec, i))) return false; } return true; @@ -5363,7 +5244,7 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, /* Always set data_imp_relocs pointer in the compilation unit (in can be used in 'dump_do_dump_relocation'). */ - comp_u->data_imp_relocs = dynlib_sym (handle, DATA_RELOC_IMPURE_SYM); + comp_u->data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); if (!comp_u->loaded_once) { @@ -5371,16 +5252,12 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM); bool **f_symbols_with_pos_enabled_reloc = dynlib_sym (handle, F_SYMBOLS_WITH_POS_ENABLED_RELOC_SYM); - void **pure_reloc = dynlib_sym (handle, PURE_RELOC_SYM); - Lisp_Object *data_relocs = dynlib_sym (handle, DATA_RELOC_SYM); - Lisp_Object *data_imp_relocs = comp_u->data_imp_relocs; + Lisp_Object *data_relocs = comp_u->data_relocs; void **freloc_link_table = dynlib_sym (handle, FUNC_LINK_TABLE_SYM); if (!(current_thread_reloc && f_symbols_with_pos_enabled_reloc - && pure_reloc && data_relocs - && data_imp_relocs && data_eph_relocs && freloc_link_table && top_level_run) @@ -5390,7 +5267,6 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, *current_thread_reloc = ¤t_thread; *f_symbols_with_pos_enabled_reloc = &symbols_with_pos_enabled; - *pure_reloc = pure; /* Imported functions. */ *freloc_link_table = freloc.link_table; @@ -5401,21 +5277,11 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump, comp_u->optimize_qualities = load_static_obj (comp_u, TEXT_OPTIM_QLY_SYM); comp_u->data_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_SYM); - comp_u->data_impure_vec = - load_static_obj (comp_u, TEXT_DATA_RELOC_IMPURE_SYM); - - if (!NILP (Vpurify_flag)) - /* Non impure can be copied into pure space. */ - comp_u->data_vec = Fpurecopy (comp_u->data_vec); } EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec)); for (EMACS_INT i = 0; i < d_vec_len; i++) data_relocs[i] = AREF (comp_u->data_vec, i); - - d_vec_len = XFIXNUM (Flength (comp_u->data_impure_vec)); - for (EMACS_INT i = 0; i < d_vec_len; i++) - data_imp_relocs[i] = AREF (comp_u->data_impure_vec, i); } if (!loading_dump) @@ -5567,7 +5433,7 @@ This gets called by top_level_run during the load phase. */) eassert (NILP (Fgethash (c_name, cu->lambda_c_name_idx_h, Qnil))); Fputhash (c_name, reloc_idx, cu->lambda_c_name_idx_h); /* Do the real relocation fixup. */ - cu->data_imp_relocs[XFIXNUM (reloc_idx)] = tem; + cu->data_relocs[XFIXNUM (reloc_idx)] = tem; return tem; } @@ -5749,7 +5615,6 @@ natively-compiled one. */); /* Allocation classes. */ DEFSYM (Qd_default, "d-default"); - DEFSYM (Qd_impure, "d-impure"); DEFSYM (Qd_ephemeral, "d-ephemeral"); /* Others. */ diff --git a/src/comp.h b/src/comp.h index 158ed0b46df..2a60cb38955 100644 --- a/src/comp.h +++ b/src/comp.h @@ -35,17 +35,15 @@ struct Lisp_Native_Comp_Unit /* Guard anonymous lambdas against Garbage Collection and serve sanity checks. */ Lisp_Object lambda_gc_guard_h; - /* Hash c_name -> d_reloc_imp index. */ + /* Hash c_name -> d_reloc index. */ Lisp_Object lambda_c_name_idx_h; /* Hash doc-idx -> function documentation. */ Lisp_Object data_fdoc_v; - /* Analogous to the constant vector but per compilation unit. */ + /* Analogous to the constant vector but per compilation unit. Must be + last. */ Lisp_Object data_vec; - /* 'data_impure_vec' must be last (see allocate_native_comp_unit). - Same as data_vec but for data that cannot be moved to pure space. */ - Lisp_Object data_impure_vec; /* STUFFS WE DO NOT DUMP!! */ - Lisp_Object *data_imp_relocs; + Lisp_Object *data_relocs; bool loaded_once; bool load_ongoing; dynlib_handle_ptr handle; diff --git a/src/lisp.h b/src/lisp.h index 5ebbe4f9860..695d5f200ea 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -5498,7 +5498,7 @@ INLINE struct Lisp_Native_Comp_Unit * allocate_native_comp_unit (void) { return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Native_Comp_Unit, - data_impure_vec, PVEC_NATIVE_COMP_UNIT); + data_vec, PVEC_NATIVE_COMP_UNIT); } #else INLINE bool diff --git a/src/pdumper.c b/src/pdumper.c index 5bd0d8ca44a..40798ff48e9 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -5498,12 +5498,12 @@ dump_do_dump_relocation (const uintptr_t dump_base, if (!NILP (lambda_data_idx)) { /* This is an anonymous lambda. - We must fixup d_reloc_imp so the lambda can be referenced + We must fixup d_reloc so the lambda can be referenced by code. */ Lisp_Object tem; XSETSUBR (tem, subr); Lisp_Object *fixup = - &(comp_u->data_imp_relocs[XFIXNUM (lambda_data_idx)]); + &(comp_u->data_relocs[XFIXNUM (lambda_data_idx)]); eassert (EQ (*fixup, Qlambda_fixup)); *fixup = tem; Fputhash (tem, Qt, comp_u->lambda_gc_guard_h); From c9ab3258760c5ef2baf3ecf2a2a0051fc3fb4612 Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 20 Aug 2024 19:15:16 +0000 Subject: [PATCH 12/57] Pure storage removal: Remove documentation As pure storage is now gone, it no longer needs to be documented. * doc/lispref/elisp.texi (Top): * doc/lispref/internals.texi (GNU Emacs Internals): Remove "Pure Storage" section. (Building Emacs, Garbage Collection, Writing Emacs Primitives): * doc/lispref/symbols.texi (Standard Properties): Remove references to pure storage. * src/alloc.c (Fgarbage_collect): Remove docstring text referring to pure storage. --- doc/lispref/elisp.texi | 1 - doc/lispref/internals.texi | 73 -------------------------------------- doc/lispref/symbols.texi | 3 +- src/alloc.c | 4 --- 4 files changed, 1 insertion(+), 80 deletions(-) diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 1ce89c6431f..0715971e579 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -1651,7 +1651,6 @@ Tips and Conventions GNU Emacs Internals * Building Emacs:: How the dumped Emacs is made. -* Pure Storage:: Kludge to make preloaded Lisp functions shareable. * Garbage Collection:: Reclaiming space for Lisp objects no longer used. * Stack-allocated Objects:: Temporary conses and strings on C stack. * Memory Usage:: Info about total size of Lisp objects made so far. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index a5480a9bf8a..00a3704fcac 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -12,7 +12,6 @@ internal aspects of GNU Emacs that may be of interest to C programmers. @menu * Building Emacs:: How the dumped Emacs is made. -* Pure Storage:: Kludge to make preloaded Lisp functions shareable. * Garbage Collection:: Reclaiming space for Lisp objects no longer used. * Stack-allocated Objects:: Temporary conses and strings on C stack. * Memory Usage:: Info about total size of Lisp objects made so far. @@ -251,71 +250,6 @@ If the current session was not restored from a dump file, the value is @code{nil}. @end defun -@node Pure Storage -@section Pure Storage -@cindex pure storage - - Emacs Lisp uses two kinds of storage for user-created Lisp objects: -@dfn{normal storage} and @dfn{pure storage}. Normal storage is where -all the new data created during an Emacs session are kept -(@pxref{Garbage Collection}). Pure storage is used for certain data -in the preloaded standard Lisp files---data that should never change -during actual use of Emacs. - - Pure storage is allocated only while @command{temacs} is loading the -standard preloaded Lisp libraries. In the file @file{emacs}, it is -marked as read-only (on operating systems that permit this), so that -the memory space can be shared by all the Emacs jobs running on the -machine at once. Pure storage is not expandable; a fixed amount is -allocated when Emacs is compiled, and if that is not sufficient for -the preloaded libraries, @file{temacs} allocates dynamic memory for -the part that didn't fit. If Emacs will be dumped using the -@code{pdump} method (@pxref{Building Emacs}), the pure-space overflow -is of no special importance (it just means some of the preloaded stuff -cannot be shared with other Emacs jobs). However, if Emacs will be -dumped using the now obsolete @code{unexec} method, the resulting -image will work, but garbage collection (@pxref{Garbage Collection}) -is disabled in this situation, causing a memory leak. Such an -overflow normally won't happen unless you try to preload additional -libraries or add features to the standard ones. Emacs will display a -warning about the overflow when it starts, if it was dumped using -@code{unexec}. If this happens, you should increase the compilation -parameter @code{SYSTEM_PURESIZE_EXTRA} in the file -@file{src/puresize.h} and rebuild Emacs. - -@defun purecopy object -This function makes a copy in pure storage of @var{object}, and returns -it. It copies a string by simply making a new string with the same -characters, but without text properties, in pure storage. It -recursively copies the contents of vectors and cons cells. It does -not make copies of other objects such as symbols, but just returns -them unchanged. It signals an error if asked to copy markers. - -This function is a no-op except while Emacs is being built and dumped; -it is usually called only in preloaded Lisp files. -@end defun - -@defvar pure-bytes-used -The value of this variable is the number of bytes of pure storage -allocated so far. Typically, in a dumped Emacs, this number is very -close to the total amount of pure storage available---if it were not, -we would preallocate less. -@end defvar - -@defvar purify-flag -This variable determines whether @code{defun} should make a copy of the -function definition in pure storage. If it is non-@code{nil}, then the -function definition is copied into pure storage. - -This flag is @code{t} while loading all of the basic functions for -building Emacs initially (allowing those functions to be shareable and -non-collectible). Dumping Emacs as an executable always writes -@code{nil} in this variable, regardless of the value it actually has -before and after dumping. - -You should not change this flag in a running Emacs. -@end defvar - @node Garbage Collection @section Garbage Collection @@ -526,12 +460,6 @@ Total heap size, in @var{unit-size} units. @item free-size Heap space which is not currently used, in @var{unit-size} units. @end table - -If there was overflow in pure space (@pxref{Pure Storage}), and Emacs -was dumped using the (now obsolete) @code{unexec} method -(@pxref{Building Emacs}), then @code{garbage-collect} returns -@code{nil}, because a real garbage collection cannot be done in that -case. @end deffn @defopt garbage-collection-messages @@ -967,7 +895,6 @@ improves user experience. the variables are never written once Emacs is dumped. These variables with initializers are allocated in an area of memory that becomes read-only (on certain operating systems) as a result of dumping Emacs. -@xref{Pure Storage}. @cindex @code{defsubr}, Lisp symbol for a primitive Defining the C function is not enough to make a Lisp primitive diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index c3dc08df2df..1ce3bd4853a 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -593,8 +593,7 @@ modes. @xref{Setting Hooks}. If the value is non-@code{nil}, the named function is considered to be pure (@pxref{What Is a Function}). Calls with constant arguments can be evaluated at compile time. This may shift run time errors to -compile time. Not to be confused with pure storage (@pxref{Pure -Storage}). +compile time. @item risky-local-variable If the value is non-@code{nil}, the named variable is considered risky diff --git a/src/alloc.c b/src/alloc.c index ea142fb1076..8c8e1a99829 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6296,10 +6296,6 @@ where each entry has the form (NAME SIZE USED FREE), where: keeps around for future allocations (maybe because it does not know how to return them to the OS). -However, if there was overflow in pure space, and Emacs was dumped -using the \"unexec\" method, `garbage-collect' returns nil, because -real GC can't be done. - Note that calling this function does not guarantee that absolutely all unreachable objects will be garbage-collected. Emacs uses a mark-and-sweep garbage collector, but is conservative when it comes to From 647f6aa4c06f681df8d2ab6520d8bcd273dff1a8 Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Tue, 20 Aug 2024 19:16:58 +0000 Subject: [PATCH 13/57] Pure storage removal: Bump nativecomp ABI Use "9" as MPS builds use "7" and "8". * src/comp.c (ABI_VERSION): Bump. --- src/comp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/comp.c b/src/comp.c index 5e8b49f7ffc..ac26ead08d9 100644 --- a/src/comp.c +++ b/src/comp.c @@ -468,7 +468,7 @@ load_gccjit_if_necessary (bool mandatory) /* Increase this number to force a new Vcomp_abi_hash to be generated. */ -#define ABI_VERSION "6" +#define ABI_VERSION "9" /* Length of the hashes used for eln file naming. */ #define HASH_LENGTH 8 From 1c495735b4fd7411bca39161b45e0115d0d377b9 Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Wed, 21 Aug 2024 08:59:25 +0000 Subject: [PATCH 14/57] Pure storage removal: Documentation * etc/NEWS: Document removal of unexec dumper. * etc/PROBLEMS: Remove pure space problems. --- etc/NEWS | 5 +++++ etc/PROBLEMS | 32 -------------------------------- 2 files changed, 5 insertions(+), 32 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index d96e49402ba..f00b2cd7bee 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -24,6 +24,11 @@ applies, and please also update docstrings as needed. * Installation Changes in Emacs 31.1 ++++ +** Unexec dumper removed. +The traditional unexec dumper, deprecated since Emacs 27, has been +removed. + ** Changed GCC default options on 32-bit x86 systems. When using GCC 4 or later to build Emacs on 32-bit x86 systems, 'configure' now defaults to using the GCC options '-mfpmath=sse' (if the diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 30506b3c87a..6075f7c18ff 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -4150,31 +4150,6 @@ prints a nonzero value. You can temporarily disable it as follows: As with randomize_va_space, you can re-enable Exec-shield when you are done, by echoing the original value back to the file. -*** temacs prints "Pure Lisp storage exhausted". - -This means that the Lisp code loaded from the .elc and .el files during -'temacs --batch --load loadup dump' took up more space than was allocated. - -This could be caused by - 1) adding code to the preloaded Lisp files - 2) adding more preloaded files in loadup.el - 3) having a site-init.el or site-load.el which loads files. - Note that ANY site-init.el or site-load.el is nonstandard; - if you have received Emacs from some other site and it contains a - site-init.el or site-load.el file, consider deleting that file. - 4) getting the wrong .el or .elc files - (not from the directory you expected). - 5) deleting some .elc files that are supposed to exist. - This would cause the source files (.el files) to be - loaded instead. They take up more room, so you lose. - 6) a bug in the Emacs distribution which underestimates the space required. - -If the need for more space is legitimate, change the definition -of PURESIZE in puresize.h. - -But in some of the cases listed above, this problem is a consequence -of something else that is wrong. Be sure to check and fix the real problem. - *** openSUSE 10.3: Segfault in bcopy during dumping. This is due to a bug in the bcopy implementation in openSUSE 10.3. @@ -4194,13 +4169,6 @@ binary null characters, and the 'file' utility says: We don't know what exactly causes this failure. A work-around is to build Emacs in a directory on a local disk. -*** The dumped Emacs crashes when run, trying to write pure data. - -On a system where getpagesize is not a system call, it is defined -as a macro. If the definition (in both unex*.c and malloc.c) is wrong, -it can cause problems like this. You might be able to find the correct -value in the man page for a.out(5). - * Problems on legacy systems This section covers bugs reported on very old hardware or software. From 9a0728af9df7c208a7e93f8e970b7348b1273fee Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Wed, 21 Aug 2024 08:44:14 +0000 Subject: [PATCH 15/57] Don't recognize "bootstrap" option for --temacs This option only makes sense for unexec dumping. * src/emacs.c (main): Recognize "pbootstrap" only, not "bootstrap". --- src/emacs.c | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/emacs.c b/src/emacs.c index 496a107d49d..13413e36459 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1310,8 +1310,7 @@ main (int argc, char **argv) if (strcmp (temacs, "pdump") == 0 || strcmp (temacs, "pbootstrap") == 0) gflags.will_dump_with_pdumper_ = true; - if (strcmp (temacs, "bootstrap") == 0 || - strcmp (temacs, "pbootstrap") == 0) + if (strcmp (temacs, "pbootstrap") == 0) gflags.will_bootstrap_ = true; gflags.will_dump_ = will_dump_with_pdumper_p (); From 0e37b11e659dd58c520d557820b006a8d03c71e6 Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Wed, 21 Aug 2024 08:45:13 +0000 Subject: [PATCH 16/57] Unexec removal: Documentation adjustments * doc/lispref/internals.texi (Building Emacs): * doc/lispref/os.texi (Command-Line Arguments): Remove documentation for 'unexec'-specific code and arguments. * etc/PROBLEMS: Remove unexec-specific problems. --- doc/lispref/internals.texi | 28 ------------ doc/lispref/os.texi | 8 ++-- etc/PROBLEMS | 90 -------------------------------------- 3 files changed, 4 insertions(+), 122 deletions(-) diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 00a3704fcac..fb7fe9aad76 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -76,23 +76,6 @@ Like @samp{pdump}, but used while @dfn{bootstrapping} Emacs, when no previous Emacs binary and no @file{*.elc} byte-compiled Lisp files are available. The produced dump file is usually named @file{bootstrap-emacs.pdmp} in this case. - -@item dump -@cindex unexec -This method causes @command{temacs} to dump out an executable program, -called @file{emacs}, which has all the standard Lisp files already -preloaded into it. (The @samp{-batch} argument prevents -@command{temacs} from trying to initialize any of its data on the -terminal, so that the tables of terminal information are empty in the -dumped Emacs.) This method is also known as @dfn{unexec}, because it -produces a program file from a running process, and thus is in some -sense the opposite of executing a program to start a process. -Although this method was the way that Emacs traditionally saved its -state, it is now deprecated. - -@item bootstrap -Like @samp{dump}, but used when bootstrapping Emacs with the -@code{unexec} method. @end table @cindex preloaded Lisp files @@ -227,17 +210,6 @@ that problem, you can put functions on the Emacs. @end defun -@defun dump-emacs to-file from-file -@cindex unexec -This function dumps the current state of Emacs into an executable file -@var{to-file}, using the @code{unexec} method. It takes symbols from -@var{from-file} (this is normally the executable file @file{temacs}). - -This function cannot be used in an Emacs that was already dumped. -This function is deprecated, and by default Emacs is built without -@code{unexec} support so this function is not available. -@end defun - @defun pdumper-stats If the current Emacs session restored its state from a dump file, this function returns information about the dump file and the diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index be26fb5063c..8f70ff30645 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -590,10 +590,10 @@ displays the startup messages. The value of this variable is @code{t} once the command line has been processed. -If you redump Emacs by calling @code{dump-emacs} (@pxref{Building -Emacs}), you may wish to set this variable to @code{nil} first in -order to cause the new dumped Emacs to process its new command-line -arguments. +If you redump Emacs by calling @code{dump-emacs-portable} +(@pxref{Building Emacs}), you may wish to set this variable to +@code{nil} first in order to cause the new dumped Emacs to process its +new command-line arguments. @end defvar @defvar command-switch-alist diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 6075f7c18ff..8fc57ea609a 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -2936,20 +2936,6 @@ This was observed for Emacs 28.1 on Solaris 10 32-bit sparc, with Oracle Developer Studio 12.6 (Sun C 5.15). The failure was intermittent, and running GNU Make a second time would typically finish the build. -*** On Solaris 10, Emacs crashes during the build process. -(This applies only with './configure --with-unexec=yes', which is rare.) -This was reported for Emacs 25.2 on i386-pc-solaris2.10 with Sun -Studio 12 (Sun C 5.9) and with Oracle Developer Studio 12.6 (Sun C -5.15), and intermittently for sparc-sun-solaris2.10 with Oracle -Developer Studio 12.5 (Sun C 5.14). Disabling compiler optimization -seems to fix the bug, as does upgrading the Solaris 10 operating -system to Update 11. The cause of the bug is unknown: it may be that -Emacs's archaic memory-allocation scheme is not compatible with -slightly-older versions of Solaris and/or Oracle Studio, or it may be -something else. Since the cause is not known, possibly the bug is -still present in newer versions of Emacs, Oracle Studio, and/or -Solaris. See Bug#26638. - *** On Solaris, C-x doesn't get through to Emacs when you use the console. This is a Solaris feature (at least on Intel x86 cpus). Type C-r @@ -4085,71 +4071,6 @@ minimum supported Windows version is 8.1, and the computer hardware (CPU, memory, disk) should also match the minimum Windows 8.1 requirements. -*** Segfault during 'make' - -If Emacs segfaults when 'make' executes one of these commands: - - LC_ALL=C ./temacs -batch -l loadup bootstrap - LC_ALL=C ./temacs -batch -l loadup dump - -the problem may be due to inadequate workarounds for address space -layout randomization (ASLR), an operating system feature that -randomizes the virtual address space of a process. ASLR is commonly -enabled in Linux and NetBSD kernels, and is intended to deter exploits -of pointer-related bugs in applications. If ASLR is enabled, the -command: - - cat /proc/sys/kernel/randomize_va_space # GNU/Linux - sysctl security.pax.aslr.global # NetBSD - -outputs a nonzero value. - -These segfaults should not occur on most modern systems, because the -Emacs build procedure uses the command 'setfattr' or 'paxctl' to mark -the Emacs executable as requiring non-randomized address space, and -Emacs uses the 'personality' system call to disable address space -randomization when dumping. However, older kernels may not support -'setfattr', 'paxctl', or 'personality', and newer Linux kernels have a -secure computing mode (seccomp) that can be configured to disable the -'personality' call. - -It may be possible to work around the 'personality' problem in a newer -Linux kernel by configuring seccomp to allow the 'personality' call. -For example, if you are building Emacs under Docker, you can run the -Docker container with a security profile that allows 'personality' by -using Docker's --security-opt option with an appropriate profile; see -. - -To work around the ASLR problem in either an older or a newer kernel, -you can temporarily disable the feature while building Emacs. On -GNU/Linux you can do so using the following command (as root). - - echo 0 > /proc/sys/kernel/randomize_va_space - -You can re-enable the feature when you are done, by echoing the -original value back to the file. NetBSD uses a different command, -e.g., 'sysctl -w security.pax.aslr.global=0'. - -Alternatively, you can try using the 'setarch' command when building -temacs like this, where -R disables address space randomization: - - setarch $(uname -m) -R make - -ASLR is not the only problem that can break Emacs dumping. Another -issue is that in Red Hat Linux kernels, Exec-shield is enabled by -default, and this creates a different memory layout. Emacs should -handle this at build time, but if this fails the following -instructions may be useful. Exec-shield is enabled on your system if - - cat /proc/sys/kernel/exec-shield - -prints a nonzero value. You can temporarily disable it as follows: - - echo 0 > /proc/sys/kernel/exec-shield - -As with randomize_va_space, you can re-enable Exec-shield when you are -done, by echoing the original value back to the file. - *** openSUSE 10.3: Segfault in bcopy during dumping. This is due to a bug in the bcopy implementation in openSUSE 10.3. @@ -4297,17 +4218,6 @@ should do. pen@lysator.liu.se says (Feb 1998) that the Compose key does work if you link with the MIT X11 libraries instead of the Solaris X11 libraries. -** OpenBSD - -*** OpenBSD 4.0 macppc: Segfault during dumping. - -The build aborts with signal 11 when the command './temacs --batch ---load loadup bootstrap' tries to load files.el. A workaround seems -to be to reduce the level of compiler optimization used during the -build (from -O2 to -O1). It is possible this is an OpenBSD -GCC problem specific to the macppc architecture, possibly only -occurring with older versions of GCC (e.g. 3.3.5). - ** AIX *** AIX 4.3.x or 4.4: Compiling fails. From a54ff8c18fa9b97b737d0de1a5e160b454ac294d Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Wed, 21 Aug 2024 08:50:02 +0000 Subject: [PATCH 17/57] Unexec removal: Build system * configure.ac (CYGWIN_OBJ): Remove comment. * src/Makefile.in (PAXCTL, SETFATTR, PAXCTL_dumped, PAXCTL_notdumped): Remove definitions. (emacs$(EXEEXT), temacs$(EXEEXT), bootstrap-emacs$(EXEEXT)): * src/deps.mk: Remove 'unexec'-specific code. --- configure.ac | 1 - src/Makefile.in | 33 --------------------------------- src/deps.mk | 10 +--------- 3 files changed, 1 insertion(+), 43 deletions(-) diff --git a/configure.ac b/configure.ac index 425e9cc4663..b320c4978d6 100644 --- a/configure.ac +++ b/configure.ac @@ -7207,7 +7207,6 @@ AC_SUBST([RALLOC_OBJ]) if test "$opsys" = "cygwin"; then CYGWIN_OBJ="cygw32.o" - ## Cygwin differs because of its unexec(). PRE_ALLOC_OBJ= POST_ALLOC_OBJ=lastfile.o elif test "$opsys" = "mingw32"; then diff --git a/src/Makefile.in b/src/Makefile.in index 03c2c8d6e0a..51352dd6d74 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -126,16 +126,6 @@ LD_SWITCH_SYSTEM_TEMACS=@LD_SWITCH_SYSTEM_TEMACS@ ## Flags to pass to ld only for temacs. TEMACS_LDFLAGS = $(LD_SWITCH_SYSTEM) $(LD_SWITCH_SYSTEM_TEMACS) -## If needed, the names of the paxctl and setfattr programs. -## On grsecurity/PaX systems, unexec will fail due to a gap between -## the bss section and the heap. Older versions need paxctl to work -## around this, newer ones setfattr. See Bug#11398 and Bug#16343. -PAXCTL = @PAXCTL@ -SETFATTR = @SETFATTR@ -## Commands to set PaX flags on dumped and not-dumped instances of Emacs. -PAXCTL_dumped = @PAXCTL_dumped@ -PAXCTL_notdumped = @PAXCTL_notdumped@ - ## Some systems define this to request special libraries. LIBS_SYSTEM=@LIBS_SYSTEM@ @@ -652,15 +642,7 @@ emacs$(EXEEXT): temacs$(EXEEXT) \ ifeq ($(SYSTEM_TYPE),cygwin) find ${top_builddir} -name '*.eln' | rebase -v -O -T - endif -ifeq ($(DUMPING),unexec) - LC_ALL=C $(RUN_TEMACS) -batch $(BUILD_DETAILS) -l loadup --temacs=dump - ifneq ($(PAXCTL_dumped),) - $(PAXCTL_dumped) emacs$(EXEEXT) - endif - cp -f $@ bootstrap-emacs$(EXEEXT) -else rm -f $@ && cp -f temacs$(EXEEXT) $@ -endif ## On Haiku, also produce a binary named Emacs with the appropriate ## icon set. @@ -749,11 +731,6 @@ endif endif $(AM_V_at)mv $@.tmp $@ $(MKDIR_P) $(etc) -ifeq ($(DUMPING),unexec) - ifneq ($(PAXCTL_notdumped),) - $(PAXCTL_notdumped) $@ - endif -endif ifeq ($(XCONFIGURE),android) ## The Android package internally links to a shared library named @@ -989,21 +966,11 @@ endif bootstrap-emacs$(EXEEXT): temacs$(EXEEXT) $(MAKE) -C ../lisp update-subdirs -ifeq ($(DUMPING),unexec) - $(RUN_TEMACS) --batch $(BUILD_DETAILS) -l loadup --temacs=bootstrap - ifneq ($(PAXCTL_dumped),) - $(PAXCTL_dumped) emacs$(EXEEXT) - endif - mv -f emacs$(EXEEXT) bootstrap-emacs$(EXEEXT) - @: Compile some files earlier to speed up further compilation. - $(MAKE) -C ../lisp compile-first EMACS="$(bootstrap_exe)" -else @: In the pdumper case, make compile-first after the dump cp -f temacs$(EXEEXT) bootstrap-emacs$(EXEEXT) ifeq ($(DO_CODESIGN),yes) codesign -s - -f bootstrap-emacs$(EXEEXT) endif -endif ifeq ($(DUMPING),pdumper) $(bootstrap_pdmp): bootstrap-emacs$(EXEEXT) diff --git a/src/deps.mk b/src/deps.mk index decb6670473..0ba43a014f8 100644 --- a/src/deps.mk +++ b/src/deps.mk @@ -92,7 +92,7 @@ editfns.o: editfns.c window.h buffer.h systime.h $(INTERVALS_H) character.h \ emacs.o: emacs.c commands.h systty.h syssignal.h blockinput.h process.h \ termhooks.h buffer.h atimer.h systime.h $(INTERVALS_H) lisp.h $(config_h) \ globals.h ../lib/unistd.h window.h dispextern.h keyboard.h keymap.h \ - frame.h coding.h gnutls.h msdos.h dosfns.h unexec.h + frame.h coding.h gnutls.h msdos.h dosfns.h fileio.o: fileio.c window.h buffer.h systime.h $(INTERVALS_H) character.h \ coding.h msdos.h blockinput.h atimer.h lisp.h $(config_h) frame.h \ commands.h globals.h ../lib/unistd.h @@ -202,14 +202,6 @@ terminfo.o: terminfo.c tparam.h lisp.h globals.h $(config_h) tparam.o: tparam.c tparam.h lisp.h $(config_h) undo.o: undo.c buffer.h commands.h window.h dispextern.h msdos.h \ lisp.h globals.h $(config_h) -unexaix.o: unexaix.c lisp.h unexec.h $(config_h) -unexcw.o: unexcw.c lisp.h unexec.h $(config_h) -unexcoff.o: unexcoff.c lisp.h unexec.h $(config_h) -unexelf.o: unexelf.c unexec.h ../lib/unistd.h $(config_h) -unexhp9k800.o: unexhp9k800.c unexec.h $(config_h) -unexmacosx.o: unexmacosx.c unexec.h $(config_h) -unexsol.o: unexsol.c lisp.h unexec.h $(config_h) -unexw32.o: unexw32.c unexec.h $(config_h) w16select.o: w16select.c dispextern.h frame.h blockinput.h atimer.h systime.h \ msdos.h buffer.h charset.h coding.h composite.h lisp.h $(config_h) widget.o: widget.c xterm.h frame.h dispextern.h widgetprv.h \ From 5b471384d1805bfb9e78314f8cb1f4d09aa378f7 Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Wed, 21 Aug 2024 19:13:23 +0000 Subject: [PATCH 18/57] Purecopy removal: Lisp code * lisp/emacs-lisp/bytecomp.el (byte-compile-cond-jump-table): Don't request our hash tables be purecopied. Adjust comment. * lisp/progmodes/elisp-mode.el (elisp--local-variables-completion-table): Use 'defconst' rather than 'defvar' now the purespace problem is gone * lisp/rfn-eshadow.el (file-name-shadow-properties): Remove obsolete comment. --- lisp/emacs-lisp/bytecomp.el | 3 +-- lisp/progmodes/elisp-mode.el | 6 +----- lisp/rfn-eshadow.el | 1 - 3 files changed, 2 insertions(+), 8 deletions(-) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f058fc48cc7..11f2ffa6063 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -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 diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 2b6d9d2b8bb..c24a1f4672b 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -489,11 +489,7 @@ use of `macroexpand-all' as a way to find the \"underlying raw code\".") var)) vars)))))) -(defvar elisp--local-variables-completion-table - ;; Use `defvar' rather than `defconst' since defconst would purecopy this - ;; value, which would doubly fail: it would fail because purecopy can't - ;; handle the recursive bytecode object, and it would fail because it would - ;; move `lastpos' and `lastvars' to pure space where they'd be immutable! +(defconst elisp--local-variables-completion-table (let ((lastpos nil) (lastvars nil)) (letrec ((hookfun (lambda () (setq lastpos nil) diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el index 5cf483bf0b1..c1e0e3da22b 100644 --- a/lisp/rfn-eshadow.el +++ b/lisp/rfn-eshadow.el @@ -92,7 +92,6 @@ (sexp :tag "Value"))))) (defcustom file-name-shadow-properties - ;; FIXME: should we purecopy this? '(face file-name-shadow field shadow) "Properties given to the `shadowed' part of a filename in the minibuffer. Only used when `file-name-shadow-mode' is active. From 1de87314c4c3cd01526e31bb805e2857fe749485 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Thu, 22 Aug 2024 00:09:51 +0200 Subject: [PATCH 19/57] Make bindings--define-key obsolete It used to be like 'define-key', but was used for making pure copies of as much of a menu's data as possible. With purespace now gone, it can be replaced by 'define-key'. * lisp/bindings.el (bindings--define-key): Make into obsolete alias for 'define-key'. Update all callers. --- lisp/bindings.el | 59 +-- lisp/bookmark.el | 22 +- lisp/international/mule-cmds.el | 56 +-- lisp/menu-bar.el | 710 ++++++++++++++++---------------- lisp/replace.el | 4 +- lisp/term/ns-win.el | 8 +- lisp/vc/vc-hooks.el | 50 +-- 7 files changed, 444 insertions(+), 465 deletions(-) diff --git a/lisp/bindings.el b/lisp/bindings.el index 06a488fa9fa..a3b6b15f32b 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -400,29 +400,6 @@ the symbol `mode-line-format-right-align' is processed by ;;;###autoload (put 'mode-line-format-right-align 'risky-local-variable t) -(defun bindings--define-key (map key item) - "Define KEY in keymap MAP according to ITEM from a menu. -This is like `define-key', but it takes the definition from the -specified menu item, and makes pure copies of as much as possible -of the menu's data." - (declare (indent 2)) - (define-key map key - (cond - ((not (consp item)) item) ;Not sure that could be other than a symbol. - ;; Keymaps can't be made pure otherwise users can't remove/add elements - ;; from/to them any more. - ((keymapp item) item) - ((stringp (car item)) - (if (keymapp (cdr item)) - (cons (purecopy (car item)) (cdr item)) - (purecopy item))) - ((eq 'menu-item (car item)) - (if (keymapp (nth 2 item)) - `(menu-item ,(purecopy (nth 1 item)) ,(nth 2 item) - ,@(purecopy (nthcdr 3 item))) - (purecopy item))) - (t (message "non-menu-item: %S" item) item)))) - (defvar mode-line-mode-menu (make-sparse-keymap "Minor Modes") "\ Menu of mode operations in the mode line.") @@ -454,11 +431,11 @@ a menu, so this function is not useful for non-menu keymaps." (defvar mode-line-major-mode-keymap (let ((map (make-sparse-keymap))) - (bindings--define-key map [mode-line down-mouse-1] + (define-key map [mode-line down-mouse-1] `(menu-item "Menu Bar" ignore :filter ,(lambda (_) (mouse-menu-major-mode-map)))) (define-key map [mode-line mouse-2] 'describe-mode) - (bindings--define-key map [mode-line down-mouse-3] + (define-key map [mode-line down-mouse-3] `(menu-item "Minor Modes" ,mode-line-mode-menu :filter bindings--sort-menu-keymap)) map) "\ @@ -509,15 +486,15 @@ mouse-3: Toggle minor modes" (defvar mode-line-column-line-number-mode-map (let ((map (make-sparse-keymap)) (menu-map (make-sparse-keymap "Toggle Line and Column Number Display"))) - (bindings--define-key menu-map [size-indication-mode] + (define-key menu-map [size-indication-mode] '(menu-item "Display Size Indication" size-indication-mode :help "Toggle displaying a size indication in the mode-line" :button (:toggle . size-indication-mode))) - (bindings--define-key menu-map [line-number-mode] + (define-key menu-map [line-number-mode] '(menu-item "Display Line Numbers" line-number-mode :help "Toggle displaying line numbers in the mode-line" :button (:toggle . line-number-mode))) - (bindings--define-key menu-map [column-number-mode] + (define-key menu-map [column-number-mode] '(menu-item "Display Column Numbers" column-number-mode :help "Toggle displaying column numbers in the mode-line" :button (:toggle . column-number-mode))) @@ -774,54 +751,54 @@ meaningful if it refers to a lexically bound variable." ;; Use mode-line-mode-menu for local minor-modes only. ;; Global ones can go on the menubar (Options --> Show/Hide). -(bindings--define-key mode-line-mode-menu [overwrite-mode] +(define-key mode-line-mode-menu [overwrite-mode] '(menu-item "Overwrite (Ovwrt)" overwrite-mode :help "Overwrite mode: typed characters replace existing text" :button (:toggle . overwrite-mode))) -(bindings--define-key mode-line-mode-menu [outline-minor-mode] +(define-key mode-line-mode-menu [outline-minor-mode] '(menu-item "Outline (Outl)" outline-minor-mode ;; XXX: This needs a good, brief description. :help "" :button (:toggle . (bound-and-true-p outline-minor-mode)))) -(bindings--define-key mode-line-mode-menu [highlight-changes-mode] +(define-key mode-line-mode-menu [highlight-changes-mode] '(menu-item "Highlight changes (Chg)" highlight-changes-mode :help "Show changes in the buffer in a distinctive color" :button (:toggle . (bound-and-true-p highlight-changes-mode)))) -(bindings--define-key mode-line-mode-menu [hide-ifdef-mode] +(define-key mode-line-mode-menu [hide-ifdef-mode] '(menu-item "Hide ifdef (Ifdef)" hide-ifdef-mode :help "Show/Hide code within #ifdef constructs" :button (:toggle . (bound-and-true-p hide-ifdef-mode)))) -(bindings--define-key mode-line-mode-menu [glasses-mode] +(define-key mode-line-mode-menu [glasses-mode] '(menu-item "Glasses (o^o)" glasses-mode :help "Insert virtual separators to make long identifiers easy to read" :button (:toggle . (bound-and-true-p glasses-mode)))) -(bindings--define-key mode-line-mode-menu [font-lock-mode] +(define-key mode-line-mode-menu [font-lock-mode] '(menu-item "Font Lock" font-lock-mode :help "Syntax coloring" :button (:toggle . font-lock-mode))) -(bindings--define-key mode-line-mode-menu [flyspell-mode] +(define-key mode-line-mode-menu [flyspell-mode] '(menu-item "Flyspell (Fly)" flyspell-mode :help "Spell checking on the fly" :button (:toggle . (bound-and-true-p flyspell-mode)))) -(bindings--define-key mode-line-mode-menu [completion-preview-mode] +(define-key mode-line-mode-menu [completion-preview-mode] '(menu-item "Completion Preview (CP)" completion-preview-mode :help "Show preview of completion suggestions as you type" :enable completion-at-point-functions :button (:toggle . (bound-and-true-p completion-preview-mode)))) -(bindings--define-key mode-line-mode-menu [auto-revert-tail-mode] +(define-key mode-line-mode-menu [auto-revert-tail-mode] '(menu-item "Auto revert tail (Tail)" auto-revert-tail-mode :help "Revert the tail of the buffer when the file on disk grows" :enable (buffer-file-name) :button (:toggle . (bound-and-true-p auto-revert-tail-mode)))) -(bindings--define-key mode-line-mode-menu [auto-revert-mode] +(define-key mode-line-mode-menu [auto-revert-mode] '(menu-item "Auto revert (ARev)" auto-revert-mode :help "Revert the buffer when the file on disk changes" :button (:toggle . (bound-and-true-p auto-revert-mode)))) -(bindings--define-key mode-line-mode-menu [auto-fill-mode] +(define-key mode-line-mode-menu [auto-fill-mode] '(menu-item "Auto fill (Fill)" auto-fill-mode :help "Automatically insert new lines" :button (:toggle . auto-fill-function))) -(bindings--define-key mode-line-mode-menu [abbrev-mode] +(define-key mode-line-mode-menu [abbrev-mode] '(menu-item "Abbrev (Abbrev)" abbrev-mode :help "Automatically expand abbreviations" :button (:toggle . abbrev-mode))) @@ -1648,6 +1625,8 @@ if `inhibit-field-text-motion' is non-nil." ;; Text conversion (define-key global-map [text-conversion] 'analyze-text-conversion) +(define-obsolete-function-alias 'bindings--define-key #'define-key "31.1") + ;; Don't look for autoload cookies in this file. ;; Local Variables: ;; no-update-autoloads: t diff --git a/lisp/bookmark.el b/lisp/bookmark.el index d43f9f740ca..d4a0eb138b0 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -2561,37 +2561,37 @@ strings returned are not." ;;;###autoload (defvar menu-bar-bookmark-map (let ((map (make-sparse-keymap "Bookmark functions"))) - (bindings--define-key map [load] + (define-key map [load] '(menu-item "Load a Bookmark File..." bookmark-load :help "Load bookmarks from a bookmark file)")) - (bindings--define-key map [write] + (define-key map [write] '(menu-item "Save Bookmarks As..." bookmark-write :help "Write bookmarks to a file (reading the file name with the minibuffer)")) - (bindings--define-key map [save] + (define-key map [save] '(menu-item "Save Bookmarks" bookmark-save :help "Save currently defined bookmarks")) - (bindings--define-key map [edit] + (define-key map [edit] '(menu-item "Edit Bookmark List" bookmark-bmenu-list :help "Display a list of existing bookmarks")) - (bindings--define-key map [delete] + (define-key map [delete] '(menu-item "Delete Bookmark..." bookmark-delete :help "Delete a bookmark from the bookmark list")) - (bindings--define-key map [delete-all] + (define-key map [delete-all] '(menu-item "Delete all Bookmarks..." bookmark-delete-all :help "Delete all bookmarks from the bookmark list")) - (bindings--define-key map [rename] + (define-key map [rename] '(menu-item "Rename Bookmark..." bookmark-rename :help "Change the name of a bookmark")) - (bindings--define-key map [locate] + (define-key map [locate] '(menu-item "Insert Location..." bookmark-locate :help "Insert the name of the file associated with a bookmark")) - (bindings--define-key map [insert] + (define-key map [insert] '(menu-item "Insert Contents..." bookmark-insert :help "Insert the text of the file pointed to by a bookmark")) - (bindings--define-key map [set] + (define-key map [set] '(menu-item "Set Bookmark..." bookmark-set :help "Set a bookmark named inside a file.")) - (bindings--define-key map [jump] + (define-key map [jump] '(menu-item "Jump to Bookmark..." bookmark-jump :help "Jump to a bookmark (a point in some file)")) map)) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index cefb6ddf9da..ef3622ec3ca 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -59,97 +59,97 @@ (defvar describe-language-environment-map (let ((map (make-sparse-keymap "Describe Language Environment"))) - (bindings--define-key map + (define-key map [Default] '(menu-item "Default" describe-specified-language-support)) map)) (defvar setup-language-environment-map (let ((map (make-sparse-keymap "Set Language Environment"))) - (bindings--define-key map + (define-key map [Default] '(menu-item "Default" setup-specified-language-environment)) map)) (defvar set-coding-system-map (let ((map (make-sparse-keymap "Set Coding System"))) - (bindings--define-key map [set-buffer-process-coding-system] + (define-key map [set-buffer-process-coding-system] '(menu-item "For I/O with Subprocess" set-buffer-process-coding-system :visible (fboundp 'make-process) :enable (get-buffer-process (current-buffer)) :help "How to en/decode I/O from/to subprocess connected to this buffer")) - (bindings--define-key map [set-next-selection-coding-system] + (define-key map [set-next-selection-coding-system] '(menu-item "For Next X Selection" set-next-selection-coding-system :visible (display-selections-p) :help "How to en/decode next selection/clipboard operation")) - (bindings--define-key map [set-selection-coding-system] + (define-key map [set-selection-coding-system] '(menu-item "For X Selections/Clipboard" set-selection-coding-system :visible (display-selections-p) :help "How to en/decode data to/from selection/clipboard")) - (bindings--define-key map [separator-3] menu-bar-separator) - (bindings--define-key map [set-terminal-coding-system] + (define-key map [separator-3] menu-bar-separator) + (define-key map [set-terminal-coding-system] '(menu-item "For Terminal" set-terminal-coding-system :enable (null (memq initial-window-system '(x w32 ns haiku pgtk android))) :help "How to encode terminal output")) - (bindings--define-key map [set-keyboard-coding-system] + (define-key map [set-keyboard-coding-system] '(menu-item "For Keyboard" set-keyboard-coding-system :help "How to decode keyboard input")) - (bindings--define-key map [separator-2] menu-bar-separator) - (bindings--define-key map [set-file-name-coding-system] + (define-key map [separator-2] menu-bar-separator) + (define-key map [set-file-name-coding-system] '(menu-item "For File Name" set-file-name-coding-system :help "How to decode/encode file names")) - (bindings--define-key map [revert-buffer-with-coding-system] + (define-key map [revert-buffer-with-coding-system] '(menu-item "For Reverting This File Now" revert-buffer-with-coding-system :enable buffer-file-name :help "Revisit this file immediately using specified coding system")) - (bindings--define-key map [set-buffer-file-coding-system] + (define-key map [set-buffer-file-coding-system] '(menu-item "For Saving This Buffer" set-buffer-file-coding-system :help "How to encode this buffer when saved")) - (bindings--define-key map [separator-1] menu-bar-separator) - (bindings--define-key map [universal-coding-system-argument] + (define-key map [separator-1] menu-bar-separator) + (define-key map [universal-coding-system-argument] '(menu-item "For Next Command" universal-coding-system-argument :help "Coding system to be used by next command")) map)) (defvar mule-menu-keymap (let ((map (make-sparse-keymap "Mule (Multilingual Environment)"))) - (bindings--define-key map [mule-diag] + (define-key map [mule-diag] '(menu-item "Show All Multilingual Settings" mule-diag :help "Display multilingual environment settings")) - (bindings--define-key map [list-character-sets] + (define-key map [list-character-sets] '(menu-item "List Character Sets" list-character-sets :help "Show table of available character sets")) - (bindings--define-key map [describe-coding-system] + (define-key map [describe-coding-system] '(menu-item "Describe Coding System..." describe-coding-system)) - (bindings--define-key map [describe-input-method] + (define-key map [describe-input-method] '(menu-item "Describe Input Method..." describe-input-method :help "Keyboard layout for a specific input method")) - (bindings--define-key map [describe-language-environment] + (define-key map [describe-language-environment] `(menu-item "Describe Language Environment" ,describe-language-environment-map :help "Show multilingual settings for a specific language")) - (bindings--define-key map [separator-coding-system] menu-bar-separator) - (bindings--define-key map [view-hello-file] + (define-key map [separator-coding-system] menu-bar-separator) + (define-key map [view-hello-file] '(menu-item "Show Multilingual Sample Text" view-hello-file :enable (file-readable-p (expand-file-name "HELLO" data-directory)) :help "Demonstrate various character sets")) - (bindings--define-key map [set-various-coding-system] + (define-key map [set-various-coding-system] `(menu-item "Set Coding Systems" ,set-coding-system-map)) - (bindings--define-key map [separator-input-method] menu-bar-separator) - (bindings--define-key map [activate-transient-input-method] + (define-key map [separator-input-method] menu-bar-separator) + (define-key map [activate-transient-input-method] '(menu-item "Transient Input Method" activate-transient-input-method)) - (bindings--define-key map [set-input-method] + (define-key map [set-input-method] '(menu-item "Select Input Method..." set-input-method)) - (bindings--define-key map [toggle-input-method] + (define-key map [toggle-input-method] '(menu-item "Toggle Input Method" toggle-input-method)) - (bindings--define-key map [separator-mule] menu-bar-separator) - (bindings--define-key map [set-language-environment] + (define-key map [separator-mule] menu-bar-separator) + (define-key map [set-language-environment] `(menu-item "Set Language Environment" ,setup-language-environment-map)) map) "Keymap for Mule (Multilingual environment) menu specific commands.") diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index b85cc834588..b625a317c56 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -51,29 +51,29 @@ (defvar menu-bar-print-menu (let ((menu (make-sparse-keymap "Print"))) - (bindings--define-key menu [ps-print-region] + (define-key menu [ps-print-region] '(menu-item "PostScript Print Region (B+W)" ps-print-region :enable mark-active :help "Pretty-print marked region in black and white to PostScript printer")) - (bindings--define-key menu [ps-print-buffer] + (define-key menu [ps-print-buffer] '(menu-item "PostScript Print Buffer (B+W)" ps-print-buffer :enable (menu-bar-menu-frame-live-and-visible-p) :help "Pretty-print current buffer in black and white to PostScript printer")) - (bindings--define-key menu [ps-print-region-faces] + (define-key menu [ps-print-region-faces] '(menu-item "PostScript Print Region" ps-print-region-with-faces :enable mark-active :help "Pretty-print marked region to PostScript printer")) - (bindings--define-key menu [ps-print-buffer-faces] + (define-key menu [ps-print-buffer-faces] '(menu-item "PostScript Print Buffer" ps-print-buffer-with-faces :enable (menu-bar-menu-frame-live-and-visible-p) :help "Pretty-print current buffer to PostScript printer")) - (bindings--define-key menu [print-region] + (define-key menu [print-region] '(menu-item "Print Region" print-region :enable mark-active :help "Print region between mark and current position")) - (bindings--define-key menu [print-buffer] + (define-key menu [print-buffer] '(menu-item "Print Buffer" print-buffer :enable (menu-bar-menu-frame-live-and-visible-p) :help "Print current buffer with page headings")) @@ -91,37 +91,37 @@ in the tool bar will close the current window where possible." (let ((menu (make-sparse-keymap "File"))) ;; The "File" menu items - (bindings--define-key menu [exit-emacs] + (define-key menu [exit-emacs] '(menu-item "Quit" save-buffers-kill-terminal :help "Save unsaved buffers, then exit")) - (bindings--define-key menu [separator-exit] + (define-key menu [separator-exit] menu-bar-separator) - (bindings--define-key menu [print] + (define-key menu [print] `(menu-item "Print" ,menu-bar-print-menu)) - (bindings--define-key menu [separator-print] + (define-key menu [separator-print] menu-bar-separator) - (bindings--define-key menu [close-tab] + (define-key menu [close-tab] '(menu-item "Close Tab" tab-close :visible (fboundp 'tab-close) :help "Close currently selected tab")) - (bindings--define-key menu [make-tab] + (define-key menu [make-tab] '(menu-item "New Tab" tab-new :visible (fboundp 'tab-new) :help "Open a new tab")) - (bindings--define-key menu [separator-tab] + (define-key menu [separator-tab] menu-bar-separator) - (bindings--define-key menu [undelete-frame-mode] + (define-key menu [undelete-frame-mode] '(menu-item "Allow Undeleting Frames" undelete-frame-mode :help "Allow frames to be restored after deletion" :button (:toggle . undelete-frame-mode))) - (bindings--define-key menu [undelete-last-deleted-frame] + (define-key menu [undelete-last-deleted-frame] '(menu-item "Undelete Frame" undelete-frame :enable (and undelete-frame-mode (car undelete-frame--deleted-frames)) @@ -129,48 +129,48 @@ in the tool bar will close the current window where possible." ;; Don't use delete-frame as event name because that is a special ;; event. - (bindings--define-key menu [delete-this-frame] + (define-key menu [delete-this-frame] '(menu-item "Delete Frame" delete-frame :visible (fboundp 'delete-frame) :enable (delete-frame-enabled-p) :help "Delete currently selected frame")) - (bindings--define-key menu [make-frame-on-monitor] + (define-key menu [make-frame-on-monitor] '(menu-item "New Frame on Monitor..." make-frame-on-monitor :visible (fboundp 'make-frame-on-monitor) :help "Open a new frame on another monitor")) - (bindings--define-key menu [make-frame-on-display] + (define-key menu [make-frame-on-display] '(menu-item "New Frame on Display Server..." make-frame-on-display :visible (fboundp 'make-frame-on-display) :help "Open a new frame on a display server")) - (bindings--define-key menu [make-frame] + (define-key menu [make-frame] '(menu-item "New Frame" make-frame-command :visible (fboundp 'make-frame-command) :help "Open a new frame")) - (bindings--define-key menu [separator-frame] + (define-key menu [separator-frame] menu-bar-separator) - (bindings--define-key menu [one-window] + (define-key menu [one-window] '(menu-item "Remove Other Windows" delete-other-windows :enable (not (one-window-p t nil)) :help "Make selected window fill whole frame")) - (bindings--define-key menu [new-window-on-right] + (define-key menu [new-window-on-right] '(menu-item "New Window on Right" split-window-right :enable (and (menu-bar-menu-frame-live-and-visible-p) (menu-bar-non-minibuffer-window-p)) :help "Make new window on right of selected one")) - (bindings--define-key menu [new-window-below] + (define-key menu [new-window-below] '(menu-item "New Window Below" split-window-below :enable (and (menu-bar-menu-frame-live-and-visible-p) (menu-bar-non-minibuffer-window-p)) :help "Make new window below selected one")) - (bindings--define-key menu [separator-window] + (define-key menu [separator-window] menu-bar-separator) - (bindings--define-key menu [recover-session] + (define-key menu [recover-session] '(menu-item "Recover Crashed Session" recover-session :enable (and auto-save-list-file-prefix @@ -185,7 +185,7 @@ in the tool bar will close the current window where possible." auto-save-list-file-prefix))) t)) :help "Recover edits from a crashed session")) - (bindings--define-key menu [revert-buffer] + (define-key menu [revert-buffer] '(menu-item "Revert Buffer" revert-buffer :enable @@ -203,47 +203,47 @@ in the tool bar will close the current window where possible." (not (eq (not buffer-read-only) (file-writable-p buffer-file-name)))))) :help "Re-read current buffer from its file")) - (bindings--define-key menu [write-file] + (define-key menu [write-file] '(menu-item "Save As..." write-file :enable (and (menu-bar-menu-frame-live-and-visible-p) (menu-bar-non-minibuffer-window-p)) :help "Write current buffer to another file")) - (bindings--define-key menu [save-buffer] + (define-key menu [save-buffer] '(menu-item "Save" save-buffer :enable (and (buffer-modified-p) (buffer-file-name) (menu-bar-non-minibuffer-window-p)) :help "Save current buffer to its file")) - (bindings--define-key menu [separator-save] + (define-key menu [separator-save] menu-bar-separator) - (bindings--define-key menu [kill-buffer] + (define-key menu [kill-buffer] '(menu-item "Close" kill-this-buffer :enable (kill-this-buffer-enabled-p) :help "Discard (kill) current buffer")) - (bindings--define-key menu [insert-file] + (define-key menu [insert-file] '(menu-item "Insert File..." insert-file :enable (menu-bar-non-minibuffer-window-p) :help "Insert another file into current buffer")) - (bindings--define-key menu [project-dired] + (define-key menu [project-dired] '(menu-item "Open Project Directory" project-dired :enable (menu-bar-non-minibuffer-window-p) :help "Read the root directory of the current project, to operate on its files")) - (bindings--define-key menu [dired] + (define-key menu [dired] '(menu-item "Open Directory..." dired :enable (menu-bar-non-minibuffer-window-p) :help "Read a directory, to operate on its files")) - (bindings--define-key menu [project-open-file] + (define-key menu [project-open-file] '(menu-item "Open File In Project..." project-find-file :enable (menu-bar-non-minibuffer-window-p) :help "Read existing file that belongs to current project into an Emacs buffer")) - (bindings--define-key menu [open-file] + (define-key menu [open-file] '(menu-item "Open File..." menu-find-file-existing :enable (menu-bar-non-minibuffer-window-p) :help "Read an existing file into an Emacs buffer")) - (bindings--define-key menu [new-file] + (define-key menu [new-file] '(menu-item "Visit New File..." find-file :enable (menu-bar-non-minibuffer-window-p) :help "Specify a new file's name, to edit the file")) @@ -330,45 +330,45 @@ in the tool bar will close the current window where possible." ;; The Edit->Incremental Search menu (defvar menu-bar-i-search-menu (let ((menu (make-sparse-keymap "Incremental Search"))) - (bindings--define-key menu [isearch-forward-symbol-at-point] + (define-key menu [isearch-forward-symbol-at-point] '(menu-item "Forward Symbol at Point..." isearch-forward-symbol-at-point :help "Search forward for a symbol found at point")) - (bindings--define-key menu [isearch-forward-symbol] + (define-key menu [isearch-forward-symbol] '(menu-item "Forward Symbol..." isearch-forward-symbol :help "Search forward for a symbol as you type it")) - (bindings--define-key menu [isearch-forward-word] + (define-key menu [isearch-forward-word] '(menu-item "Forward Word..." isearch-forward-word :help "Search forward for a word as you type it")) - (bindings--define-key menu [isearch-backward-regexp] + (define-key menu [isearch-backward-regexp] '(menu-item "Backward Regexp..." isearch-backward-regexp :help "Search backwards for a regular expression as you type it")) - (bindings--define-key menu [isearch-forward-regexp] + (define-key menu [isearch-forward-regexp] '(menu-item "Forward Regexp..." isearch-forward-regexp :help "Search forward for a regular expression as you type it")) - (bindings--define-key menu [isearch-backward] + (define-key menu [isearch-backward] '(menu-item "Backward String..." isearch-backward :help "Search backwards for a string as you type it")) - (bindings--define-key menu [isearch-forward] + (define-key menu [isearch-forward] '(menu-item "Forward String..." isearch-forward :help "Search forward for a string as you type it")) menu)) (defvar menu-bar-search-menu (let ((menu (make-sparse-keymap "Search"))) - (bindings--define-key menu [tags-continue] + (define-key menu [tags-continue] '(menu-item "Continue Tags Search" fileloop-continue :enable (and (featurep 'fileloop) (not (eq fileloop--operate-function 'ignore))) :help "Continue last tags search operation")) - (bindings--define-key menu [tags-srch] + (define-key menu [tags-srch] '(menu-item "Search Tagged Files..." tags-search :help "Search for a regexp in all tagged files")) - (bindings--define-key menu [project-search] + (define-key menu [project-search] '(menu-item "Search in Project Files..." project-find-regexp :help "Search for a regexp in files belonging to current project")) - (bindings--define-key menu [separator-tag-search] menu-bar-separator) + (define-key menu [separator-tag-search] menu-bar-separator) - (bindings--define-key menu [repeat-search-back] + (define-key menu [repeat-search-back] '(menu-item "Repeat Backwards" nonincremental-repeat-search-backward :enable (or (and (eq menu-bar-last-search-type 'string) @@ -376,7 +376,7 @@ in the tool bar will close the current window where possible." (and (eq menu-bar-last-search-type 'regexp) regexp-search-ring)) :help "Repeat last search backwards")) - (bindings--define-key menu [repeat-search-fwd] + (define-key menu [repeat-search-fwd] '(menu-item "Repeat Forward" nonincremental-repeat-search-forward :enable (or (and (eq menu-bar-last-search-type 'string) @@ -384,23 +384,23 @@ in the tool bar will close the current window where possible." (and (eq menu-bar-last-search-type 'regexp) regexp-search-ring)) :help "Repeat last search forward")) - (bindings--define-key menu [separator-repeat-search] + (define-key menu [separator-repeat-search] menu-bar-separator) - (bindings--define-key menu [re-search-backward] + (define-key menu [re-search-backward] '(menu-item "Regexp Backwards..." nonincremental-re-search-backward :help "Search backwards for a regular expression")) - (bindings--define-key menu [re-search-forward] + (define-key menu [re-search-forward] '(menu-item "Regexp Forward..." nonincremental-re-search-forward :help "Search forward for a regular expression")) - (bindings--define-key menu [search-backward] + (define-key menu [search-backward] '(menu-item "String Backwards..." nonincremental-search-backward :help "Search backwards for a string")) - (bindings--define-key menu [search-forward] + (define-key menu [search-forward] '(menu-item "String Forward..." nonincremental-search-forward :help "Search forward for a string")) menu)) @@ -409,25 +409,25 @@ in the tool bar will close the current window where possible." (defvar menu-bar-replace-menu (let ((menu (make-sparse-keymap "Replace"))) - (bindings--define-key menu [tags-repl-continue] + (define-key menu [tags-repl-continue] '(menu-item "Continue Replace" fileloop-continue :enable (and (featurep 'fileloop) (not (eq fileloop--operate-function 'ignore))) :help "Continue last tags replace operation")) - (bindings--define-key menu [tags-repl] + (define-key menu [tags-repl] '(menu-item "Replace in Tagged Files..." tags-query-replace :help "Interactively replace a regexp in all tagged files")) - (bindings--define-key menu [project-replace] + (define-key menu [project-replace] '(menu-item "Replace in Project Files..." project-query-replace-regexp :help "Interactively replace a regexp in files belonging to current project")) - (bindings--define-key menu [separator-replace-tags] + (define-key menu [separator-replace-tags] menu-bar-separator) - (bindings--define-key menu [query-replace-regexp] + (define-key menu [query-replace-regexp] '(menu-item "Replace Regexp..." query-replace-regexp :enable (not buffer-read-only) :help "Replace regular expression interactively, ask about each occurrence")) - (bindings--define-key menu [query-replace] + (define-key menu [query-replace] '(menu-item "Replace String..." query-replace :enable (not buffer-read-only) :help "Replace string interactively, ask about each occurrence")) @@ -437,49 +437,49 @@ in the tool bar will close the current window where possible." (defvar menu-bar-goto-menu (let ((menu (make-sparse-keymap "Go To"))) - (bindings--define-key menu [set-tags-name] + (define-key menu [set-tags-name] '(menu-item "Set Tags File Name..." visit-tags-table :visible (menu-bar-goto-uses-etags-p) :help "Tell navigation commands which tag table file to use")) - (bindings--define-key menu [separator-tag-file] + (define-key menu [separator-tag-file] '(menu-item "--" nil :visible (menu-bar-goto-uses-etags-p))) - (bindings--define-key menu [xref-forward] + (define-key menu [xref-forward] '(menu-item "Forward" xref-go-forward :visible (and (featurep 'xref) (not (xref-forward-history-empty-p))) :help "Forward to the position gone Back from")) - (bindings--define-key menu [xref-pop] + (define-key menu [xref-pop] '(menu-item "Back" xref-go-back :visible (and (featurep 'xref) (not (xref-marker-stack-empty-p))) :help "Back to the position of the last search")) - (bindings--define-key menu [xref-apropos] + (define-key menu [xref-apropos] '(menu-item "Find Apropos..." xref-find-apropos :help "Find function/variables whose names match regexp")) - (bindings--define-key menu [xref-find-otherw] + (define-key menu [xref-find-otherw] '(menu-item "Find Definition in Other Window..." xref-find-definitions-other-window :help "Find function/variable definition in another window")) - (bindings--define-key menu [xref-find-def] + (define-key menu [xref-find-def] '(menu-item "Find Definition..." xref-find-definitions :help "Find definition of function or variable")) - (bindings--define-key menu [separator-xref] + (define-key menu [separator-xref] menu-bar-separator) - (bindings--define-key menu [end-of-buf] + (define-key menu [end-of-buf] '(menu-item "Goto End of Buffer" end-of-buffer)) - (bindings--define-key menu [beg-of-buf] + (define-key menu [beg-of-buf] '(menu-item "Goto Beginning of Buffer" beginning-of-buffer)) - (bindings--define-key menu [go-to-pos] + (define-key menu [go-to-pos] '(menu-item "Goto Buffer Position..." goto-char :help "Read a number N and go to buffer position N")) - (bindings--define-key menu [go-to-line] + (define-key menu [go-to-line] '(menu-item "Goto Line..." goto-line :help "Read a line number and go to that line")) menu)) @@ -494,47 +494,47 @@ in the tool bar will close the current window where possible." (defvar menu-bar-edit-menu (let ((menu (make-sparse-keymap "Edit"))) - (bindings--define-key menu [execute-extended-command] + (define-key menu [execute-extended-command] '(menu-item "Execute Command" execute-extended-command :enable t :help "Read a command name, its arguments, then call it.")) ;; ns-win.el said: Add spell for platform consistency. (if (featurep 'ns) - (bindings--define-key menu [spell] + (define-key menu [spell] '(menu-item "Spell" ispell-menu-map))) - (bindings--define-key menu [fill] + (define-key menu [fill] '(menu-item "Fill" fill-region :enable (and mark-active (not buffer-read-only)) :help "Fill text in region to fit between left and right margin")) - (bindings--define-key menu [separator-bookmark] + (define-key menu [separator-bookmark] menu-bar-separator) - (bindings--define-key menu [bookmark] + (define-key menu [bookmark] '(menu-item "Bookmarks" menu-bar-bookmark-map)) - (bindings--define-key menu [goto] + (define-key menu [goto] `(menu-item "Go To" ,menu-bar-goto-menu)) - (bindings--define-key menu [replace] + (define-key menu [replace] `(menu-item "Replace" ,menu-bar-replace-menu)) - (bindings--define-key menu [i-search] + (define-key menu [i-search] `(menu-item "Incremental Search" ,menu-bar-i-search-menu)) - (bindings--define-key menu [search] + (define-key menu [search] `(menu-item "Search" ,menu-bar-search-menu)) - (bindings--define-key menu [separator-search] + (define-key menu [separator-search] menu-bar-separator) - (bindings--define-key menu [mark-whole-buffer] + (define-key menu [mark-whole-buffer] '(menu-item "Select All" mark-whole-buffer :help "Mark the whole buffer for a subsequent cut/copy")) - (bindings--define-key menu [clear] + (define-key menu [clear] '(menu-item "Clear" delete-active-region :enable (and mark-active (not buffer-read-only)) @@ -542,7 +542,7 @@ in the tool bar will close the current window where possible." "Delete the text in region between mark and current position")) - (bindings--define-key menu (if (featurep 'ns) [select-paste] + (define-key menu (if (featurep 'ns) [select-paste] [paste-from-menu]) ;; ns-win.el said: Change text to be more consistent with ;; surrounding menu items `paste', etc." @@ -550,7 +550,7 @@ in the tool bar will close the current window where possible." yank-menu :enable (and (cdr yank-menu) (not buffer-read-only)) :help "Choose a string from the kill ring and paste it")) - (bindings--define-key menu [paste] + (define-key menu [paste] `(menu-item "Paste" yank :enable (funcall ',(lambda () @@ -565,7 +565,7 @@ in the tool bar will close the current window where possible." (if cua-mode "\\[cua-paste]" "\\[yank]")))) - (bindings--define-key menu [copy] + (define-key menu [copy] ;; ns-win.el said: Substitute a Copy function that works better ;; under X (for GNUstep). `(menu-item "Copy" ,(if (featurep 'ns) @@ -581,7 +581,7 @@ in the tool bar will close the current window where possible." "\\[cua-copy-handler]") (t "\\[kill-ring-save]"))))) - (bindings--define-key menu [cut] + (define-key menu [cut] `(menu-item "Cut" kill-region :enable (and mark-active (not buffer-read-only)) :help @@ -592,15 +592,15 @@ in the tool bar will close the current window where possible." "\\[kill-region]")))) ;; ns-win.el said: Separate undo from cut/paste section. (if (featurep 'ns) - (bindings--define-key menu [separator-undo] menu-bar-separator)) + (define-key menu [separator-undo] menu-bar-separator)) - (bindings--define-key menu [undo-redo] + (define-key menu [undo-redo] '(menu-item "Redo" undo-redo :enable (and (not buffer-read-only) (undo--last-change-was-undo-p buffer-undo-list)) :help "Redo last undone edits")) - (bindings--define-key menu [undo] + (define-key menu [undo] '(menu-item "Undo" undo :enable (and (not buffer-read-only) (not (eq t buffer-undo-list)) @@ -667,43 +667,43 @@ Do the same for the keys of the same name." (defvar menu-bar-custom-menu (let ((menu (make-sparse-keymap "Customize"))) - (bindings--define-key menu [customize-apropos-faces] + (define-key menu [customize-apropos-faces] '(menu-item "Faces Matching..." customize-apropos-faces :help "Browse faces matching a regexp or word list")) - (bindings--define-key menu [customize-apropos-options] + (define-key menu [customize-apropos-options] '(menu-item "Options Matching..." customize-apropos-options :help "Browse options matching a regexp or word list")) - (bindings--define-key menu [customize-apropos] + (define-key menu [customize-apropos] '(menu-item "All Settings Matching..." customize-apropos :help "Browse customizable settings matching a regexp or word list")) - (bindings--define-key menu [separator-1] + (define-key menu [separator-1] menu-bar-separator) - (bindings--define-key menu [customize-group] + (define-key menu [customize-group] '(menu-item "Specific Group..." customize-group :help "Customize settings of specific group")) - (bindings--define-key menu [customize-face] + (define-key menu [customize-face] '(menu-item "Specific Face..." customize-face :help "Customize attributes of specific face")) - (bindings--define-key menu [customize-option] + (define-key menu [customize-option] '(menu-item "Specific Option..." customize-option :help "Customize value of specific option")) - (bindings--define-key menu [separator-2] + (define-key menu [separator-2] menu-bar-separator) - (bindings--define-key menu [customize-changed] + (define-key menu [customize-changed] '(menu-item "New Options..." customize-changed :help "Options and faces added or changed in recent Emacs versions")) - (bindings--define-key menu [customize-saved] + (define-key menu [customize-saved] '(menu-item "Saved Options" customize-saved :help "Customize previously saved options")) - (bindings--define-key menu [separator-3] + (define-key menu [separator-3] menu-bar-separator) - (bindings--define-key menu [customize-browse] + (define-key menu [customize-browse] '(menu-item "Browse Customization Groups" customize-browse :help "Tree-like browser of all the groups of customizable options")) - (bindings--define-key menu [customize] + (define-key menu [customize] '(menu-item "Top-level Emacs Customization Group" customize :help "Top-level groups of customizable options, and their descriptions")) - (bindings--define-key menu [customize-themes] + (define-key menu [customize-themes] '(menu-item "Custom Themes" customize-themes :help "Choose a pre-defined customization theme")) menu)) @@ -883,12 +883,12 @@ The selected font will be the default on both the existing and future frames." ;; dividers are displayed by manipulating frame parameters directly. (defvar menu-bar-showhide-window-divider-menu (let ((menu (make-sparse-keymap "Window Divider"))) - (bindings--define-key menu [customize] + (define-key menu [customize] '(menu-item "Customize" menu-bar-window-divider-customize :help "Customize window dividers" :visible (memq (window-system) '(x w32)))) - (bindings--define-key menu [bottom-and-right] + (define-key menu [bottom-and-right] '(menu-item "Bottom and Right" menu-bar-bottom-and-right-window-divider :help "Display window divider on the bottom and right of each window" @@ -900,7 +900,7 @@ The selected font will be the default on both the existing and future frames." (window-divider-width-valid-p (cdr (assq 'right-divider-width (frame-parameters)))))))) - (bindings--define-key menu [right-only] + (define-key menu [right-only] '(menu-item "Right Only" menu-bar-right-window-divider :help "Display window divider on the right of each window only" @@ -912,7 +912,7 @@ The selected font will be the default on both the existing and future frames." (window-divider-width-valid-p (cdr (assq 'right-divider-width (frame-parameters)))))))) - (bindings--define-key menu [bottom-only] + (define-key menu [bottom-only] '(menu-item "Bottom Only" menu-bar-bottom-window-divider :help "Display window divider on the bottom of each window only" @@ -924,7 +924,7 @@ The selected font will be the default on both the existing and future frames." (not (window-divider-width-valid-p (cdr (assq 'right-divider-width (frame-parameters))))))))) - (bindings--define-key menu [no-divider] + (define-key menu [no-divider] '(menu-item "None" menu-bar-no-window-divider :help "Do not display window dividers" @@ -973,7 +973,7 @@ The selected font will be the default on both the existing and future frames." (defvar menu-bar-showhide-fringe-ind-menu (let ((menu (make-sparse-keymap "Buffer boundaries"))) - (bindings--define-key menu [customize] + (define-key menu [customize] '(menu-item "Other (Customize)" menu-bar-showhide-fringe-ind-customize :help "Additional choices available through Custom buffer" @@ -983,7 +983,7 @@ The selected font will be the default on both the existing and future frames." ((top . left) (bottom . right)) ((t . right) (top . left)))))))) - (bindings--define-key menu [mixed] + (define-key menu [mixed] '(menu-item "Opposite, Arrows Right" menu-bar-showhide-fringe-ind-mixed :help "Show top/bottom indicators in opposite fringes, arrows in right" @@ -991,26 +991,26 @@ The selected font will be the default on both the existing and future frames." :button (:radio . (equal indicate-buffer-boundaries '((t . right) (top . left)))))) - (bindings--define-key menu [box] + (define-key menu [box] '(menu-item "Opposite, No Arrows" menu-bar-showhide-fringe-ind-box :help "Show top/bottom indicators in opposite fringes, no arrows" :visible (display-graphic-p) :button (:radio . (equal indicate-buffer-boundaries '((top . left) (bottom . right)))))) - (bindings--define-key menu [right] + (define-key menu [right] '(menu-item "In Right Fringe" menu-bar-showhide-fringe-ind-right :help "Show buffer boundaries and arrows in right fringe" :visible (display-graphic-p) :button (:radio . (eq indicate-buffer-boundaries 'right)))) - (bindings--define-key menu [left] + (define-key menu [left] '(menu-item "In Left Fringe" menu-bar-showhide-fringe-ind-left :help "Show buffer boundaries and arrows in left fringe" :visible (display-graphic-p) :button (:radio . (eq indicate-buffer-boundaries 'left)))) - (bindings--define-key menu [none] + (define-key menu [none] '(menu-item "No Indicators" menu-bar-showhide-fringe-ind-none :help "Hide all buffer boundary indicators and arrows" :visible (display-graphic-p) @@ -1048,42 +1048,42 @@ The selected font will be the default on both the existing and future frames." (defvar menu-bar-showhide-fringe-menu (let ((menu (make-sparse-keymap "Fringe"))) - (bindings--define-key menu [showhide-fringe-ind] + (define-key menu [showhide-fringe-ind] `(menu-item "Buffer Boundaries" ,menu-bar-showhide-fringe-ind-menu :visible (display-graphic-p) :help "Indicate buffer boundaries in fringe")) - (bindings--define-key menu [indicate-empty-lines] + (define-key menu [indicate-empty-lines] (menu-bar-make-toggle-command toggle-indicate-empty-lines indicate-empty-lines "Empty Line Indicators" "Indicating of empty lines %s" "Indicate trailing empty lines in fringe, globally")) - (bindings--define-key menu [customize] + (define-key menu [customize] '(menu-item "Customize Fringe" menu-bar-showhide-fringe-menu-customize :help "Detailed customization of fringe" :visible (display-graphic-p))) - (bindings--define-key menu [default] + (define-key menu [default] '(menu-item "Default" menu-bar-showhide-fringe-menu-customize-reset :help "Default width fringe on both left and right side" :visible (display-graphic-p) :button (:radio . (eq fringe-mode nil)))) - (bindings--define-key menu [right] + (define-key menu [right] '(menu-item "On the Right" menu-bar-showhide-fringe-menu-customize-right :help "Fringe only on the right side" :visible (display-graphic-p) :button (:radio . (equal fringe-mode '(0 . nil))))) - (bindings--define-key menu [left] + (define-key menu [left] '(menu-item "On the Left" menu-bar-showhide-fringe-menu-customize-left :help "Fringe only on the left side" :visible (display-graphic-p) :button (:radio . (equal fringe-mode '(nil . 0))))) - (bindings--define-key menu [none] + (define-key menu [none] '(menu-item "None" menu-bar-showhide-fringe-menu-customize-disable :help "Turn off fringe" :visible (display-graphic-p) @@ -1108,15 +1108,15 @@ The selected font will be the default on both the existing and future frames." (defvar menu-bar-showhide-scroll-bar-menu (let ((menu (make-sparse-keymap "Scroll Bar"))) - (bindings--define-key menu [horizontal] + (define-key menu [horizontal] (menu-bar-make-mm-toggle horizontal-scroll-bar-mode "Horizontal" "Horizontal scroll bar")) - (bindings--define-key menu [scrollbar-separator] + (define-key menu [scrollbar-separator] menu-bar-separator) - (bindings--define-key menu [right] + (define-key menu [right] '(menu-item "On the Right" menu-bar-right-scroll-bar :help "Scroll bar on the right side" :visible (display-graphic-p) @@ -1125,7 +1125,7 @@ The selected font will be the default on both the existing and future frames." nil 'vertical-scroll-bars) 'right))))) - (bindings--define-key menu [left] + (define-key menu [left] '(menu-item "On the Left" menu-bar-left-scroll-bar :help "Scroll bar on the left side" :visible (display-graphic-p) @@ -1134,7 +1134,7 @@ The selected font will be the default on both the existing and future frames." nil 'vertical-scroll-bars) 'left))))) - (bindings--define-key menu [none] + (define-key menu [none] '(menu-item "No Vertical Scroll Bar" menu-bar-no-scroll-bar :help "Turn off vertical scroll bar" :visible (display-graphic-p) @@ -1180,7 +1180,7 @@ The selected font will be the default on both the existing and future frames." (defvar menu-bar-showhide-tool-bar-menu (let ((menu (make-sparse-keymap "Tool Bar"))) - (bindings--define-key menu [showhide-tool-bar-left] + (define-key menu [showhide-tool-bar-left] '(menu-item "On the Left" menu-bar-showhide-tool-bar-menu-customize-enable-left :help "Tool bar at the left side" @@ -1192,7 +1192,7 @@ The selected font will be the default on both the existing and future frames." 'tool-bar-position) 'left))))) - (bindings--define-key menu [showhide-tool-bar-right] + (define-key menu [showhide-tool-bar-right] '(menu-item "On the Right" menu-bar-showhide-tool-bar-menu-customize-enable-right :help "Tool bar at the right side" @@ -1204,7 +1204,7 @@ The selected font will be the default on both the existing and future frames." 'tool-bar-position) 'right))))) - (bindings--define-key menu [showhide-tool-bar-bottom] + (define-key menu [showhide-tool-bar-bottom] '(menu-item "On the Bottom" menu-bar-showhide-tool-bar-menu-customize-enable-bottom :help "Tool bar at the bottom" @@ -1216,7 +1216,7 @@ The selected font will be the default on both the existing and future frames." 'tool-bar-position) 'bottom))))) - (bindings--define-key menu [showhide-tool-bar-top] + (define-key menu [showhide-tool-bar-top] '(menu-item "On the Top" menu-bar-showhide-tool-bar-menu-customize-enable-top :help "Tool bar at the top" @@ -1228,7 +1228,7 @@ The selected font will be the default on both the existing and future frames." 'tool-bar-position) 'top))))) - (bindings--define-key menu [showhide-tool-bar-none] + (define-key menu [showhide-tool-bar-none] '(menu-item "None" menu-bar-showhide-tool-bar-menu-customize-disable :help "Turn tool bar off" @@ -1271,35 +1271,35 @@ The selected font will be the default on both the existing and future frames." (defvar menu-bar-showhide-line-numbers-menu (let ((menu (make-sparse-keymap "Line Numbers"))) - (bindings--define-key menu [visual] + (define-key menu [visual] '(menu-item "Visual Line Numbers" menu-bar--display-line-numbers-mode-visual :help "Enable visual line numbers" :button (:radio . (eq display-line-numbers 'visual)) :visible (menu-bar-menu-frame-live-and-visible-p))) - (bindings--define-key menu [relative] + (define-key menu [relative] '(menu-item "Relative Line Numbers" menu-bar--display-line-numbers-mode-relative :help "Enable relative line numbers" :button (:radio . (eq display-line-numbers 'relative)) :visible (menu-bar-menu-frame-live-and-visible-p))) - (bindings--define-key menu [absolute] + (define-key menu [absolute] '(menu-item "Absolute Line Numbers" menu-bar--display-line-numbers-mode-absolute :help "Enable absolute line numbers" :button (:radio . (eq display-line-numbers t)) :visible (menu-bar-menu-frame-live-and-visible-p))) - (bindings--define-key menu [none] + (define-key menu [none] '(menu-item "No Line Numbers" menu-bar--display-line-numbers-mode-none :help "Disable line numbers" :button (:radio . (null display-line-numbers)) :visible (menu-bar-menu-frame-live-and-visible-p))) - (bindings--define-key menu [global] + (define-key menu [global] (menu-bar-make-mm-toggle global-display-line-numbers-mode "Global Line Numbers Mode" "Set line numbers globally")) @@ -1308,43 +1308,43 @@ The selected font will be the default on both the existing and future frames." (defvar menu-bar-showhide-menu (let ((menu (make-sparse-keymap "Show/Hide"))) - (bindings--define-key menu [display-line-numbers] + (define-key menu [display-line-numbers] `(menu-item "Line Numbers for All Lines" ,menu-bar-showhide-line-numbers-menu)) - (bindings--define-key menu [column-number-mode] + (define-key menu [column-number-mode] (menu-bar-make-mm-toggle column-number-mode "Column Numbers in Mode Line" "Show the current column number in the mode line")) - (bindings--define-key menu [line-number-mode] + (define-key menu [line-number-mode] (menu-bar-make-mm-toggle line-number-mode "Line Numbers in Mode Line" "Show the current line number in the mode line")) - (bindings--define-key menu [size-indication-mode] + (define-key menu [size-indication-mode] (menu-bar-make-mm-toggle size-indication-mode "Size Indication" "Show the size of the buffer in the mode line")) - (bindings--define-key menu [linecolumn-separator] + (define-key menu [linecolumn-separator] menu-bar-separator) - (bindings--define-key menu [showhide-battery] + (define-key menu [showhide-battery] (menu-bar-make-mm-toggle display-battery-mode "Battery Status" "Display battery status information in mode line")) - (bindings--define-key menu [showhide-date-time] + (define-key menu [showhide-date-time] (menu-bar-make-mm-toggle display-time-mode "Time, Load and Mail" "Display time, system load averages and \ mail status in mode line")) - (bindings--define-key menu [datetime-separator] + (define-key menu [datetime-separator] menu-bar-separator) - (bindings--define-key menu [showhide-speedbar] + (define-key menu [showhide-speedbar] '(menu-item "Speedbar" speedbar-frame-mode :help "Display a Speedbar quick-navigation frame" :button (:toggle @@ -1353,7 +1353,7 @@ mail status in mode line")) (frame-visible-p (symbol-value 'speedbar-frame)))))) - (bindings--define-key menu [showhide-outline-minor-mode] + (define-key menu [showhide-outline-minor-mode] '(menu-item "Outlines" outline-minor-mode :help "Turn outline-minor-mode on/off" :visible (seq-some #'local-variable-p @@ -1361,36 +1361,36 @@ mail status in mode line")) outline-regexp outline-level)) :button (:toggle . (bound-and-true-p outline-minor-mode)))) - (bindings--define-key menu [showhide-tab-line-mode] + (define-key menu [showhide-tab-line-mode] '(menu-item "Window Tab Line" global-tab-line-mode :help "Turn window-local tab-lines on/off" :visible (fboundp 'global-tab-line-mode) :button (:toggle . global-tab-line-mode))) - (bindings--define-key menu [showhide-window-divider] + (define-key menu [showhide-window-divider] `(menu-item "Window Divider" ,menu-bar-showhide-window-divider-menu :visible (memq (window-system) '(x w32)))) - (bindings--define-key menu [showhide-fringe] + (define-key menu [showhide-fringe] `(menu-item "Fringe" ,menu-bar-showhide-fringe-menu :visible (display-graphic-p))) - (bindings--define-key menu [showhide-scroll-bar] + (define-key menu [showhide-scroll-bar] `(menu-item "Scroll Bar" ,menu-bar-showhide-scroll-bar-menu :visible (display-graphic-p))) - (bindings--define-key menu [showhide-tooltip-mode] + (define-key menu [showhide-tooltip-mode] '(menu-item "Tooltips" tooltip-mode :help "Turn tooltips on/off" :visible (and (display-graphic-p) (fboundp 'x-show-tip)) :button (:toggle . tooltip-mode))) - (bindings--define-key menu [showhide-context-menu] + (define-key menu [showhide-context-menu] '(menu-item "Context Menus" context-menu-mode :help "Turn mouse-3 context menus on/off" :button (:toggle . context-menu-mode))) - (bindings--define-key menu [menu-bar-mode] + (define-key menu [menu-bar-mode] '(menu-item "Menu Bar" toggle-menu-bar-mode-from-frame :help "Turn menu bar on/off" :button @@ -1398,7 +1398,7 @@ mail status in mode line")) (frame-parameter (menu-bar-frame-for-menubar) 'menu-bar-lines))))) - (bindings--define-key menu [showhide-tab-bar] + (define-key menu [showhide-tab-bar] '(menu-item "Tab Bar" toggle-tab-bar-mode-from-frame :help "Turn tab bar on/off" :button @@ -1408,11 +1408,11 @@ mail status in mode line")) (if (and (boundp 'menu-bar-showhide-tool-bar-menu) (keymapp menu-bar-showhide-tool-bar-menu)) - (bindings--define-key menu [showhide-tool-bar] + (define-key menu [showhide-tool-bar] `(menu-item "Tool Bar" ,menu-bar-showhide-tool-bar-menu :visible (display-graphic-p))) ;; else not tool bar that can move. - (bindings--define-key menu [showhide-tool-bar] + (define-key menu [showhide-tool-bar] '(menu-item "Tool Bar" toggle-tool-bar-mode-from-frame :help "Turn tool bar on/off" :visible (display-graphic-p) @@ -1446,7 +1446,7 @@ mail status in mode line")) (defvar menu-bar-line-wrapping-menu (let ((menu (make-sparse-keymap "Line Wrapping"))) - (bindings--define-key menu [visual-wrap] + (define-key menu [visual-wrap] '(menu-item "Visual Wrap Prefix mode" visual-wrap-prefix-mode :help "Display continuation lines with visual context-dependent prefix" :visible (menu-bar-menu-frame-live-and-visible-p) @@ -1454,7 +1454,7 @@ mail status in mode line")) . (bound-and-true-p visual-wrap-prefix-mode)) :enable t)) - (bindings--define-key menu [word-wrap] + (define-key menu [word-wrap] '(menu-item "Word Wrap (Visual Line mode)" menu-bar--visual-line-mode-enable :help "Wrap long lines at word boundaries" @@ -1464,7 +1464,7 @@ mail status in mode line")) word-wrap)) :visible (menu-bar-menu-frame-live-and-visible-p))) - (bindings--define-key menu [truncate] + (define-key menu [truncate] '(menu-item "Truncate Long Lines" menu-bar--toggle-truncate-long-lines :help "Truncate long lines at window edge" @@ -1473,7 +1473,7 @@ mail status in mode line")) :visible (menu-bar-menu-frame-live-and-visible-p) :enable (not (truncated-partial-width-window-p)))) - (bindings--define-key menu [window-wrap] + (define-key menu [window-wrap] '(menu-item "Wrap at Window Edge" menu-bar--wrap-long-lines-window-edge :help "Wrap long lines at window edge" @@ -1491,7 +1491,7 @@ mail status in mode line")) (dolist (x '((char-fold-to-regexp "Fold Characters" "Character folding") (isearch-symbol-regexp "Whole Symbols" "Whole symbol") (word-search-regexp "Whole Words" "Whole word"))) - (bindings--define-key menu (vector (nth 0 x)) + (define-key menu (vector (nth 0 x)) `(menu-item ,(nth 1 x) ,(lambda () (interactive) @@ -1500,7 +1500,7 @@ mail status in mode line")) :help ,(format "Enable %s search" (downcase (nth 2 x))) :button (:radio . (eq search-default-mode #',(nth 0 x)))))) - (bindings--define-key menu [regexp-search] + (define-key menu [regexp-search] `(menu-item "Regular Expression" ,(lambda () (interactive) @@ -1509,7 +1509,7 @@ mail status in mode line")) :help "Enable regular-expression search" :button (:radio . (eq search-default-mode t)))) - (bindings--define-key menu [regular-search] + (define-key menu [regular-search] `(menu-item "Literal Search" ,(lambda () (interactive) @@ -1520,9 +1520,9 @@ mail status in mode line")) :help "Disable special search modes" :button (:radio . (not search-default-mode)))) - (bindings--define-key menu [custom-separator] + (define-key menu [custom-separator] menu-bar-separator) - (bindings--define-key menu [case-fold-search] + (define-key menu [case-fold-search] (menu-bar-make-toggle-command toggle-case-fold-search case-fold-search "Ignore Case" @@ -1533,74 +1533,74 @@ mail status in mode line")) (defvar menu-bar-options-menu (let ((menu (make-sparse-keymap "Options"))) - (bindings--define-key menu [customize] + (define-key menu [customize] `(menu-item "Customize Emacs" ,menu-bar-custom-menu)) - (bindings--define-key menu [package] + (define-key menu [package] '(menu-item "Manage Emacs Packages" package-list-packages :help "Install or uninstall additional Emacs packages")) - (bindings--define-key menu [save] + (define-key menu [save] '(menu-item "Save Options" menu-bar-options-save :help "Save options set from the menu above")) - (bindings--define-key menu [custom-separator] + (define-key menu [custom-separator] menu-bar-separator) - (bindings--define-key menu [menu-set-font] + (define-key menu [menu-set-font] '(menu-item "Set Default Font..." menu-set-font :visible (display-multi-font-p) :help "Select a default font")) (if (featurep 'system-font-setting) - (bindings--define-key menu [menu-system-font] + (define-key menu [menu-system-font] (menu-bar-make-toggle-command toggle-use-system-font font-use-system-font "Use System Font" "Use system font: %s" "Use the monospaced font defined by the system"))) - (bindings--define-key menu [showhide] + (define-key menu [showhide] `(menu-item "Show/Hide" ,menu-bar-showhide-menu)) - (bindings--define-key menu [showhide-separator] + (define-key menu [showhide-separator] menu-bar-separator) - (bindings--define-key menu [mule] + (define-key menu [mule] ;; It is better not to use backquote here, ;; because that makes a bootstrapping problem ;; if you need to recompile all the Lisp files using interpreted code. `(menu-item "Multilingual Environment" ,mule-menu-keymap)) ;;(setq menu-bar-final-items (cons 'mule menu-bar-final-items)) - ;;(bindings--define-key menu [preferences] + ;;(define-key menu [preferences] ;; `(menu-item "Preferences" ,menu-bar-preferences-menu ;; :help "Toggle important global options")) - (bindings--define-key menu [mule-separator] + (define-key menu [mule-separator] menu-bar-separator) - (bindings--define-key menu [debug-on-quit] + (define-key menu [debug-on-quit] (menu-bar-make-toggle-command toggle-debug-on-quit debug-on-quit "Enter Debugger on Quit/C-g" "Debug on Quit %s" "Enter Lisp debugger when C-g is pressed")) - (bindings--define-key menu [debug-on-error] + (define-key menu [debug-on-error] (menu-bar-make-toggle-command toggle-debug-on-error debug-on-error "Enter Debugger on Error" "Debug on Error %s" "Enter Lisp debugger when an error is signaled")) - (bindings--define-key menu [debugger-separator] + (define-key menu [debugger-separator] menu-bar-separator) - (bindings--define-key menu [blink-cursor-mode] + (define-key menu [blink-cursor-mode] (menu-bar-make-mm-toggle blink-cursor-mode "Blink Cursor" "Whether the cursor blinks (Blink Cursor mode)")) - (bindings--define-key menu [cursor-separator] + (define-key menu [cursor-separator] menu-bar-separator) - (bindings--define-key menu [save-desktop] + (define-key menu [save-desktop] (menu-bar-make-toggle-command toggle-save-desktop-globally desktop-save-mode "Save State between Sessions" @@ -1613,7 +1613,7 @@ mail status in mode line")) (set-default 'desktop-save-mode (not (symbol-value 'desktop-save-mode)))))) - (bindings--define-key menu [save-place] + (define-key menu [save-place] (menu-bar-make-toggle-command toggle-save-place-globally save-place-mode "Save Place in Files between Sessions" @@ -1626,7 +1626,7 @@ mail status in mode line")) (set-default 'save-place-mode (not (symbol-value 'save-place-mode)))))) - (bindings--define-key menu [uniquify] + (define-key menu [uniquify] (menu-bar-make-toggle-command toggle-uniquify-buffer-names uniquify-buffer-name-style "Use Directory Names in Buffer Names" @@ -1636,9 +1636,9 @@ mail status in mode line")) (if (not uniquify-buffer-name-style) 'post-forward-angle-brackets)))) - (bindings--define-key menu [edit-options-separator] + (define-key menu [edit-options-separator] menu-bar-separator) - (bindings--define-key menu [cua-mode] + (define-key menu [cua-mode] (menu-bar-make-mm-toggle cua-mode "Cut/Paste with C-x/C-c/C-v (CUA Mode)" @@ -1646,7 +1646,7 @@ mail status in mode line")) (:visible (or (not (boundp 'cua-enable-cua-keys)) cua-enable-cua-keys)))) - (bindings--define-key menu [cua-emulation-mode] + (define-key menu [cua-emulation-mode] (menu-bar-make-mm-toggle cua-mode "CUA Mode (without C-x/C-c/C-v)" @@ -1654,23 +1654,23 @@ mail status in mode line")) (:visible (and (boundp 'cua-enable-cua-keys) (not cua-enable-cua-keys))))) - (bindings--define-key menu [search-options] + (define-key menu [search-options] `(menu-item "Default Search Options" ,menu-bar-search-options-menu)) - (bindings--define-key menu [line-wrapping] + (define-key menu [line-wrapping] `(menu-item "Line Wrapping in This Buffer" ,menu-bar-line-wrapping-menu)) - (bindings--define-key menu [highlight-separator] + (define-key menu [highlight-separator] menu-bar-separator) - (bindings--define-key menu [highlight-paren-mode] + (define-key menu [highlight-paren-mode] (menu-bar-make-mm-toggle show-paren-mode "Highlight Matching Parentheses" "Highlight matching/mismatched parentheses at cursor (Show Paren mode)")) - (bindings--define-key menu [transient-mark-mode] + (define-key menu [transient-mark-mode] (menu-bar-make-mm-toggle transient-mark-mode "Highlight Active Region" @@ -1684,104 +1684,104 @@ mail status in mode line")) (defvar menu-bar-games-menu (let ((menu (make-sparse-keymap "Games"))) - (bindings--define-key menu [zone] + (define-key menu [zone] '(menu-item "Zone Out" zone :help "Play tricks with Emacs display when Emacs is idle")) - (bindings--define-key menu [tetris] + (define-key menu [tetris] '(menu-item "Tetris" tetris :help "Falling blocks game")) - (bindings--define-key menu [solitaire] + (define-key menu [solitaire] '(menu-item "Solitaire" solitaire :help "Get rid of all the stones")) - (bindings--define-key menu [snake] + (define-key menu [snake] '(menu-item "Snake" snake :help "Move snake around avoiding collisions")) - (bindings--define-key menu [pong] + (define-key menu [pong] '(menu-item "Pong" pong :help "Bounce the ball to your opponent")) - (bindings--define-key menu [mult] + (define-key menu [mult] '(menu-item "Multiplication Puzzle" mpuz :help "Exercise brain with multiplication")) - (bindings--define-key menu [life] + (define-key menu [life] '(menu-item "Life" life :help "Watch how John Conway's cellular automaton evolves")) - (bindings--define-key menu [hanoi] + (define-key menu [hanoi] '(menu-item "Towers of Hanoi" hanoi :help "Watch Towers-of-Hanoi puzzle solved by Emacs")) - (bindings--define-key menu [gomoku] + (define-key menu [gomoku] '(menu-item "Gomoku" gomoku :help "Mark 5 contiguous squares (like tic-tac-toe)")) - (bindings--define-key menu [bubbles] + (define-key menu [bubbles] '(menu-item "Bubbles" bubbles :help "Remove all bubbles using the fewest moves")) - (bindings--define-key menu [black-box] + (define-key menu [black-box] '(menu-item "Blackbox" blackbox :help "Find balls in a black box by shooting rays")) - (bindings--define-key menu [adventure] + (define-key menu [adventure] '(menu-item "Adventure" dunnet :help "Dunnet, a text Adventure game for Emacs")) - (bindings--define-key menu [5x5] + (define-key menu [5x5] '(menu-item "5x5" 5x5 :help "Fill in all the squares on a 5x5 board")) menu)) (defvar menu-bar-encryption-decryption-menu (let ((menu (make-sparse-keymap "Encryption/Decryption"))) - (bindings--define-key menu [insert-keys] + (define-key menu [insert-keys] '(menu-item "Insert Keys" epa-insert-keys :help "Insert public keys after the current point")) - (bindings--define-key menu [export-keys] + (define-key menu [export-keys] '(menu-item "Export Keys" epa-export-keys :help "Export public keys to a file")) - (bindings--define-key menu [import-keys-region] + (define-key menu [import-keys-region] '(menu-item "Import Keys from Region" epa-import-keys-region :help "Import public keys from the current region")) - (bindings--define-key menu [import-keys] + (define-key menu [import-keys] '(menu-item "Import Keys from File..." epa-import-keys :help "Import public keys from a file")) - (bindings--define-key menu [list-keys] + (define-key menu [list-keys] '(menu-item "List Keys" epa-list-keys :help "Browse your public keyring")) - (bindings--define-key menu [separator-keys] + (define-key menu [separator-keys] menu-bar-separator) - (bindings--define-key menu [sign-region] + (define-key menu [sign-region] '(menu-item "Sign Region" epa-sign-region :help "Create digital signature of the current region")) - (bindings--define-key menu [verify-region] + (define-key menu [verify-region] '(menu-item "Verify Region" epa-verify-region :help "Verify digital signature of the current region")) - (bindings--define-key menu [encrypt-region] + (define-key menu [encrypt-region] '(menu-item "Encrypt Region" epa-encrypt-region :help "Encrypt the current region")) - (bindings--define-key menu [decrypt-region] + (define-key menu [decrypt-region] '(menu-item "Decrypt Region" epa-decrypt-region :help "Decrypt the current region")) - (bindings--define-key menu [separator-file] + (define-key menu [separator-file] menu-bar-separator) - (bindings--define-key menu [sign-file] + (define-key menu [sign-file] '(menu-item "Sign File..." epa-sign-file :help "Create digital signature of a file")) - (bindings--define-key menu [verify-file] + (define-key menu [verify-file] '(menu-item "Verify File..." epa-verify-file :help "Verify digital signature of a file")) - (bindings--define-key menu [encrypt-file] + (define-key menu [encrypt-file] '(menu-item "Encrypt File..." epa-encrypt-file :help "Encrypt a file")) - (bindings--define-key menu [decrypt-file] + (define-key menu [decrypt-file] '(menu-item "Decrypt File..." epa-decrypt-file :help "Decrypt a file")) @@ -1789,24 +1789,24 @@ mail status in mode line")) (defvar menu-bar-shell-commands-menu (let ((menu (make-sparse-keymap "Shell Commands"))) - (bindings--define-key menu [project-interactive-shell] + (define-key menu [project-interactive-shell] '(menu-item "Run Shell In Project" project-shell :help "Run a subshell interactively, in the current project's root directory")) - (bindings--define-key menu [interactive-shell] + (define-key menu [interactive-shell] '(menu-item "Run Shell" shell :help "Run a subshell interactively")) - (bindings--define-key menu [async-shell-command] + (define-key menu [async-shell-command] '(menu-item "Async Shell Command..." async-shell-command :help "Invoke a shell command asynchronously in background")) - (bindings--define-key menu [shell-on-region] + (define-key menu [shell-on-region] '(menu-item "Shell Command on Region..." shell-command-on-region :enable mark-active :help "Pass marked region to a shell command")) - (bindings--define-key menu [shell] + (define-key menu [shell] '(menu-item "Shell Command..." shell-command :help "Invoke a shell command and catch its output")) @@ -1814,27 +1814,27 @@ mail status in mode line")) (defvar menu-bar-project-menu (let ((menu (make-sparse-keymap "Project"))) - (bindings--define-key menu [project-execute-extended-command] '(menu-item "Execute Extended Command..." project-execute-extended-command :help "Execute an extended command in project root directory")) - (bindings--define-key menu [project-query-replace-regexp] '(menu-item "Query Replace Regexp..." project-query-replace-regexp :help "Interactively replace a regexp in files belonging to current project")) - (bindings--define-key menu [project-or-external-find-regexp] '(menu-item "Find Regexp Including External Roots..." project-or-external-find-regexp :help "Search for a regexp in files belonging to current project or external files")) - (bindings--define-key menu [project-find-regexp] '(menu-item "Find Regexp..." project-find-regexp :help "Search for a regexp in files belonging to current project")) - (bindings--define-key menu [separator-project-search] menu-bar-separator) - (bindings--define-key menu [project-kill-buffers] '(menu-item "Kill Buffers..." project-kill-buffers :help "Kill the buffers belonging to the current project")) - (bindings--define-key menu [project-list-buffers] '(menu-item "List Buffers" project-list-buffers :help "Pop up a window listing all Emacs buffers belonging to current project")) - (bindings--define-key menu [project-switch-to-buffer] '(menu-item "Switch To Buffer..." project-switch-to-buffer :help "Prompt for a buffer belonging to current project, and switch to it")) - (bindings--define-key menu [separator-project-buffers] menu-bar-separator) - (bindings--define-key menu [project-async-shell-command] '(menu-item "Async Shell Command..." project-async-shell-command :help "Invoke a shell command in project root asynchronously in background")) - (bindings--define-key menu [project-shell-command] '(menu-item "Shell Command..." project-shell-command :help "Invoke a shell command in project root and catch its output")) - (bindings--define-key menu [project-eshell] '(menu-item "Run Eshell" project-eshell :help "Run eshell for the current project")) - (bindings--define-key menu [project-shell] '(menu-item "Run Shell" project-shell :help "Run a subshell interactively, in the current project's root directory")) - (bindings--define-key menu [project-compile] '(menu-item "Compile..." project-compile :help "Invoke compiler or Make for current project, view errors")) - (bindings--define-key menu [separator-project-programs] menu-bar-separator) - (bindings--define-key menu [project-switch-project] '(menu-item "Switch Project..." project-switch-project :help "Switch to another project and then run a command")) - (bindings--define-key menu [project-vc-dir] '(menu-item "VC Dir" project-vc-dir :help "Show the VC status of the project repository")) - (bindings--define-key menu [project-dired] '(menu-item "Open Project Root" project-dired :help "Read the root directory of the current project, to operate on its files")) - (bindings--define-key menu [project-find-dir] '(menu-item "Open Directory..." project-find-dir :help "Open existing directory that belongs to current project")) - (bindings--define-key menu [project-or-external-find-file] '(menu-item "Open File Including External Roots..." project-or-external-find-file :help "Open existing file that belongs to current project or its external roots")) - (bindings--define-key menu [project-open-file] '(menu-item "Open File..." project-find-file :help "Open an existing file that belongs to current project")) + (define-key menu [project-execute-extended-command] '(menu-item "Execute Extended Command..." project-execute-extended-command :help "Execute an extended command in project root directory")) + (define-key menu [project-query-replace-regexp] '(menu-item "Query Replace Regexp..." project-query-replace-regexp :help "Interactively replace a regexp in files belonging to current project")) + (define-key menu [project-or-external-find-regexp] '(menu-item "Find Regexp Including External Roots..." project-or-external-find-regexp :help "Search for a regexp in files belonging to current project or external files")) + (define-key menu [project-find-regexp] '(menu-item "Find Regexp..." project-find-regexp :help "Search for a regexp in files belonging to current project")) + (define-key menu [separator-project-search] menu-bar-separator) + (define-key menu [project-kill-buffers] '(menu-item "Kill Buffers..." project-kill-buffers :help "Kill the buffers belonging to the current project")) + (define-key menu [project-list-buffers] '(menu-item "List Buffers" project-list-buffers :help "Pop up a window listing all Emacs buffers belonging to current project")) + (define-key menu [project-switch-to-buffer] '(menu-item "Switch To Buffer..." project-switch-to-buffer :help "Prompt for a buffer belonging to current project, and switch to it")) + (define-key menu [separator-project-buffers] menu-bar-separator) + (define-key menu [project-async-shell-command] '(menu-item "Async Shell Command..." project-async-shell-command :help "Invoke a shell command in project root asynchronously in background")) + (define-key menu [project-shell-command] '(menu-item "Shell Command..." project-shell-command :help "Invoke a shell command in project root and catch its output")) + (define-key menu [project-eshell] '(menu-item "Run Eshell" project-eshell :help "Run eshell for the current project")) + (define-key menu [project-shell] '(menu-item "Run Shell" project-shell :help "Run a subshell interactively, in the current project's root directory")) + (define-key menu [project-compile] '(menu-item "Compile..." project-compile :help "Invoke compiler or Make for current project, view errors")) + (define-key menu [separator-project-programs] menu-bar-separator) + (define-key menu [project-switch-project] '(menu-item "Switch Project..." project-switch-project :help "Switch to another project and then run a command")) + (define-key menu [project-vc-dir] '(menu-item "VC Dir" project-vc-dir :help "Show the VC status of the project repository")) + (define-key menu [project-dired] '(menu-item "Open Project Root" project-dired :help "Read the root directory of the current project, to operate on its files")) + (define-key menu [project-find-dir] '(menu-item "Open Directory..." project-find-dir :help "Open existing directory that belongs to current project")) + (define-key menu [project-or-external-find-file] '(menu-item "Open File Including External Roots..." project-or-external-find-file :help "Open existing file that belongs to current project or its external roots")) + (define-key menu [project-open-file] '(menu-item "Open File..." project-find-file :help "Open an existing file that belongs to current project")) menu)) (defvar menu-bar-project-item @@ -1848,112 +1848,112 @@ mail status in mode line")) (defvar menu-bar-tools-menu (let ((menu (make-sparse-keymap "Tools"))) - (bindings--define-key menu [games] + (define-key menu [games] `(menu-item "Games" ,menu-bar-games-menu)) - (bindings--define-key menu [separator-games] + (define-key menu [separator-games] menu-bar-separator) - (bindings--define-key menu [encryption-decryption] + (define-key menu [encryption-decryption] `(menu-item "Encryption/Decryption" ,menu-bar-encryption-decryption-menu)) - (bindings--define-key menu [separator-encryption-decryption] + (define-key menu [separator-encryption-decryption] menu-bar-separator) - (bindings--define-key menu [simple-calculator] + (define-key menu [simple-calculator] '(menu-item "Simple Calculator" calculator :help "Invoke the Emacs built-in quick calculator")) - (bindings--define-key menu [calc] + (define-key menu [calc] '(menu-item "Programmable Calculator" calc :help "Invoke the Emacs built-in full scientific calculator")) - (bindings--define-key menu [calendar] + (define-key menu [calendar] '(menu-item "Calendar" calendar :help "Invoke the Emacs built-in calendar")) - (bindings--define-key menu [separator-net] + (define-key menu [separator-net] menu-bar-separator) - (bindings--define-key menu [browse-web] + (define-key menu [browse-web] '(menu-item "Browse the Web..." browse-web)) - (bindings--define-key menu [directory-search] + (define-key menu [directory-search] '(menu-item "Directory Servers" eudc-tools-menu)) - (bindings--define-key menu [compose-mail] + (define-key menu [compose-mail] '(menu-item "Compose New Mail" compose-mail :visible (and mail-user-agent (not (eq mail-user-agent 'ignore))) :help "Start writing a new mail message")) - (bindings--define-key menu [rmail] + (define-key menu [rmail] '(menu-item "Read Mail" menu-bar-read-mail :visible (and read-mail-command (not (eq read-mail-command 'ignore))) :help "Read your mail")) - (bindings--define-key menu [gnus] + (define-key menu [gnus] '(menu-item "Read Net News" gnus :help "Read network news groups")) - (bindings--define-key menu [separator-vc] + (define-key menu [separator-vc] menu-bar-separator) - (bindings--define-key menu [vc] nil) ;Create the place for the VC menu. + (define-key menu [vc] nil) ;Create the place for the VC menu. - (bindings--define-key menu [separator-compare] + (define-key menu [separator-compare] menu-bar-separator) - (bindings--define-key menu [epatch] + (define-key menu [epatch] '(menu-item "Apply Patch" menu-bar-epatch-menu)) - (bindings--define-key menu [ediff-merge] + (define-key menu [ediff-merge] '(menu-item "Merge" menu-bar-ediff-merge-menu)) - (bindings--define-key menu [compare] + (define-key menu [compare] '(menu-item "Compare (Ediff)" menu-bar-ediff-menu)) - (bindings--define-key menu [separator-spell] + (define-key menu [separator-spell] menu-bar-separator) - (bindings--define-key menu [spell] + (define-key menu [spell] '(menu-item "Spell Checking" ispell-menu-map)) - (bindings--define-key menu [separator-prog] + (define-key menu [separator-prog] menu-bar-separator) - (bindings--define-key menu [semantic] + (define-key menu [semantic] '(menu-item "Source Code Parsers (Semantic)" semantic-mode :help "Toggle automatic parsing in source code buffers (Semantic mode)" :button (:toggle . (bound-and-true-p semantic-mode)))) - (bindings--define-key menu [eglot] + (define-key menu [eglot] '(menu-item "Language Server Support (Eglot)" eglot :help "Start language server suitable for this buffer's major-mode")) - (bindings--define-key menu [project] + (define-key menu [project] menu-bar-project-item) - (bindings--define-key menu [ede] + (define-key menu [ede] '(menu-item "Project Support (EDE)" global-ede-mode :help "Toggle the Emacs Development Environment (Global EDE mode)" :button (:toggle . (bound-and-true-p global-ede-mode)))) - (bindings--define-key menu [gdb] + (define-key menu [gdb] '(menu-item "Debugger (GDB)..." gdb :help "Debug a program from within Emacs with GDB")) - (bindings--define-key menu [project-compile] + (define-key menu [project-compile] '(menu-item "Compile Project..." project-compile :help "Invoke compiler or Make for current project, view errors")) - (bindings--define-key menu [compile] + (define-key menu [compile] '(menu-item "Compile..." compile :help "Invoke compiler or Make in current buffer's directory, view errors")) - (bindings--define-key menu [shell-commands] + (define-key menu [shell-commands] `(menu-item "Shell Commands" ,menu-bar-shell-commands-menu)) - (bindings--define-key menu [rgrep] + (define-key menu [rgrep] '(menu-item "Recursive Grep..." rgrep :help "Interactively ask for parameters and search recursively")) - (bindings--define-key menu [grep] + (define-key menu [grep] '(menu-item "Search Files (Grep)..." grep :help "Search files for strings or regexps (with Grep)")) menu)) @@ -1963,58 +1963,58 @@ mail status in mode line")) (defvar menu-bar-describe-menu (let ((menu (make-sparse-keymap "Describe"))) - (bindings--define-key menu [mule-diag] + (define-key menu [mule-diag] '(menu-item "Show All of Mule Status" mule-diag :help "Display multilingual environment settings")) - (bindings--define-key menu [describe-coding-system-briefly] + (define-key menu [describe-coding-system-briefly] '(menu-item "Describe Coding System (Briefly)" describe-current-coding-system-briefly)) - (bindings--define-key menu [describe-coding-system] + (define-key menu [describe-coding-system] '(menu-item "Describe Coding System..." describe-coding-system)) - (bindings--define-key menu [describe-input-method] + (define-key menu [describe-input-method] '(menu-item "Describe Input Method..." describe-input-method :help "Keyboard layout for specific input method")) - (bindings--define-key menu [describe-language-environment] + (define-key menu [describe-language-environment] `(menu-item "Describe Language Environment" ,describe-language-environment-map)) - (bindings--define-key menu [separator-desc-mule] + (define-key menu [separator-desc-mule] menu-bar-separator) - (bindings--define-key menu [list-keybindings] + (define-key menu [list-keybindings] '(menu-item "List Key Bindings" describe-bindings :help "Display all current key bindings (keyboard shortcuts)")) - (bindings--define-key menu [list-recent-keystrokes] + (define-key menu [list-recent-keystrokes] '(menu-item "Show Recent Inputs" view-lossage :help "Display last few input events and the commands \ they ran")) - (bindings--define-key menu [describe-current-display-table] + (define-key menu [describe-current-display-table] '(menu-item "Describe Display Table" describe-current-display-table :help "Describe the current display table")) - (bindings--define-key menu [describe-package] + (define-key menu [describe-package] '(menu-item "Describe Package..." describe-package :help "Display documentation of a Lisp package")) - (bindings--define-key menu [describe-face] + (define-key menu [describe-face] '(menu-item "Describe Face..." describe-face :help "Display the properties of a face")) - (bindings--define-key menu [describe-variable] + (define-key menu [describe-variable] '(menu-item "Describe Variable..." describe-variable :help "Display documentation of variable/option")) - (bindings--define-key menu [describe-function] + (define-key menu [describe-function] '(menu-item "Describe Function..." describe-function :help "Display documentation of function/command")) - (bindings--define-key menu [describe-command] + (define-key menu [describe-command] '(menu-item "Describe Command..." describe-command :help "Display documentation of command")) - (bindings--define-key menu [shortdoc-display-group] + (define-key menu [shortdoc-display-group] '(menu-item "Function Group Overview..." shortdoc-display-group :help "Display a function overview for a specific topic")) - (bindings--define-key menu [describe-key-1] + (define-key menu [describe-key-1] '(menu-item "Describe Key or Mouse Operation..." describe-key ;; Users typically don't identify keys and menu items... :help "Display documentation of command bound to a \ key, a click, or a menu-item")) - (bindings--define-key menu [describe-mode] + (define-key menu [describe-mode] '(menu-item "Describe Buffer Modes" describe-mode :help "Describe this buffer's major and minor mode")) menu)) @@ -2059,40 +2059,40 @@ key, a click, or a menu-item")) (defvar menu-bar-search-documentation-menu (let ((menu (make-sparse-keymap "Search Documentation"))) - (bindings--define-key menu [search-documentation-strings] + (define-key menu [search-documentation-strings] '(menu-item "Search Documentation Strings..." apropos-documentation :help "Find functions and variables whose doc strings match a regexp")) - (bindings--define-key menu [find-any-object-by-name] + (define-key menu [find-any-object-by-name] '(menu-item "Find Any Object by Name..." apropos :help "Find symbols of any kind whose names match a regexp")) - (bindings--define-key menu [find-option-by-value] + (define-key menu [find-option-by-value] '(menu-item "Find Options by Value..." apropos-value :help "Find variables whose values match a regexp")) - (bindings--define-key menu [find-options-by-name] + (define-key menu [find-options-by-name] '(menu-item "Find Options by Name..." apropos-user-option :help "Find user options whose names match a regexp")) - (bindings--define-key menu [find-commands-by-name] + (define-key menu [find-commands-by-name] '(menu-item "Find Commands by Name..." apropos-command :help "Find commands whose names match a regexp")) - (bindings--define-key menu [sep1] + (define-key menu [sep1] menu-bar-separator) - (bindings--define-key menu [lookup-symbol-in-manual] + (define-key menu [lookup-symbol-in-manual] '(menu-item "Look Up Symbol in Manual..." info-lookup-symbol :help "Display manual section that describes a symbol")) - (bindings--define-key menu [lookup-command-in-manual] + (define-key menu [lookup-command-in-manual] '(menu-item "Look Up Command in User Manual..." Info-goto-emacs-command-node :help "Display manual section that describes a command")) - (bindings--define-key menu [lookup-key-in-manual] + (define-key menu [lookup-key-in-manual] '(menu-item "Look Up Key in User Manual..." Info-goto-emacs-key-command-node :help "Display manual section that describes a key")) - (bindings--define-key menu [lookup-subject-in-elisp-manual] + (define-key menu [lookup-subject-in-elisp-manual] '(menu-item "Look Up Subject in ELisp Manual..." elisp-index-search :help "Find description of a subject in Emacs Lisp manual")) - (bindings--define-key menu [lookup-subject-in-emacs-manual] + (define-key menu [lookup-subject-in-emacs-manual] '(menu-item "Look Up Subject in User Manual..." emacs-index-search :help "Find description of a subject in Emacs User manual")) - (bindings--define-key menu [emacs-terminology] + (define-key menu [emacs-terminology] '(menu-item "Emacs Terminology" search-emacs-glossary :help "Display the Glossary section of the Emacs manual")) menu)) @@ -2100,24 +2100,24 @@ key, a click, or a menu-item")) (defvar menu-bar-manuals-menu (let ((menu (make-sparse-keymap "More Manuals"))) - (bindings--define-key menu [man] + (define-key menu [man] '(menu-item "Read Man Page..." manual-entry :help "Man-page docs for external commands and libraries")) - (bindings--define-key menu [sep2] + (define-key menu [sep2] menu-bar-separator) - (bindings--define-key menu [order-emacs-manuals] + (define-key menu [order-emacs-manuals] '(menu-item "Ordering Manuals" view-order-manuals :help "How to order manuals from the Free Software Foundation")) - (bindings--define-key menu [lookup-subject-in-all-manuals] + (define-key menu [lookup-subject-in-all-manuals] '(menu-item "Lookup Subject in all Manuals..." info-apropos :help "Find description of a subject in all installed manuals")) - (bindings--define-key menu [other-manuals] + (define-key menu [other-manuals] '(menu-item "All Other Manuals (Info)" Info-directory :help "Read any of the installed manuals")) - (bindings--define-key menu [emacs-lisp-reference] + (define-key menu [emacs-lisp-reference] '(menu-item "Emacs Lisp Reference" menu-bar-read-lispref :help "Read the Emacs Lisp Reference manual")) - (bindings--define-key menu [emacs-lisp-intro] + (define-key menu [emacs-lisp-intro] '(menu-item "Introduction to Emacs Lisp" menu-bar-read-lispintro :help "Read the Introduction to Emacs Lisp Programming")) menu)) @@ -2129,66 +2129,66 @@ key, a click, or a menu-item")) (defvar menu-bar-help-menu (let ((menu (make-sparse-keymap "Help"))) - (bindings--define-key menu [about-gnu-project] + (define-key menu [about-gnu-project] '(menu-item "About GNU" describe-gnu-project :help "About the GNU System, GNU Project, and GNU/Linux")) - (bindings--define-key menu [about-emacs] + (define-key menu [about-emacs] '(menu-item "About Emacs" about-emacs :help "Display version number, copyright info, and basic help")) - (bindings--define-key menu [sep4] + (define-key menu [sep4] menu-bar-separator) - (bindings--define-key menu [describe-no-warranty] + (define-key menu [describe-no-warranty] '(menu-item "(Non)Warranty" describe-no-warranty :help "Explain that Emacs has NO WARRANTY")) - (bindings--define-key menu [describe-copying] + (define-key menu [describe-copying] '(menu-item "Copying Conditions" describe-copying :help "Show the Emacs license (GPL)")) - (bindings--define-key menu [getting-new-versions] + (define-key menu [getting-new-versions] '(menu-item "Getting New Versions" describe-distribution :help "How to get the latest version of Emacs")) - (bindings--define-key menu [sep2] + (define-key menu [sep2] menu-bar-separator) - (bindings--define-key menu [external-packages] + (define-key menu [external-packages] '(menu-item "Finding Extra Packages" view-external-packages :help "How to get more Lisp packages for use in Emacs")) - (bindings--define-key menu [find-emacs-packages] + (define-key menu [find-emacs-packages] '(menu-item "Search Built-in Packages" finder-by-keyword :help "Find built-in packages and features by keyword")) - (bindings--define-key menu [more-manuals] + (define-key menu [more-manuals] `(menu-item "More Manuals" ,menu-bar-manuals-menu)) - (bindings--define-key menu [emacs-manual] + (define-key menu [emacs-manual] '(menu-item "Read the Emacs Manual" info-emacs-manual :help "Full documentation of Emacs features")) - (bindings--define-key menu [describe] + (define-key menu [describe] `(menu-item "Describe" ,menu-bar-describe-menu)) - (bindings--define-key menu [search-documentation] + (define-key menu [search-documentation] `(menu-item "Search Documentation" ,menu-bar-search-documentation-menu)) - (bindings--define-key menu [sep1] + (define-key menu [sep1] menu-bar-separator) - (bindings--define-key menu [emacs-psychotherapist] + (define-key menu [emacs-psychotherapist] '(menu-item "Emacs Psychotherapist" doctor :help "Our doctor will help you feel better")) - (bindings--define-key menu [send-emacs-bug-report] + (define-key menu [send-emacs-bug-report] '(menu-item "Send Bug Report..." report-emacs-bug :help "Send e-mail to Emacs maintainers")) - (bindings--define-key menu [emacs-manual-bug] + (define-key menu [emacs-manual-bug] '(menu-item "How to Report a Bug" info-emacs-bug :help "Read about how to report an Emacs bug")) - (bindings--define-key menu [emacs-known-problems] + (define-key menu [emacs-known-problems] '(menu-item "Emacs Known Problems" view-emacs-problems :help "Read about known problems with Emacs")) - (bindings--define-key menu [emacs-news] + (define-key menu [emacs-news] '(menu-item "Emacs News" view-emacs-news :help "New features of this version")) - (bindings--define-key menu [emacs-faq] + (define-key menu [emacs-faq] '(menu-item "Emacs FAQ" view-emacs-FAQ :help "Frequently asked (and answered) questions about Emacs")) - (bindings--define-key menu [emacs-tutorial-language-specific] + (define-key menu [emacs-tutorial-language-specific] '(menu-item "Emacs Tutorial (choose language)..." help-with-tutorial-spec-language :help "Learn how to use Emacs (choose a language)")) - (bindings--define-key menu [emacs-tutorial] + (define-key menu [emacs-tutorial] '(menu-item "Emacs Tutorial" help-with-tutorial :help "Learn how to use Emacs")) @@ -2196,21 +2196,21 @@ key, a click, or a menu-item")) ;; FIXME? There already is an "About Emacs" (sans ...) entry in the Help menu. (and (featurep 'ns) (not (eq system-type 'darwin)) - (bindings--define-key menu [info-panel] + (define-key menu [info-panel] '(menu-item "About Emacs..." ns-do-emacs-info-panel))) menu)) -(bindings--define-key global-map [menu-bar tools] +(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu)) -(bindings--define-key global-map [menu-bar buffer] +(define-key global-map [menu-bar buffer] (cons "Buffers" global-buffers-menu-map)) -(bindings--define-key global-map [menu-bar options] +(define-key global-map [menu-bar options] (cons "Options" menu-bar-options-menu)) -(bindings--define-key global-map [menu-bar edit] +(define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu)) -(bindings--define-key global-map [menu-bar file] +(define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu)) -(bindings--define-key global-map [menu-bar help-menu] +(define-key global-map [menu-bar help-menu] (cons (purecopy "Help") menu-bar-help-menu)) (define-key global-map [menu-bar mouse-1] 'menu-bar-open-mouse) @@ -2576,38 +2576,38 @@ It must accept a buffer as its only required argument.") ;; This shouldn't be necessary, but there's a funny ;; bug in keymap.c that I don't understand yet. -stef minibuffer-local-completion-map)) - (bindings--define-key map [menu-bar minibuf] + (define-key map [menu-bar minibuf] (cons "Minibuf" (make-sparse-keymap "Minibuf")))) (let ((map minibuffer-local-completion-map)) - (bindings--define-key map [menu-bar minibuf ?\?] + (define-key map [menu-bar minibuf ?\?] '(menu-item "List Completions" minibuffer-completion-help :help "Display all possible completions")) - (bindings--define-key map [menu-bar minibuf space] + (define-key map [menu-bar minibuf space] '(menu-item "Complete Word" minibuffer-complete-word :help "Complete at most one word")) - (bindings--define-key map [menu-bar minibuf tab] + (define-key map [menu-bar minibuf tab] '(menu-item "Complete" minibuffer-complete :help "Complete as far as possible"))) (let ((map minibuffer-local-map)) - (bindings--define-key map [menu-bar minibuf quit] + (define-key map [menu-bar minibuf quit] '(menu-item "Quit" abort-recursive-edit :help "Abort input and exit minibuffer")) - (bindings--define-key map [menu-bar minibuf return] + (define-key map [menu-bar minibuf return] '(menu-item "Enter" exit-minibuffer :key-sequence "\r" :help "Terminate input and exit minibuffer")) - (bindings--define-key map [menu-bar minibuf isearch-forward] + (define-key map [menu-bar minibuf isearch-forward] '(menu-item "Isearch History Forward" isearch-forward :help "Incrementally search minibuffer history forward")) - (bindings--define-key map [menu-bar minibuf isearch-backward] + (define-key map [menu-bar minibuf isearch-backward] '(menu-item "Isearch History Backward" isearch-backward :help "Incrementally search minibuffer history backward")) - (bindings--define-key map [menu-bar minibuf next] + (define-key map [menu-bar minibuf next] '(menu-item "Next History Item" next-history-element :help "Put next minibuffer history element in the minibuffer")) - (bindings--define-key map [menu-bar minibuf previous] + (define-key map [menu-bar minibuf previous] '(menu-item "Previous History Item" previous-history-element :help "Put previous minibuffer history element in the minibuffer"))) diff --git a/lisp/replace.el b/lisp/replace.el index 2285b19b519..51b8799ab76 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1315,7 +1315,7 @@ a previously found match." (define-key map "r" 'occur-rename-buffer) (define-key map "c" 'clone-buffer) (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) - (bindings--define-key map [menu-bar occur] (cons "Occur" occur-menu-map)) + (define-key map [menu-bar occur] (cons "Occur" occur-menu-map)) map) "Keymap for `occur-mode'.") @@ -1368,7 +1368,7 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. (define-key map "\C-c\C-c" 'occur-cease-edit) (define-key map "\C-o" 'occur-mode-display-occurrence) (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) - (bindings--define-key map [menu-bar occur] (cons "Occur" occur-menu-map)) + (define-key map [menu-bar occur] (cons "Occur" occur-menu-map)) map) "Keymap for `occur-edit-mode'.") diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 2188aa67e54..21a8c751252 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -830,15 +830,15 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (setq menu-bar-final-items '(buffer services hide-app quit)) ;; If running under GNUstep, "Help" is moved and renamed "Info". - (bindings--define-key global-map [menu-bar help-menu] + (define-key global-map [menu-bar help-menu] (cons "Info" menu-bar-help-menu)) - (bindings--define-key global-map [menu-bar quit] + (define-key global-map [menu-bar quit] '(menu-item "Quit" save-buffers-kill-emacs :help "Save unsaved buffers, then exit")) - (bindings--define-key global-map [menu-bar hide-app] + (define-key global-map [menu-bar hide-app] '(menu-item "Hide" ns-do-hide-emacs :help "Hide Emacs")) - (bindings--define-key global-map [menu-bar services] + (define-key global-map [menu-bar services] (cons "Services" (make-sparse-keymap "Services"))))) diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 8f212e96933..8fd1aa90b31 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -940,76 +940,76 @@ In the latter case, VC mode is deactivated for this buffer." (let ((map (make-sparse-keymap "Version Control"))) ;;(define-key map [show-files] ;; '("Show Files under VC" . (vc-directory t))) - (bindings--define-key map [vc-retrieve-tag] + (define-key map [vc-retrieve-tag] '(menu-item "Retrieve Tag" vc-retrieve-tag :help "Retrieve tagged version or branch")) - (bindings--define-key map [vc-create-tag] + (define-key map [vc-create-tag] '(menu-item "Create Tag" vc-create-tag :help "Create version tag")) - (bindings--define-key map [vc-print-branch-log] + (define-key map [vc-print-branch-log] '(menu-item "Show Branch History..." vc-print-branch-log :help "List the change log for another branch")) - (bindings--define-key map [vc-switch-branch] + (define-key map [vc-switch-branch] '(menu-item "Switch Branch..." vc-switch-branch :help "Switch to another branch")) - (bindings--define-key map [vc-create-branch] + (define-key map [vc-create-branch] '(menu-item "Create Branch..." vc-create-branch :help "Make a new branch")) - (bindings--define-key map [separator1] menu-bar-separator) - (bindings--define-key map [vc-annotate] + (define-key map [separator1] menu-bar-separator) + (define-key map [vc-annotate] '(menu-item "Annotate" vc-annotate :help "Display the edit history of the current file using colors")) - (bindings--define-key map [vc-rename-file] + (define-key map [vc-rename-file] '(menu-item "Rename File" vc-rename-file :help "Rename file")) - (bindings--define-key map [vc-revision-other-window] + (define-key map [vc-revision-other-window] '(menu-item "Show Other Version" vc-revision-other-window :help "Visit another version of the current file in another window")) - (bindings--define-key map [vc-diff] + (define-key map [vc-diff] '(menu-item "Compare with Base Version" vc-diff :help "Compare file set with the base version")) - (bindings--define-key map [vc-root-diff] + (define-key map [vc-root-diff] '(menu-item "Compare Tree with Base Version" vc-root-diff :help "Compare current tree with the base version")) - (bindings--define-key map [vc-update-change-log] + (define-key map [vc-update-change-log] '(menu-item "Update ChangeLog" vc-update-change-log :help "Find change log file and add entries from recent version control logs")) - (bindings--define-key map [vc-log-out] + (define-key map [vc-log-out] '(menu-item "Show Outgoing Log" vc-log-outgoing :help "Show a log of changes that will be sent with a push operation")) - (bindings--define-key map [vc-log-in] + (define-key map [vc-log-in] '(menu-item "Show Incoming Log" vc-log-incoming :help "Show a log of changes that will be received with a pull operation")) - (bindings--define-key map [vc-print-log] + (define-key map [vc-print-log] '(menu-item "Show History" vc-print-log :help "List the change log of the current file set in a window")) - (bindings--define-key map [vc-print-root-log] + (define-key map [vc-print-root-log] '(menu-item "Show Top of the Tree History " vc-print-root-log :help "List the change log for the current tree in a window")) - (bindings--define-key map [separator2] menu-bar-separator) - (bindings--define-key map [vc-insert-header] + (define-key map [separator2] menu-bar-separator) + (define-key map [vc-insert-header] '(menu-item "Insert Header" vc-insert-headers :help "Insert headers into a file for use with a version control system.")) - (bindings--define-key map [vc-revert] + (define-key map [vc-revert] '(menu-item "Revert to Base Version" vc-revert :help "Revert working copies of the selected file set to their repository contents")) ;; TODO Only :enable if (vc-find-backend-function backend 'push) - (bindings--define-key map [vc-push] + (define-key map [vc-push] '(menu-item "Push Changes" vc-push :help "Push the current branch's changes")) - (bindings--define-key map [vc-update] + (define-key map [vc-update] '(menu-item "Update to Latest Version" vc-update :help "Update the current fileset's files to their tip revisions")) - (bindings--define-key map [vc-next-action] + (define-key map [vc-next-action] '(menu-item "Check In/Out" vc-next-action :help "Do the next logical version control operation on the current fileset")) - (bindings--define-key map [vc-register] + (define-key map [vc-register] '(menu-item "Register" vc-register :help "Register file set into a version control system")) - (bindings--define-key map [vc-ignore] + (define-key map [vc-ignore] '(menu-item "Ignore File..." vc-ignore :help "Ignore a file under current version control system")) - (bindings--define-key map [vc-dir-root] + (define-key map [vc-dir-root] '(menu-item "VC Dir" vc-dir-root :help "Show the VC status of the repository")) map)) From 00a1152fad510d56cec813ba008f854cfceb163e Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Thu, 22 Aug 2024 05:48:43 +0000 Subject: [PATCH 20/57] Update pdumper hashes * src/pdumper.c (dump_symbol, dump_hash_table): Update hashes. --- src/pdumper.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/pdumper.c b/src/pdumper.c index 40798ff48e9..f9d74f87fb4 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2465,7 +2465,7 @@ dump_symbol (struct dump_context *ctx, Lisp_Object object, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_61B174C9F4 +#if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_E0ADAF2F24 # error "Lisp_Symbol changed. See CHECK_STRUCTS comment in config.h." #endif #if CHECK_STRUCTS && !defined (HASH_symbol_redirect_EA72E4BFF5) @@ -2733,7 +2733,7 @@ dump_hash_table_contents (struct dump_context *ctx, struct Lisp_Hash_Table *h) static dump_off dump_hash_table (struct dump_context *ctx, Lisp_Object object) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_0360833954 +#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_6728D315B2 # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); From c951fd415cd243eeda3caf2e536967a762bd0ffe Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Thu, 22 Aug 2024 05:49:33 +0000 Subject: [PATCH 21/57] Avoid compiler warning in process_mark_stack * src/alloc.c (process_mark_stack): Only declare and assign to 'po' if it's needed. Problem reported by: Stefan Kangas . --- src/alloc.c | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 8c8e1a99829..e557e82883c 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6702,8 +6702,6 @@ process_mark_stack (ptrdiff_t base_sp) { Lisp_Object obj = mark_stack_pop (); mark_obj: ; - void *po = XPNTR (obj); - #if GC_REMEMBER_LAST_MARKED last_marked[last_marked_index++] = obj; last_marked_index &= LAST_MARKED_SIZE - 1; @@ -6713,6 +6711,7 @@ process_mark_stack (ptrdiff_t base_sp) we encounter an object we know is bogus. This increases GC time by ~80%. */ #if GC_CHECK_MARKED_OBJECTS + void *po = XPNTR (obj); /* Check that the object pointed to by PO is known to be a Lisp structure allocated from the heap. */ @@ -6949,7 +6948,10 @@ process_mark_stack (ptrdiff_t base_sp) set_string_marked (XSTRING (ptr->u.s.name)); mark_interval_tree (string_intervals (ptr->u.s.name)); /* Inner loop to mark next symbol in this bucket, if any. */ - po = ptr = ptr->u.s.next; + ptr = ptr->u.s.next; +#if GC_CHECK_MARKED_OBJECTS + po = ptr; +#endif if (ptr) goto nextsym; } From 538a2428983c3aaf300bba920bc9f7e4d718982e Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 23 Aug 2024 20:05:15 +0200 Subject: [PATCH 22/57] Remove purecopy calls from files.el * lisp/files.el (null-device, file-name-invalid-regexp) (locate-dominating-stop-dir-regexp, auto-mode-alist) (interpreter-mode-alist, inhibit-local-variables-regexps) (auto-mode-interpreter-regexp, magic-fallback-mode-alist) (save-some-buffers-action-alist, list-directory-brief-switches) (list-directory-verbose-switches, insert-directory-program) (directory-free-space-program, directory-free-space-args) (directory-listing-before-filename-regexp) (file-name-handler-alist): Remove all purecopy calls. --- lisp/files.el | 688 +++++++++++++++++++++++++------------------------- 1 file changed, 338 insertions(+), 350 deletions(-) diff --git a/lisp/files.el b/lisp/files.el index a65bc4a4ea2..cce0396ef3d 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -231,7 +231,7 @@ have fast storage with limited space, such as a RAM disk." :type '(choice (const nil) directory)) ;; The system null device. (Should reference NULL_DEVICE from C.) -(defvar null-device (purecopy "/dev/null") "The system null device.") +(defvar null-device "/dev/null" "The system null device.") (declare-function msdos-long-file-names "msdos.c") (declare-function w32-long-file-name "w32proc.c") @@ -243,17 +243,15 @@ have fast storage with limited space, such as a RAM disk." (defvar file-name-invalid-regexp (cond ((and (eq system-type 'ms-dos) (not (msdos-long-file-names))) - (purecopy (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive "[+, ;=|<>\"?*]\\|\\[\\|\\]\\|" ; invalid characters "[\000-\037]\\|" ; control characters "\\(/\\.\\.?[^/]\\)\\|" ; leading dots - "\\(/[^/.]+\\.[^/.]*\\.\\)"))) ; more than a single dot + "\\(/[^/.]+\\.[^/.]*\\.\\)")) ; more than a single dot ((memq system-type '(ms-dos windows-nt cygwin)) - (purecopy - (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive - "[|<>\"?*\000-\037]"))) ; invalid characters - (t (purecopy "[\000]"))) + (concat "^\\([^A-Z[-`a-z]\\|..+\\)?:\\|" ; colon except after drive + "[|<>\"?*\000-\037]")) ; invalid characters + (t "[\000]")) "Regexp recognizing file names that aren't allowed by the filesystem.") (defcustom file-precious-flag nil @@ -1124,7 +1122,7 @@ one or more of those symbols." string-dir names string-file pred action))))) (defvar locate-dominating-stop-dir-regexp - (purecopy "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'") + "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'" "Regexp of directory names that stop the search in `locate-dominating-file'. Any directory whose name matches this regexp will be treated like a kind of root directory by `locate-dominating-file', which will stop its @@ -2937,277 +2935,274 @@ since only a single case-insensitive search through the alist is made." ;; Note: The entries for the modes defined in cc-mode.el (c-mode, ;; c++-mode, java-mode and more) are added through autoload ;; directives in that file. - (mapcar - (lambda (elt) - (cons (purecopy (car elt)) (cdr elt))) - `(;; do this first, so that .html.pl is Polish html, not Perl - ("\\.[sx]?html?\\(\\.[a-zA-Z_]+\\)?\\'" . mhtml-mode) - ("\\.svgz?\\'" . image-mode) - ("\\.svgz?\\'" . xml-mode) - ("\\.x[bp]m\\'" . image-mode) - ("\\.x[bp]m\\'" . c-mode) - ("\\.p[bpgn]m\\'" . image-mode) - ("\\.tiff?\\'" . image-mode) - ("\\.gif\\'" . image-mode) - ("\\.png\\'" . image-mode) - ("\\.jpe?g\\'" . image-mode) - ("\\.webp\\'" . image-mode) - ("\\.te?xt\\'" . text-mode) - ("\\.[tT]e[xX]\\'" . tex-mode) - ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages. - ("\\.ltx\\'" . latex-mode) - ("\\.dtx\\'" . doctex-mode) - ("\\.org\\'" . org-mode) - ;; .dir-locals.el is not really Elisp. Could use the - ;; `dir-locals-file' constant if it weren't defined below. - ("\\.dir-locals\\(?:-2\\)?\\.el\\'" . lisp-data-mode) - ("\\.eld\\'" . lisp-data-mode) - ;; FIXME: The lisp-data-mode files below should use the `.eld' extension - ;; (or a -*- mode cookie) so we don't need ad-hoc entries here. - ("eww-bookmarks\\'" . lisp-data-mode) - ("tramp\\'" . lisp-data-mode) - ("/archive-contents\\'" . lisp-data-mode) - ("places\\'" . lisp-data-mode) - ("\\.emacs-places\\'" . lisp-data-mode) - ("\\.el\\'" . emacs-lisp-mode) - ("Project\\.ede\\'" . emacs-lisp-mode) - ("\\(?:\\.\\(?:scm\\|sls\\|sld\\|stk\\|ss\\|sch\\)\\|/\\.guile\\)\\'" . scheme-mode) - ("\\.l\\'" . lisp-mode) - ("\\.li?sp\\'" . lisp-mode) - ("\\.[fF]\\'" . fortran-mode) - ("\\.for\\'" . fortran-mode) - ("\\.p\\'" . pascal-mode) - ("\\.pas\\'" . pascal-mode) - ("\\.\\(dpr\\|DPR\\)\\'" . delphi-mode) - ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode) - ("Imakefile\\'" . makefile-imake-mode) - ("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk - ("\\.makepp\\'" . makefile-makepp-mode) - ,@(if (memq system-type '(berkeley-unix darwin)) - '(("\\.mk\\'" . makefile-bsdmake-mode) - ("\\.make\\'" . makefile-bsdmake-mode) - ("GNUmakefile\\'" . makefile-gmake-mode) - ("[Mm]akefile\\'" . makefile-bsdmake-mode)) - '(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give GNU the host advantage - ("\\.make\\'" . makefile-gmake-mode) - ("[Mm]akefile\\'" . makefile-gmake-mode))) - ("\\.am\\'" . makefile-automake-mode) - ;; Less common extensions come here - ;; so more common ones above are found faster. - ("\\.texinfo\\'" . texinfo-mode) - ("\\.te?xi\\'" . texinfo-mode) - ("\\.[sS]\\'" . asm-mode) - ("\\.asm\\'" . asm-mode) - ("\\.css\\'" . css-mode) - ("\\.mixal\\'" . mixal-mode) - ("\\.gcov\\'" . compilation-mode) - ;; Besides .gdbinit, gdb documents other names to be usable for init - ;; files, cross-debuggers can use something like - ;; .PROCESSORNAME-gdbinit so that the host and target gdbinit files - ;; don't interfere with each other. - ("/\\.[a-z0-9-]*gdbinit" . gdb-script-mode) - ;; GDB 7.5 introduced OBJFILE-gdb.gdb script files; e.g. a file - ;; named 'emacs-gdb.gdb', if it exists, will be automatically - ;; loaded when GDB reads an objfile called 'emacs'. - ("-gdb\\.gdb" . gdb-script-mode) - ("[cC]hange\\.?[lL]og?\\'" . change-log-mode) - ("[cC]hange[lL]og[-.][0-9]+\\'" . change-log-mode) - ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) - ("\\.scm\\.[0-9]*\\'" . scheme-mode) - ("\\.[ckz]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) - ("\\.bash\\'" . sh-mode) - ;; Bash builtin 'fc' creates a temp file named "bash-fc.XXXXXX" - ;; to edit shell commands from its history list. - ("/bash-fc\\.[0-9A-Za-z]\\{6\\}\\'" . sh-mode) - ("/PKGBUILD\\'" . sh-mode) - ("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode) - ("\\(/\\|\\`\\)\\.\\(shrc\\|zshrc\\|m?kshrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) - ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode) - ("\\.m?spec\\'" . sh-mode) - ("\\.m[mes]\\'" . nroff-mode) - ("\\.man\\'" . nroff-mode) - ("\\.sty\\'" . latex-mode) - ("\\.cl[so]\\'" . latex-mode) ;LaTeX 2e class option - ("\\.bbl\\'" . latex-mode) - ("\\.bib\\'" . bibtex-mode) - ("\\.bst\\'" . bibtex-style-mode) - ("\\.sql\\'" . sql-mode) - ;; These .m4 files are Autoconf files. - ("\\(acinclude\\|aclocal\\|acsite\\)\\.m4\\'" . autoconf-mode) - ("\\.m[4c]\\'" . m4-mode) - ("\\.mf\\'" . metafont-mode) - ("\\.mp\\'" . metapost-mode) - ("\\.vhdl?\\'" . vhdl-mode) - ("\\.article\\'" . text-mode) - ("\\.letter\\'" . text-mode) - ("\\.i?tcl\\'" . tcl-mode) - ("\\.exp\\'" . tcl-mode) - ("\\.itk\\'" . tcl-mode) - ("\\.icn\\'" . icon-mode) - ("\\.sim\\'" . simula-mode) - ("\\.mss\\'" . scribe-mode) - ;; The Fortran standard does not say anything about file extensions. - ;; .f90 was widely used for F90, now we seem to be trapped into - ;; using a different extension for each language revision. - ;; Anyway, the following extensions are supported by gfortran. - ("\\.f9[05]\\'" . f90-mode) - ("\\.f0[38]\\'" . f90-mode) - ("\\.srt\\'" . srecode-template-mode) - ("\\.prolog\\'" . prolog-mode) - ("\\.tar\\'" . tar-mode) - ;; The list of archive file extensions should be in sync with - ;; `auto-coding-alist' with `no-conversion' coding system. - ("\\.\\(\ + `(;; do this first, so that .html.pl is Polish html, not Perl + ("\\.[sx]?html?\\(\\.[a-zA-Z_]+\\)?\\'" . mhtml-mode) + ("\\.svgz?\\'" . image-mode) + ("\\.svgz?\\'" . xml-mode) + ("\\.x[bp]m\\'" . image-mode) + ("\\.x[bp]m\\'" . c-mode) + ("\\.p[bpgn]m\\'" . image-mode) + ("\\.tiff?\\'" . image-mode) + ("\\.gif\\'" . image-mode) + ("\\.png\\'" . image-mode) + ("\\.jpe?g\\'" . image-mode) + ("\\.webp\\'" . image-mode) + ("\\.te?xt\\'" . text-mode) + ("\\.[tT]e[xX]\\'" . tex-mode) + ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages. + ("\\.ltx\\'" . latex-mode) + ("\\.dtx\\'" . doctex-mode) + ("\\.org\\'" . org-mode) + ;; .dir-locals.el is not really Elisp. Could use the + ;; `dir-locals-file' constant if it weren't defined below. + ("\\.dir-locals\\(?:-2\\)?\\.el\\'" . lisp-data-mode) + ("\\.eld\\'" . lisp-data-mode) + ;; FIXME: The lisp-data-mode files below should use the `.eld' extension + ;; (or a -*- mode cookie) so we don't need ad-hoc entries here. + ("eww-bookmarks\\'" . lisp-data-mode) + ("tramp\\'" . lisp-data-mode) + ("/archive-contents\\'" . lisp-data-mode) + ("places\\'" . lisp-data-mode) + ("\\.emacs-places\\'" . lisp-data-mode) + ("\\.el\\'" . emacs-lisp-mode) + ("Project\\.ede\\'" . emacs-lisp-mode) + ("\\(?:\\.\\(?:scm\\|sls\\|sld\\|stk\\|ss\\|sch\\)\\|/\\.guile\\)\\'" . scheme-mode) + ("\\.l\\'" . lisp-mode) + ("\\.li?sp\\'" . lisp-mode) + ("\\.[fF]\\'" . fortran-mode) + ("\\.for\\'" . fortran-mode) + ("\\.p\\'" . pascal-mode) + ("\\.pas\\'" . pascal-mode) + ("\\.\\(dpr\\|DPR\\)\\'" . delphi-mode) + ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode) + ("Imakefile\\'" . makefile-imake-mode) + ("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk + ("\\.makepp\\'" . makefile-makepp-mode) + ,@(if (memq system-type '(berkeley-unix darwin)) + '(("\\.mk\\'" . makefile-bsdmake-mode) + ("\\.make\\'" . makefile-bsdmake-mode) + ("GNUmakefile\\'" . makefile-gmake-mode) + ("[Mm]akefile\\'" . makefile-bsdmake-mode)) + '(("\\.mk\\'" . makefile-gmake-mode) ; Might be any make, give GNU the host advantage + ("\\.make\\'" . makefile-gmake-mode) + ("[Mm]akefile\\'" . makefile-gmake-mode))) + ("\\.am\\'" . makefile-automake-mode) + ;; Less common extensions come here + ;; so more common ones above are found faster. + ("\\.texinfo\\'" . texinfo-mode) + ("\\.te?xi\\'" . texinfo-mode) + ("\\.[sS]\\'" . asm-mode) + ("\\.asm\\'" . asm-mode) + ("\\.css\\'" . css-mode) + ("\\.mixal\\'" . mixal-mode) + ("\\.gcov\\'" . compilation-mode) + ;; Besides .gdbinit, gdb documents other names to be usable for init + ;; files, cross-debuggers can use something like + ;; .PROCESSORNAME-gdbinit so that the host and target gdbinit files + ;; don't interfere with each other. + ("/\\.[a-z0-9-]*gdbinit" . gdb-script-mode) + ;; GDB 7.5 introduced OBJFILE-gdb.gdb script files; e.g. a file + ;; named 'emacs-gdb.gdb', if it exists, will be automatically + ;; loaded when GDB reads an objfile called 'emacs'. + ("-gdb\\.gdb" . gdb-script-mode) + ("[cC]hange\\.?[lL]og?\\'" . change-log-mode) + ("[cC]hange[lL]og[-.][0-9]+\\'" . change-log-mode) + ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) + ("\\.scm\\.[0-9]*\\'" . scheme-mode) + ("\\.[ckz]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) + ("\\.bash\\'" . sh-mode) + ;; Bash builtin 'fc' creates a temp file named "bash-fc.XXXXXX" + ;; to edit shell commands from its history list. + ("/bash-fc\\.[0-9A-Za-z]\\{6\\}\\'" . sh-mode) + ("/PKGBUILD\\'" . sh-mode) + ("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode) + ("\\(/\\|\\`\\)\\.\\(shrc\\|zshrc\\|m?kshrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) + ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode) + ("\\.m?spec\\'" . sh-mode) + ("\\.m[mes]\\'" . nroff-mode) + ("\\.man\\'" . nroff-mode) + ("\\.sty\\'" . latex-mode) + ("\\.cl[so]\\'" . latex-mode) ;LaTeX 2e class option + ("\\.bbl\\'" . latex-mode) + ("\\.bib\\'" . bibtex-mode) + ("\\.bst\\'" . bibtex-style-mode) + ("\\.sql\\'" . sql-mode) + ;; These .m4 files are Autoconf files. + ("\\(acinclude\\|aclocal\\|acsite\\)\\.m4\\'" . autoconf-mode) + ("\\.m[4c]\\'" . m4-mode) + ("\\.mf\\'" . metafont-mode) + ("\\.mp\\'" . metapost-mode) + ("\\.vhdl?\\'" . vhdl-mode) + ("\\.article\\'" . text-mode) + ("\\.letter\\'" . text-mode) + ("\\.i?tcl\\'" . tcl-mode) + ("\\.exp\\'" . tcl-mode) + ("\\.itk\\'" . tcl-mode) + ("\\.icn\\'" . icon-mode) + ("\\.sim\\'" . simula-mode) + ("\\.mss\\'" . scribe-mode) + ;; The Fortran standard does not say anything about file extensions. + ;; .f90 was widely used for F90, now we seem to be trapped into + ;; using a different extension for each language revision. + ;; Anyway, the following extensions are supported by gfortran. + ("\\.f9[05]\\'" . f90-mode) + ("\\.f0[38]\\'" . f90-mode) + ("\\.srt\\'" . srecode-template-mode) + ("\\.prolog\\'" . prolog-mode) + ("\\.tar\\'" . tar-mode) + ;; The list of archive file extensions should be in sync with + ;; `auto-coding-alist' with `no-conversion' coding system. + ("\\.\\(\ arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|cbr\\|7z\\|squashfs\\|\ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\|SQUASHFS\\)\\'" . archive-mode) - ("\\.oxt\\'" . archive-mode) ;(Open|Libre)Office extensions. - ("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages. - ;; Mailer puts message to be edited in - ;; /tmp/Re.... or Message - ("\\`/tmp/Re" . text-mode) - ("/Message[0-9]*\\'" . text-mode) - ;; some news reader is reported to use this - ("\\`/tmp/fol/" . text-mode) - ("\\.oak\\'" . scheme-mode) - ("\\.sgml?\\'" . sgml-mode) - ("\\.x[ms]l\\'" . xml-mode) - ("\\.dbk\\'" . xml-mode) - ("\\.dtd\\'" . sgml-mode) - ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) - ("\\.js[mx]?\\'" . javascript-mode) - ;; https://en.wikipedia.org/wiki/.har - ("\\.har\\'" . javascript-mode) - ("\\.json\\'" . js-json-mode) - ("\\.[ds]?va?h?\\'" . verilog-mode) - ("\\.by\\'" . bovine-grammar-mode) - ("\\.wy\\'" . wisent-grammar-mode) - ("\\.erts\\'" . erts-mode) - ;; .emacs or .gnus or .viper following a directory delimiter in - ;; Unix or MS-DOS syntax. - ("[:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode) - ("\\`\\..*emacs\\'" . emacs-lisp-mode) - ;; _emacs following a directory delimiter in MS-DOS syntax - ("[:/]_emacs\\'" . emacs-lisp-mode) - ("/crontab\\.X*[0-9]+\\'" . shell-script-mode) - ("\\.ml\\'" . lisp-mode) - ;; Linux-2.6.9 uses some different suffix for linker scripts: - ;; "ld", "lds", "lds.S", "lds.in", "ld.script", and "ld.script.balo". - ;; eCos uses "ld" and "ldi". Netbsd uses "ldscript.*". - ("\\.ld[si]?\\'" . ld-script-mode) - ("ld\\.?script\\'" . ld-script-mode) - ;; .xs is also used for ld scripts, but seems to be more commonly - ;; associated with Perl .xs files (C with Perl bindings). (Bug#7071) - ("\\.xs\\'" . c-mode) - ;; Explained in binutils ld/genscripts.sh. Eg: - ;; A .x script file is the default script. - ;; A .xr script is for linking without relocation (-r flag). Etc. - ("\\.x[abdsru]?[cnw]?\\'" . ld-script-mode) - ("\\.zone\\'" . dns-mode) - ("\\.soa\\'" . dns-mode) - ;; Common Lisp ASDF package system. - ("\\.asd\\'" . lisp-mode) - ("\\.\\(asn\\|mib\\|smi\\)\\'" . snmp-mode) - ("\\.\\(as\\|mi\\|sm\\)2\\'" . snmpv2-mode) - ("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode) - ("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MS-DOS - ("\\.[eE]?[pP][sS]\\'" . ps-mode) - ("\\.\\(?:PDF\\|EPUB\\|CBZ\\|FB2\\|O?XPS\\|DVI\\|OD[FGPST]\\|DOCX\\|XLSX?\\|PPTX?\\|pdf\\|epub\\|cbz\\|fb2\\|o?xps\\|djvu\\|dvi\\|od[fgpst]\\|docx\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe) - ("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode) - ("\\.s\\(v\\|iv\\|ieve\\)\\'" . sieve-mode) - ("BROWSE\\'" . ebrowse-tree-mode) - ("\\.ebrowse\\'" . ebrowse-tree-mode) - ("#\\*mail\\*" . mail-mode) - ("\\.g\\'" . antlr-mode) - ("\\.mod\\'" . m2-mode) - ("\\.ses\\'" . ses-mode) - ("\\.docbook\\'" . sgml-mode) - ("\\.com\\'" . dcl-mode) - ("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode) - ("/\\.?\\(authinfo\\|netrc\\)\\'" . authinfo-mode) - ;; Windows candidates may be opened case sensitively on Unix - ("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode) - ("\\.la\\'" . conf-unix-mode) - ("\\.ppd\\'" . conf-ppd-mode) - ("java.+\\.conf\\'" . conf-javaprop-mode) - ("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode) - ("\\.toml\\'" . conf-toml-mode) - ("\\.desktop\\'" . conf-desktop-mode) - ("/\\.redshift\\.conf\\'" . conf-windows-mode) - ("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode) - ("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode) - ;; ChangeLog.old etc. Other change-log-mode entries are above; - ;; this has lower priority to avoid matching changelog.sgml etc. - ("[cC]hange[lL]og[-.][-0-9a-z]+\\'" . change-log-mode) - ;; either user's dot-files or under /etc or some such - ("/\\.?\\(?:gitconfig\\|gnokiirc\\|hgrc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode) - ("/\\.mailmap\\'" . conf-unix-mode) - ;; alas not all ~/.*rc files are like this - ("/\\.\\(?:asound\\|enigma\\|fetchmail\\|gltron\\|gtk\\|hxplayer\\|mairix\\|mbsync\\|msmtp\\|net\\|neverball\\|nvidia-settings-\\|offlineimap\\|qt/.+\\|realplayer\\|reportbug\\|rtorrent\\.\\|screen\\|scummvm\\|sversion\\|sylpheed/.+\\|xmp\\)rc\\'" . conf-mode) - ("/\\.\\(?:gdbtkinit\\|grip\\|mpdconf\\|notmuch-config\\|orbital/.+txt\\|rhosts\\|tuxracer/options\\)\\'" . conf-mode) - ("/\\.?X\\(?:default\\|resource\\|re\\)s\\>" . conf-xdefaults-mode) - ("/X11.+app-defaults/\\|\\.ad\\'" . conf-xdefaults-mode) - ("/X11.+locale/.+/Compose\\'" . conf-colon-mode) - ;; this contains everything twice, with space and with colon :-( - ("/X11.+locale/compose\\.dir\\'" . conf-javaprop-mode) - ;; Get rid of any trailing .n.m and try again. - ;; This is for files saved by cvs-merge that look like .#. - ;; or .#.- or VC's .~~. - ;; Using mode nil rather than `ignore' would let the search continue - ;; through this list (with the shortened name) rather than start over. - ("\\.~?[0-9]+\\.[0-9][-.0-9]*~?\\'" nil t) - ("\\.\\(?:orig\\|in\\|[bB][aA][kK]\\)\\'" nil t) - ;; This should come after "in" stripping (e.g. config.h.in). - ;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config - ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode-maybe) - ;; The following should come after the ChangeLog pattern - ;; for the sake of ChangeLog.1, etc. - ;; and after the .scm.[0-9] and CVS' . patterns too. - ("\\.[1-9]\\'" . nroff-mode) - ;; Image file types probably supported by `image-convert'. - ("\\.art\\'" . image-mode) - ("\\.avs\\'" . image-mode) - ("\\.bmp\\'" . image-mode) - ("\\.cmyk\\'" . image-mode) - ("\\.cmyka\\'" . image-mode) - ("\\.crw\\'" . image-mode) - ("\\.dcr\\'" . image-mode) - ("\\.dcx\\'" . image-mode) - ("\\.dng\\'" . image-mode) - ("\\.dpx\\'" . image-mode) - ("\\.fax\\'" . image-mode) - ("\\.heic\\'" . image-mode) - ("\\.hrz\\'" . image-mode) - ("\\.icb\\'" . image-mode) - ("\\.icc\\'" . image-mode) - ("\\.icm\\'" . image-mode) - ("\\.ico\\'" . image-mode) - ("\\.icon\\'" . image-mode) - ("\\.jbg\\'" . image-mode) - ("\\.jbig\\'" . image-mode) - ("\\.jng\\'" . image-mode) - ("\\.jnx\\'" . image-mode) - ("\\.miff\\'" . image-mode) - ("\\.mng\\'" . image-mode) - ("\\.mvg\\'" . image-mode) - ("\\.otb\\'" . image-mode) - ("\\.p7\\'" . image-mode) - ("\\.pcx\\'" . image-mode) - ("\\.pdb\\'" . image-mode) - ("\\.pfa\\'" . image-mode) - ("\\.pfb\\'" . image-mode) - ("\\.picon\\'" . image-mode) - ("\\.pict\\'" . image-mode) - ("\\.rgb\\'" . image-mode) - ("\\.rgba\\'" . image-mode) - ("\\.tga\\'" . image-mode) - ("\\.wbmp\\'" . image-mode) - ("\\.webp\\'" . image-mode) - ("\\.wmf\\'" . image-mode) - ("\\.wpg\\'" . image-mode) - ("\\.xcf\\'" . image-mode) - ("\\.xmp\\'" . image-mode) - ("\\.xwd\\'" . image-mode) - ("\\.yuv\\'" . image-mode))) + ("\\.oxt\\'" . archive-mode) ;(Open|Libre)Office extensions. + ("\\.\\(deb\\|[oi]pk\\)\\'" . archive-mode) ; Debian/Opkg packages. + ;; Mailer puts message to be edited in + ;; /tmp/Re.... or Message + ("\\`/tmp/Re" . text-mode) + ("/Message[0-9]*\\'" . text-mode) + ;; some news reader is reported to use this + ("\\`/tmp/fol/" . text-mode) + ("\\.oak\\'" . scheme-mode) + ("\\.sgml?\\'" . sgml-mode) + ("\\.x[ms]l\\'" . xml-mode) + ("\\.dbk\\'" . xml-mode) + ("\\.dtd\\'" . sgml-mode) + ("\\.ds\\(ss\\)?l\\'" . dsssl-mode) + ("\\.js[mx]?\\'" . javascript-mode) + ;; https://en.wikipedia.org/wiki/.har + ("\\.har\\'" . javascript-mode) + ("\\.json\\'" . js-json-mode) + ("\\.[ds]?va?h?\\'" . verilog-mode) + ("\\.by\\'" . bovine-grammar-mode) + ("\\.wy\\'" . wisent-grammar-mode) + ("\\.erts\\'" . erts-mode) + ;; .emacs or .gnus or .viper following a directory delimiter in + ;; Unix or MS-DOS syntax. + ("[:/\\]\\..*\\(emacs\\|gnus\\|viper\\)\\'" . emacs-lisp-mode) + ("\\`\\..*emacs\\'" . emacs-lisp-mode) + ;; _emacs following a directory delimiter in MS-DOS syntax + ("[:/]_emacs\\'" . emacs-lisp-mode) + ("/crontab\\.X*[0-9]+\\'" . shell-script-mode) + ("\\.ml\\'" . lisp-mode) + ;; Linux-2.6.9 uses some different suffix for linker scripts: + ;; "ld", "lds", "lds.S", "lds.in", "ld.script", and "ld.script.balo". + ;; eCos uses "ld" and "ldi". Netbsd uses "ldscript.*". + ("\\.ld[si]?\\'" . ld-script-mode) + ("ld\\.?script\\'" . ld-script-mode) + ;; .xs is also used for ld scripts, but seems to be more commonly + ;; associated with Perl .xs files (C with Perl bindings). (Bug#7071) + ("\\.xs\\'" . c-mode) + ;; Explained in binutils ld/genscripts.sh. Eg: + ;; A .x script file is the default script. + ;; A .xr script is for linking without relocation (-r flag). Etc. + ("\\.x[abdsru]?[cnw]?\\'" . ld-script-mode) + ("\\.zone\\'" . dns-mode) + ("\\.soa\\'" . dns-mode) + ;; Common Lisp ASDF package system. + ("\\.asd\\'" . lisp-mode) + ("\\.\\(asn\\|mib\\|smi\\)\\'" . snmp-mode) + ("\\.\\(as\\|mi\\|sm\\)2\\'" . snmpv2-mode) + ("\\.\\(diffs?\\|patch\\|rej\\)\\'" . diff-mode) + ("\\.\\(dif\\|pat\\)\\'" . diff-mode) ; for MS-DOS + ("\\.[eE]?[pP][sS]\\'" . ps-mode) + ("\\.\\(?:PDF\\|EPUB\\|CBZ\\|FB2\\|O?XPS\\|DVI\\|OD[FGPST]\\|DOCX\\|XLSX?\\|PPTX?\\|pdf\\|epub\\|cbz\\|fb2\\|o?xps\\|djvu\\|dvi\\|od[fgpst]\\|docx\\|xlsx?\\|pptx?\\)\\'" . doc-view-mode-maybe) + ("configure\\.\\(ac\\|in\\)\\'" . autoconf-mode) + ("\\.s\\(v\\|iv\\|ieve\\)\\'" . sieve-mode) + ("BROWSE\\'" . ebrowse-tree-mode) + ("\\.ebrowse\\'" . ebrowse-tree-mode) + ("#\\*mail\\*" . mail-mode) + ("\\.g\\'" . antlr-mode) + ("\\.mod\\'" . m2-mode) + ("\\.ses\\'" . ses-mode) + ("\\.docbook\\'" . sgml-mode) + ("\\.com\\'" . dcl-mode) + ("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode) + ("/\\.?\\(authinfo\\|netrc\\)\\'" . authinfo-mode) + ;; Windows candidates may be opened case sensitively on Unix + ("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode) + ("\\.la\\'" . conf-unix-mode) + ("\\.ppd\\'" . conf-ppd-mode) + ("java.+\\.conf\\'" . conf-javaprop-mode) + ("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode) + ("\\.toml\\'" . conf-toml-mode) + ("\\.desktop\\'" . conf-desktop-mode) + ("/\\.redshift\\.conf\\'" . conf-windows-mode) + ("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode) + ("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode) + ;; ChangeLog.old etc. Other change-log-mode entries are above; + ;; this has lower priority to avoid matching changelog.sgml etc. + ("[cC]hange[lL]og[-.][-0-9a-z]+\\'" . change-log-mode) + ;; either user's dot-files or under /etc or some such + ("/\\.?\\(?:gitconfig\\|gnokiirc\\|hgrc\\|kde.*rc\\|mime\\.types\\|wgetrc\\)\\'" . conf-mode) + ("/\\.mailmap\\'" . conf-unix-mode) + ;; alas not all ~/.*rc files are like this + ("/\\.\\(?:asound\\|enigma\\|fetchmail\\|gltron\\|gtk\\|hxplayer\\|mairix\\|mbsync\\|msmtp\\|net\\|neverball\\|nvidia-settings-\\|offlineimap\\|qt/.+\\|realplayer\\|reportbug\\|rtorrent\\.\\|screen\\|scummvm\\|sversion\\|sylpheed/.+\\|xmp\\)rc\\'" . conf-mode) + ("/\\.\\(?:gdbtkinit\\|grip\\|mpdconf\\|notmuch-config\\|orbital/.+txt\\|rhosts\\|tuxracer/options\\)\\'" . conf-mode) + ("/\\.?X\\(?:default\\|resource\\|re\\)s\\>" . conf-xdefaults-mode) + ("/X11.+app-defaults/\\|\\.ad\\'" . conf-xdefaults-mode) + ("/X11.+locale/.+/Compose\\'" . conf-colon-mode) + ;; this contains everything twice, with space and with colon :-( + ("/X11.+locale/compose\\.dir\\'" . conf-javaprop-mode) + ;; Get rid of any trailing .n.m and try again. + ;; This is for files saved by cvs-merge that look like .#. + ;; or .#.- or VC's .~~. + ;; Using mode nil rather than `ignore' would let the search continue + ;; through this list (with the shortened name) rather than start over. + ("\\.~?[0-9]+\\.[0-9][-.0-9]*~?\\'" nil t) + ("\\.\\(?:orig\\|in\\|[bB][aA][kK]\\)\\'" nil t) + ;; This should come after "in" stripping (e.g. config.h.in). + ;; *.cf, *.cfg, *.conf, *.config[.local|.de_DE.UTF8|...], */config + ("[/.]c\\(?:on\\)?f\\(?:i?g\\)?\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-mode-maybe) + ;; The following should come after the ChangeLog pattern + ;; for the sake of ChangeLog.1, etc. + ;; and after the .scm.[0-9] and CVS' . patterns too. + ("\\.[1-9]\\'" . nroff-mode) + ;; Image file types probably supported by `image-convert'. + ("\\.art\\'" . image-mode) + ("\\.avs\\'" . image-mode) + ("\\.bmp\\'" . image-mode) + ("\\.cmyk\\'" . image-mode) + ("\\.cmyka\\'" . image-mode) + ("\\.crw\\'" . image-mode) + ("\\.dcr\\'" . image-mode) + ("\\.dcx\\'" . image-mode) + ("\\.dng\\'" . image-mode) + ("\\.dpx\\'" . image-mode) + ("\\.fax\\'" . image-mode) + ("\\.heic\\'" . image-mode) + ("\\.hrz\\'" . image-mode) + ("\\.icb\\'" . image-mode) + ("\\.icc\\'" . image-mode) + ("\\.icm\\'" . image-mode) + ("\\.ico\\'" . image-mode) + ("\\.icon\\'" . image-mode) + ("\\.jbg\\'" . image-mode) + ("\\.jbig\\'" . image-mode) + ("\\.jng\\'" . image-mode) + ("\\.jnx\\'" . image-mode) + ("\\.miff\\'" . image-mode) + ("\\.mng\\'" . image-mode) + ("\\.mvg\\'" . image-mode) + ("\\.otb\\'" . image-mode) + ("\\.p7\\'" . image-mode) + ("\\.pcx\\'" . image-mode) + ("\\.pdb\\'" . image-mode) + ("\\.pfa\\'" . image-mode) + ("\\.pfb\\'" . image-mode) + ("\\.picon\\'" . image-mode) + ("\\.pict\\'" . image-mode) + ("\\.rgb\\'" . image-mode) + ("\\.rgba\\'" . image-mode) + ("\\.tga\\'" . image-mode) + ("\\.wbmp\\'" . image-mode) + ("\\.webp\\'" . image-mode) + ("\\.wmf\\'" . image-mode) + ("\\.wpg\\'" . image-mode) + ("\\.xcf\\'" . image-mode) + ("\\.xmp\\'" . image-mode) + ("\\.xwd\\'" . image-mode) + ("\\.yuv\\'" . image-mode)) "Alist of file name patterns vs corresponding major mode functions. Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL). \(NON-NIL stands for anything that is not nil; the value does not matter.) @@ -3240,34 +3235,31 @@ and `magic-mode-alist', which determines modes based on file contents.") ;; Note: The entries for the modes defined in cc-mode.el (awk-mode ;; and pike-mode) are added through autoload directives in that ;; file. - (mapcar - (lambda (l) - (cons (purecopy (car l)) (cdr l))) - '(("\\(mini\\)?perl5?" . perl-mode) - ("wishx?" . tcl-mode) - ("tcl\\(sh\\)?" . tcl-mode) - ("expect" . tcl-mode) - ("octave" . octave-mode) - ("scm" . scheme-mode) - ("[acjkwz]sh" . sh-mode) - ("r?bash2?" . sh-mode) - ("dash" . sh-mode) - ("mksh" . sh-mode) - ("\\(dt\\|pd\\|w\\)ksh" . sh-mode) - ("es" . sh-mode) - ("i?tcsh" . sh-mode) - ("oash" . sh-mode) - ("rc" . sh-mode) - ("rpm" . sh-mode) - ("sh5?" . sh-mode) - ("tail" . text-mode) - ("more" . text-mode) - ("less" . text-mode) - ("pg" . text-mode) - ("make" . makefile-gmake-mode) ; Debian uses this - ("guile" . scheme-mode) - ("clisp" . lisp-mode) - ("emacs" . emacs-lisp-mode))) + '(("\\(mini\\)?perl5?" . perl-mode) + ("wishx?" . tcl-mode) + ("tcl\\(sh\\)?" . tcl-mode) + ("expect" . tcl-mode) + ("octave" . octave-mode) + ("scm" . scheme-mode) + ("[acjkwz]sh" . sh-mode) + ("r?bash2?" . sh-mode) + ("dash" . sh-mode) + ("mksh" . sh-mode) + ("\\(dt\\|pd\\|w\\)ksh" . sh-mode) + ("es" . sh-mode) + ("i?tcsh" . sh-mode) + ("oash" . sh-mode) + ("rc" . sh-mode) + ("rpm" . sh-mode) + ("sh5?" . sh-mode) + ("tail" . text-mode) + ("more" . text-mode) + ("less" . text-mode) + ("pg" . text-mode) + ("make" . makefile-gmake-mode) ; Debian uses this + ("guile" . scheme-mode) + ("clisp" . lisp-mode) + ("emacs" . emacs-lisp-mode)) "Alist mapping interpreter names to major modes. This is used for files whose first lines match `auto-mode-interpreter-regexp'. Each element looks like (REGEXP . MODE). @@ -3281,13 +3273,13 @@ See also `auto-mode-alist'.") ;; because we are duplicating info from auto-mode-alist. ;; TODO many elements of this list are also in auto-coding-alist. (defvar inhibit-local-variables-regexps - (mapcar 'purecopy '("\\.tar\\'" "\\.t[bg]z\\'" - "\\.arc\\'" "\\.zip\\'" "\\.lzh\\'" "\\.lha\\'" - "\\.zoo\\'" "\\.[jew]ar\\'" "\\.xpi\\'" "\\.rar\\'" - "\\.7z\\'" - "\\.sx[dmicw]\\'" "\\.odt\\'" - "\\.diff\\'" "\\.patch\\'" - "\\.tiff?\\'" "\\.gif\\'" "\\.png\\'" "\\.jpe?g\\'")) + '("\\.tar\\'" "\\.t[bg]z\\'" + "\\.arc\\'" "\\.zip\\'" "\\.lzh\\'" "\\.lha\\'" + "\\.zoo\\'" "\\.[jew]ar\\'" "\\.xpi\\'" "\\.rar\\'" + "\\.7z\\'" + "\\.sx[dmicw]\\'" "\\.odt\\'" + "\\.diff\\'" "\\.patch\\'" + "\\.tiff?\\'" "\\.gif\\'" "\\.png\\'" "\\.jpe?g\\'") "List of regexps matching file names in which to ignore local variables. This includes `-*-' lines as well as trailing \"Local Variables\" sections. Files matching this list are typically binary file formats. @@ -3328,25 +3320,24 @@ and `inhibit-local-variables-suffixes'. If temp)) (defvar auto-mode-interpreter-regexp - (purecopy - (concat - "#![ \t]*" - ;; Optional group 1: env(1) invocation. - "\\(" - "[^ \t\n]*/bin/env[ \t]*" - ;; Within group 1: possible -S/--split-string and environment - ;; adjustments. - "\\(?:" - ;; -S/--split-string - "\\(?:-[0a-z]*S[ \t]*\\|--split-string=\\)" - ;; More env arguments. - "\\(?:-[^ \t\n]+[ \t]+\\)*" - ;; Interpreter environment modifications. - "\\(?:[^ \t\n]+=[^ \t\n]*[ \t]+\\)*" - "\\)?" - "\\)?" - ;; Group 2: interpreter. - "\\([^ \t\n]+\\)")) + (concat + "#![ \t]*" + ;; Optional group 1: env(1) invocation. + "\\(" + "[^ \t\n]*/bin/env[ \t]*" + ;; Within group 1: possible -S/--split-string and environment + ;; adjustments. + "\\(?:" + ;; -S/--split-string + "\\(?:-[0a-z]*S[ \t]*\\|--split-string=\\)" + ;; More env arguments. + "\\(?:-[^ \t\n]+[ \t]+\\)*" + ;; Interpreter environment modifications. + "\\(?:[^ \t\n]+=[^ \t\n]*[ \t]+\\)*" + "\\)?" + "\\)?" + ;; Group 2: interpreter. + "\\([^ \t\n]+\\)") "Regexp matching interpreters, for file mode determination. This regular expression is matched against the first line of a file to determine the file's mode in `set-auto-mode'. If it matches, the file @@ -3367,7 +3358,6 @@ If FUNCTION is nil, then it is not called. (That is a way of saying (put 'magic-mode-alist 'risky-local-variable t) (defvar magic-fallback-mode-alist - (purecopy `((image-type-auto-detected-p . image-mode) ("\\(PK00\\)?[P]K\003\004" . archive-mode) ; zip ;; The < comes before the groups (but the first) to reduce backtracking. @@ -3389,7 +3379,7 @@ If FUNCTION is nil, then it is not called. (That is a way of saying . sgml-mode) ("\320\317\021\340\241\261\032\341" . doc-view-mode-maybe) ; Word documents 1997-2004 ("%!PS" . ps-mode) - ("# xmcd " . conf-unix-mode))) + ("# xmcd " . conf-unix-mode)) "Like `magic-mode-alist' but has lower priority than `auto-mode-alist'. Each element looks like (REGEXP . FUNCTION) or (MATCH-FUNCTION . FUNCTION). After visiting a file, if REGEXP matches the text at the beginning of the @@ -6195,12 +6185,12 @@ Before and after saving the buffer, this function runs (recursive-edit)) ;; Return nil to ask about BUF again. nil) - ,(purecopy "view this buffer")) + "view this buffer") (?\C-f ,(lambda (buf) (funcall save-some-buffers--switch-window-callback buf) (setq quit-flag t)) - ,(purecopy "view this buffer and quit")) + "view this buffer and quit") (?d ,(lambda (buf) (if (null (buffer-file-name buf)) (message "Not applicable: no file") @@ -6214,7 +6204,7 @@ Before and after saving the buffer, this function runs (recursive-edit)))) ;; Return nil to ask about BUF again. nil) - ,(purecopy "view changes in this buffer"))) + "view changes in this buffer")) "ACTION-ALIST argument used in call to `map-y-or-n-p'.") (put 'save-some-buffers-action-alist 'risky-local-variable t) @@ -7710,14 +7700,12 @@ by `sh' are supported." ;; not its part. Make the regexp say so. (concat "\\`" result "\\'"))) -(defcustom list-directory-brief-switches - (purecopy "-CF") +(defcustom list-directory-brief-switches "-CF" "Switches for `list-directory' to pass to `ls' for brief listing." :type 'string :group 'dired) -(defcustom list-directory-verbose-switches - (purecopy "-l") +(defcustom list-directory-verbose-switches "-l" "Switches for `list-directory' to pass to `ls' for verbose listing." :type 'string :group 'dired) @@ -7972,8 +7960,8 @@ need to be passed verbatim to shell commands." (defcustom insert-directory-program (if (and (memq system-type '(berkeley-unix darwin)) (executable-find "gls")) - (purecopy "gls") - (purecopy "ls")) + "gls" + "ls") "Absolute or relative name of the `ls'-like program. This is used by `insert-directory' and `dired-insert-directory' \(thus, also by `dired'). For Dired, this should ideally point to @@ -8002,7 +7990,7 @@ Return nil if we should prefer `ls-lisp' instead." t) insert-directory-program)) -(defcustom directory-free-space-program (purecopy "df") +(defcustom directory-free-space-program "df" "Program to get the amount of free space on a file system. We assume the output has the format of `df'. The value of this variable must be just a command name or file name; @@ -8016,7 +8004,7 @@ A value of nil disables this feature." "27.1") (defcustom directory-free-space-args - (purecopy (if (eq system-type 'darwin) "-k" "-Pk")) + (if (eq system-type 'darwin) "-k" "-Pk") "Options to use when running `directory-free-space-program'." :type 'string :group 'dired) @@ -8081,11 +8069,11 @@ If DIR's free space cannot be obtained, this function returns nil." ;; parentheses: ;; -rw-r--r-- (modified) 2005-10-22 21:25 files.el ;; This is not supported yet. - (purecopy (concat "\\([0-9][BkKMGTPEZYRQ]? " iso - "\\|.*[0-9][BkKMGTPEZYRQ]? " - "\\(" western "\\|" western-comma - "\\|" DD-MMM-YYYY "\\|" east-asian "\\)" - "\\) +"))) + (concat "\\([0-9][BkKMGTPEZYRQ]? " iso + "\\|.*[0-9][BkKMGTPEZYRQ]? " + "\\(" western "\\|" western-comma + "\\|" DD-MMM-YYYY "\\|" east-asian "\\)" + "\\) +")) "Regular expression to match up to the file name in a directory listing. The default value is designed to recognize dates and times regardless of the language.") @@ -8551,7 +8539,7 @@ arguments as the running Emacs)." ;; so that magic file name handlers will not apply to it. (setq file-name-handler-alist - (cons (cons (purecopy "\\`/:") 'file-name-non-special) + (cons '("\\`/:" . file-name-non-special) file-name-handler-alist)) ;; We depend on being the last handler on the list, From 833037fadd3533a50eb07406f058ee695c72fb9a Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 23 Aug 2024 20:21:41 +0200 Subject: [PATCH 23/57] Don't call purecopy in international/*.el * lisp/international/fontset.el (font-encoding-alist,) (x-pixel-size-width-font-regexp, vertical-centering-font-regexp) (face-font-rescale-alist, standard-fontset-spec): * lisp/international/latexenc.el (latex-inputenc-coding-alist): * lisp/international/mule-cmds.el (help-xref-mule-regexp-template) (set-language-info-internal, set-language-info-alist) (register-input-method, locale-language-names) (locale-charset-language-names, locale-preferred-coding-systems) (define-char-code-property): * lisp/international/mule-conf.el (file-coding-system-alist): * lisp/international/mule-diag.el (sort-listed-character-sets): * lisp/international/mule.el (define-charset, load-with-code-conversion) (put-charset-property, define-coding-system) (ctext-non-standard-encodings-alist) (ctext-non-standard-encodings-regexp, auto-coding-alist) (auto-coding-regexp-alist): * lisp/international/quail.el (quail-keyboard-layout-button): (quail-keyboard-customize-button): Remove calls to purecopy. --- lisp/international/fontset.el | 12 ++- lisp/international/latexenc.el | 3 +- lisp/international/mule-cmds.el | 125 +++++++++++++++----------------- lisp/international/mule-conf.el | 3 +- lisp/international/mule-diag.el | 2 +- lisp/international/mule.el | 33 +++------ lisp/international/quail.el | 4 +- 7 files changed, 76 insertions(+), 106 deletions(-) diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 9743782a672..32234254ebf 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -33,8 +33,6 @@ ;; Setup font-encoding-alist for all known encodings. (setq font-encoding-alist - (mapcar (lambda (arg) - (cons (purecopy (car arg)) (cdr arg))) '(("iso8859-1$" . iso-8859-1) ("iso8859-2$" . iso-8859-2) ("iso8859-3$" . iso-8859-3) @@ -122,7 +120,7 @@ ("mulelao-1" . mule-lao) ("muletibetan-2" . tibetan) ("muletibetan-0" . tibetan) - ("muletibetan-1" . tibetan-1-column)))) + ("muletibetan-1" . tibetan-1-column))) (defvar font-encoding-charset-alist) @@ -1244,17 +1242,17 @@ Internal use only. Should be called at startup time." ;; Setting for suppressing XLoadQueryFont on big fonts. (setq x-pixel-size-width-font-regexp - (purecopy "gb2312\\|gbk\\|gb18030\\|jisx0208\\|ksc5601\\|cns11643\\|big5")) + "gb2312\\|gbk\\|gb18030\\|jisx0208\\|ksc5601\\|cns11643\\|big5") ;; These fonts require vertical centering. (setq vertical-centering-font-regexp - (purecopy "gb2312\\|gbk\\|gb18030\\|jisx0208\\|jisx0212\\|ksc5601\\|cns11643\\|big5")) + "gb2312\\|gbk\\|gb18030\\|jisx0208\\|jisx0212\\|ksc5601\\|cns11643\\|big5") (put 'vertical-centering-font-regexp 'standard-value (list vertical-centering-font-regexp)) ;; CDAC fonts are actually smaller than their design sizes. (setq face-font-rescale-alist - (list (cons (purecopy "-cdac$") 1.3))) + (list '("-cdac$" . 1.3))) (defvar x-font-name-charset-alist nil "This variable has no meaning starting with Emacs 22.1.") @@ -1574,7 +1572,7 @@ It returns a name of the created fontset." ;; specified here because FAMILY of those fonts are not "fixed" in ;; many cases. (defvar standard-fontset-spec - (purecopy "-*-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-standard") + "-*-fixed-medium-r-normal-*-16-*-*-*-*-*-fontset-standard" "String of fontset spec of the standard fontset. You have the biggest chance to display international characters with correct glyphs by using the standard fontset. diff --git a/lisp/international/latexenc.el b/lisp/international/latexenc.el index 6e2306449bc..68941fc2051 100644 --- a/lisp/international/latexenc.el +++ b/lisp/international/latexenc.el @@ -51,7 +51,6 @@ ;;;###autoload (defcustom latex-inputenc-coding-alist - (purecopy '(("ansinew" . windows-1252) ; MS Windows ANSI encoding, extension of Latin-1 ("applemac" . mac-roman) ("ascii" . us-ascii) @@ -74,7 +73,7 @@ ;; ("macce" . undecided) ; Apple Central European ("next" . next) ; The Next encoding ("utf8" . utf-8) - ("utf8x" . utf-8))) ; used by the Unicode LaTeX package + ("utf8x" . utf-8)) ; used by the Unicode LaTeX package "Mapping from LaTeX encodings in \"inputenc.sty\" to Emacs coding systems. LaTeX encodings are specified with \"\\usepackage[encoding]{inputenc}\". Used by the function `latexenc-find-file-coding-system'." diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index ef3622ec3ca..8e6bf25e0b6 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -169,14 +169,14 @@ ;;; Mule related hyperlinks. (defconst help-xref-mule-regexp-template - (purecopy (concat "\\(\\<\\(" - "\\(coding system\\)\\|" - "\\(input method\\)\\|" - "\\(character set\\)\\|" - "\\(charset\\)" - "\\)\\s-+\\)?" - ;; Note starting with word-syntax character: - "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\)['’]"))) + (concat "\\(\\<\\(" + "\\(coding system\\)\\|" + "\\(input method\\)\\|" + "\\(character set\\)\\|" + "\\(charset\\)" + "\\)\\s-+\\)?" + ;; Note starting with word-syntax character: + "['`‘]\\(\\sw\\(\\sw\\|\\s_\\)+\\)['’]")) (defun coding-system-change-eol-conversion (coding-system eol-type) "Return a coding system which differs from CODING-SYSTEM in EOL conversion. @@ -1201,7 +1201,7 @@ Arguments are the same as `set-language-info'." (progn (setq key-slot (list key)) (setcdr lang-slot (cons key-slot (cdr lang-slot))))) - (setcdr key-slot (purecopy info)) + (setcdr key-slot info) ;; Update the custom-type of `current-language-environment'. (put 'current-language-environment 'custom-type (cons 'choice (mapcar @@ -1229,10 +1229,8 @@ where to put this language environment in the Describe Language Environment and Set Language Environment menus. For example, (\"European\") means to put this language environment in the European submenu in each of those two menus." - (cond ((symbolp lang-env) - (setq lang-env (symbol-name lang-env))) - ((stringp lang-env) - (setq lang-env (purecopy lang-env)))) + (when (symbolp lang-env) + (setq lang-env (symbol-name lang-env))) (if parents (while parents (let (describe-map setup-map parent-symbol parent prompt) @@ -1439,13 +1437,11 @@ The commands `describe-input-method' and `list-input-methods' need these duplicated values to show some information about input methods without loading the relevant Quail packages. \n(fn INPUT-METHOD LANG-ENV ACTIVATE-FUNC TITLE DESCRIPTION &rest ARGS)" - (setq lang-env (if (symbolp lang-env) - (symbol-name lang-env) - (purecopy lang-env))) - (setq input-method (if (symbolp input-method) - (symbol-name input-method) - (purecopy input-method))) - (setq args (mapcar #'purecopy args)) + + (when (symbolp lang-env) + (setq lang-env (symbol-name lang-env))) + (when (symbolp input-method) + (setq input-method (symbol-name input-method))) (let ((info (cons lang-env args)) (slot (assoc input-method input-method-alist))) (if slot @@ -2252,12 +2248,8 @@ See `set-language-info-alist' for use in programs." (defvar locale-translation-file-name nil "File name for the system's file of locale-name aliases, or nil if none.") -;; The following definitions might as well be marked as constants and -;; purecopied, since they're normally used on startup, and probably -;; should reflect the facilities of the base Emacs. (defconst locale-language-names - (purecopy - '( + '( ;; Locale names of the form LANGUAGE[_TERRITORY][.CODESET][@MODIFIER] ;; as specified in the Single Unix Spec, Version 2. ;; LANGUAGE is a language code taken from ISO 639:1988 (E/F) @@ -2515,7 +2507,7 @@ See `set-language-info-alist' for use in programs." ; mwk MS-Windows Mohawk (Canada) ("uig" . "UTF-8") ; MS-Windows Uighur ("kin" . "UTF-8") ; MS-Windows Kinyarwanda - )) + ) "Alist of locale regexps vs the corresponding languages and coding systems. Each element has this form: (LOCALE-REGEXP LANG-ENV CODING-SYSTEM) @@ -2528,18 +2520,17 @@ In this case, LANG-ENV is one of generic language environments for an specific encoding such as \"Latin-1\" and \"UTF-8\".") (defconst locale-charset-language-names - (purecopy - '((".*8859[-_]?1\\>" . "Latin-1") - (".*8859[-_]?2\\>" . "Latin-2") - (".*8859[-_]?3\\>" . "Latin-3") - (".*8859[-_]?4\\>" . "Latin-4") - (".*8859[-_]?9\\>" . "Latin-5") - (".*8859[-_]?14\\>" . "Latin-8") - (".*8859[-_]?15\\>" . "Latin-9") - (".*utf\\(?:-?8\\)?\\>" . "UTF-8") - ;; utf-8@euro exists, so put this last. (@euro really specifies - ;; the currency, rather than the charset.) - (".*@euro\\>" . "Latin-9"))) + '((".*8859[-_]?1\\>" . "Latin-1") + (".*8859[-_]?2\\>" . "Latin-2") + (".*8859[-_]?3\\>" . "Latin-3") + (".*8859[-_]?4\\>" . "Latin-4") + (".*8859[-_]?9\\>" . "Latin-5") + (".*8859[-_]?14\\>" . "Latin-8") + (".*8859[-_]?15\\>" . "Latin-9") + (".*utf\\(?:-?8\\)?\\>" . "UTF-8") + ;; utf-8@euro exists, so put this last. (@euro really specifies + ;; the currency, rather than the charset.) + (".*@euro\\>" . "Latin-9")) "List of pairs of locale regexps and charset language names. The first element whose locale regexp matches the start of a downcased locale specifies the language name whose charset corresponds to that locale. @@ -2547,34 +2538,33 @@ This language name is used if the locale is not listed in `locale-language-names'.") (defconst locale-preferred-coding-systems - (purecopy - '((".*8859[-_]?1\\>" . iso-8859-1) - (".*8859[-_]?2\\>" . iso-8859-2) - (".*8859[-_]?3\\>" . iso-8859-3) - (".*8859[-_]?4\\>" . iso-8859-4) - (".*8859[-_]?9\\>" . iso-8859-9) - (".*8859[-_]?14\\>" . iso-8859-14) - (".*8859[-_]?15\\>" . iso-8859-15) - (".*utf\\(?:-?8\\)?" . utf-8) - ;; utf-8@euro exists, so put this after utf-8. (@euro really - ;; specifies the currency, rather than the charset.) - (".*@euro" . iso-8859-15) - ("koi8-?r" . koi8-r) - ("koi8-?u" . koi8-u) - ("tcvn" . tcvn) - ("big5[-_]?hkscs" . big5-hkscs) - ("big5" . big5) - ("euc-?tw" . euc-tw) - ("euc-?cn" . euc-cn) - ("gb2312" . gb2312) - ("gbk" . gbk) - ("gb18030" . gb18030) - ("ja.*[._]euc" . japanese-iso-8bit) - ("ja.*[._]jis7" . iso-2022-jp) - ("ja.*[._]pck" . japanese-shift-jis) - ("ja.*[._]sjis" . japanese-shift-jis) - ("jpn" . japanese-shift-jis) ; MS-Windows uses this. - )) + '((".*8859[-_]?1\\>" . iso-8859-1) + (".*8859[-_]?2\\>" . iso-8859-2) + (".*8859[-_]?3\\>" . iso-8859-3) + (".*8859[-_]?4\\>" . iso-8859-4) + (".*8859[-_]?9\\>" . iso-8859-9) + (".*8859[-_]?14\\>" . iso-8859-14) + (".*8859[-_]?15\\>" . iso-8859-15) + (".*utf\\(?:-?8\\)?" . utf-8) + ;; utf-8@euro exists, so put this after utf-8. (@euro really + ;; specifies the currency, rather than the charset.) + (".*@euro" . iso-8859-15) + ("koi8-?r" . koi8-r) + ("koi8-?u" . koi8-u) + ("tcvn" . tcvn) + ("big5[-_]?hkscs" . big5-hkscs) + ("big5" . big5) + ("euc-?tw" . euc-tw) + ("euc-?cn" . euc-cn) + ("gb2312" . gb2312) + ("gbk" . gbk) + ("gb18030" . gb18030) + ("ja.*[._]euc" . japanese-iso-8bit) + ("ja.*[._]jis7" . iso-2022-jp) + ("ja.*[._]pck" . japanese-shift-jis) + ("ja.*[._]sjis" . japanese-shift-jis) + ("jpn" . japanese-shift-jis) ; MS-Windows uses this. + ) "List of pairs of locale regexps and preferred coding systems. The first element whose locale regexp matches the start of a downcased locale specifies the coding system to prefer when using that locale. @@ -2965,7 +2955,6 @@ See also the documentation of `get-char-code-property' and (error "Invalid char-table: %s" table)) (or (stringp table) (error "Not a char-table nor a file name: %s" table))) - (if (stringp table) (setq table (purecopy table))) (if (and (stringp table) (char-table-p (alist-get name char-code-property-alist))) ;; The table is already setup and we're apparently trying to @@ -2973,7 +2962,7 @@ See also the documentation of `get-char-code-property' and ;; Just skip it, in order to work around a recursive load (bug#52945). nil (setf (alist-get name char-code-property-alist) table) - (put name 'char-code-property-documentation (purecopy docstring)))) + (put name 'char-code-property-documentation docstring))) (defvar char-code-property-table (make-char-table 'char-code-property-table) diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index a448aa494bc..a94bc57d8d3 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -1633,7 +1633,6 @@ for decoding and encoding files, process I/O, etc." ;; Tar files are not decoded at all, but we treat them as raw bytes. (setq file-coding-system-alist - (mapcar (lambda (arg) (cons (purecopy (car arg)) (cdr arg))) '(("\\.elc\\'" . utf-8-emacs) ("\\.el\\'" . prefer-utf-8) ("\\.utf\\(-8\\)?\\'" . utf-8) @@ -1647,7 +1646,7 @@ for decoding and encoding files, process I/O, etc." ("\\.tar\\'" . (no-conversion . no-conversion)) ( "\\.po[tx]?\\'\\|\\.po\\." . po-find-file-coding-system) ("\\.\\(tex\\|ltx\\|dtx\\|drv\\)\\'" . latexenc-find-file-coding-system) - ("" . (undecided . nil))))) + ("" . (undecided . nil)))) ;;; Setting coding categories and their priorities. diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index e8556119995..ac23a88cea0 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -43,7 +43,7 @@ ;;; CHARSET (define-button-type 'sort-listed-character-sets - 'help-echo (purecopy "mouse-2, RET: sort on this column") + 'help-echo "mouse-2, RET: sort on this column" 'face 'bold 'action (lambda (button) (sort-listed-character-sets (button-get button 'sort-key)))) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index ed74fdae755..b2d3de3f913 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -265,7 +265,7 @@ attribute." (aset emacs-mule-charset-table emacs-mule-id name))) (dolist (slot attrs) - (setcdr slot (purecopy (plist-get props (car slot))))) + (setcdr slot (plist-get props (car slot)))) ;; Make sure that the value of :code-space is a vector of 8 ;; elements. @@ -278,19 +278,12 @@ attribute." ;; Add :name and :docstring properties to PROPS. (setq props - (cons :name (cons name (cons :docstring (cons (purecopy docstring) props))))) + (cons :name (cons name (cons :docstring (cons docstring props))))) (or (plist-get props :short-name) (plist-put props :short-name (symbol-name name))) (or (plist-get props :long-name) (plist-put props :long-name (plist-get props :short-name))) (plist-put props :base name) - ;; We can probably get a worthwhile amount in purespace. - (setq props - (mapcar (lambda (elt) - (if (stringp elt) - (purecopy elt) - elt)) - props)) (setcdr (assq :plist attrs) props) (apply 'define-charset-internal name (mapcar 'cdr attrs)))) @@ -326,7 +319,7 @@ Return t if file exists." (message "Loading %s (source)..." file) (message "Loading %s..." file))) (when purify-flag - (push (purecopy file) preloaded-file-list)) + (push file preloaded-file-list)) (unwind-protect (let ((load-true-file-name fullname) (load-file-name fullname) @@ -440,10 +433,7 @@ This is the last value stored with "Set CHARSETS's PROPNAME property to value VALUE. It can be retrieved with `(get-charset-property CHARSET PROPNAME)'." (set-charset-plist charset - (plist-put (charset-plist charset) propname - (if (stringp value) - (purecopy value) - value)))) + (plist-put (charset-plist charset) propname value))) (defun charset-description (charset) "Return description string of CHARSET." @@ -984,8 +974,7 @@ non-ASCII files. This attribute is meaningful only when ;; Add :name and :docstring properties to PROPS. (setq props - (cons :name (cons name (cons :docstring (cons (purecopy docstring) - props))))) + (cons :name (cons name (cons :docstring (cons docstring props))))) (setcdr (assq :plist common-attrs) props) (apply #'define-coding-system-internal name (mapcar #'cdr (append common-attrs spec-attrs))))) @@ -1529,13 +1518,12 @@ This setting is effective for the next communication only." ;;; X selections (defvar ctext-non-standard-encodings-alist - (mapcar 'purecopy '(("big5-0" big5 2 big5) ("ISO8859-14" iso-8859-14 1 latin-iso8859-14) ("ISO8859-15" iso-8859-15 1 latin-iso8859-15) ("gbk-0" gbk 2 chinese-gbk) ("koi8-r" koi8-r 1 koi8-r) - ("microsoft-cp1251" windows-1251 1 windows-1251))) + ("microsoft-cp1251" windows-1251 1 windows-1251)) "Alist of non-standard encoding names vs the corresponding usages in CTEXT. It controls how extended segments of a compound text are handled @@ -1568,14 +1556,13 @@ Each element must be one of the names listed in the variable `ctext-non-standard-encodings-alist' (which see).") (defvar ctext-non-standard-encodings-regexp - (purecopy (string-to-multibyte (concat ;; For non-standard encodings. "\\(\e%/[0-4][\200-\377][\200-\377]\\([^\002]+\\)\002\\)" "\\|" ;; For UTF-8 encoding. - "\\(\e%G[^\e]*\e%@\\)")))) + "\\(\e%G[^\e]*\e%@\\)"))) ;; Functions to support "Non-Standard Character Set Encodings" defined ;; by the COMPOUND-TEXT spec. They also support "The UTF-8 encoding" @@ -1746,7 +1733,6 @@ in-place." (defcustom auto-coding-alist ;; .exe and .EXE are added to support archive-mode looking at DOS ;; self-extracting exe archives. - (mapcar (lambda (arg) (cons (purecopy (car arg)) (cdr arg))) '(("\\.\\(\ arc\\|zip\\|lzh\\|lha\\|zoo\\|[jew]ar\\|xpi\\|rar\\|7z\\|squashfs\\|\ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\|SQUASHFS\\)\\'" @@ -1756,7 +1742,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|7Z\\|SQUASHFS\\)\\'" ("\\.\\(gz\\|Z\\|bz\\|bz2\\|xz\\|gpg\\)\\'" . no-conversion) ("\\.\\(jpe?g\\|png\\|gif\\|tiff?\\|p[bpgn]m\\)\\'" . no-conversion) ("\\.pdf\\'" . no-conversion) - ("/#[^/]+#\\'" . utf-8-emacs-unix))) + ("/#[^/]+#\\'" . utf-8-emacs-unix)) "Alist of filename patterns vs corresponding coding systems. Each element looks like (REGEXP . CODING-SYSTEM). A file whose name matches REGEXP is decoded by CODING-SYSTEM on reading. @@ -1771,12 +1757,11 @@ and the contents of `file-coding-system-alist'." (symbol :tag "Coding system")))) (defcustom auto-coding-regexp-alist - (mapcar (lambda (arg) (cons (purecopy (car arg)) (cdr arg))) '(("\\`BABYL OPTIONS:[ \t]*-\\*-[ \t]*rmail[ \t]*-\\*-" . no-conversion) ("\\`\xFE\xFF" . utf-16be-with-signature) ("\\`\xFF\xFE" . utf-16le-with-signature) ("\\`\xEF\xBB\xBF" . utf-8-with-signature) - ("\\`;ELC\024\0\0\0" . emacs-mule))) ; Emacs 20-compiled + ("\\`;ELC\024\0\0\0" . emacs-mule)) ; Emacs 20-compiled "Alist of patterns vs corresponding coding systems. Each element looks like (REGEXP . CODING-SYSTEM). A file whose first bytes match REGEXP is decoded by CODING-SYSTEM on reading. diff --git a/lisp/international/quail.el b/lisp/international/quail.el index cb7aa89b252..fc17bb979a6 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -2494,11 +2494,11 @@ should be made by `quail-build-decode-map' (which see)." (help-setup-xref `(quail-keyboard-layout-button ,layout) nil) (quail-show-keyboard-layout layout)) - 'help-echo (purecopy "mouse-2, RET: show keyboard layout")) + 'help-echo "mouse-2, RET: show keyboard layout") (define-button-type 'quail-keyboard-customize-button :supertype 'help-customize-variable - 'help-echo (purecopy "mouse-2, RET: customize keyboard layout")) + 'help-echo "mouse-2, RET: customize keyboard layout") (defun quail-help (&optional package) "Show brief description of the current Quail package. From d121953b971f2bee5d75e37355fd2bd5e1d12784 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Fri, 23 Aug 2024 20:24:01 +0200 Subject: [PATCH 24/57] Don't call purecopy in common-win.el * lisp/term/common-win.el: Remove calls to purecopy. --- lisp/term/common-win.el | 323 ++++++++++++++++++++-------------------- 1 file changed, 161 insertions(+), 162 deletions(-) diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el index 68c3b2d56e3..099ae0ab49f 100644 --- a/lisp/term/common-win.el +++ b/lisp/term/common-win.el @@ -222,168 +222,167 @@ have been processed." (defvar x-colors (if (featurep 'ns) (ns-list-colors) - (purecopy - '("gray100" "grey100" "gray99" "grey99" "gray98" "grey98" "gray97" - "grey97" "gray96" "grey96" "gray95" "grey95" "gray94" "grey94" - "gray93" "grey93" "gray92" "grey92" "gray91" "grey91" "gray90" - "grey90" "gray89" "grey89" "gray88" "grey88" "gray87" "grey87" - "gray86" "grey86" "gray85" "grey85" "gray84" "grey84" "gray83" - "grey83" "gray82" "grey82" "gray81" "grey81" "gray80" "grey80" - "gray79" "grey79" "gray78" "grey78" "gray77" "grey77" "gray76" - "grey76" "gray75" "grey75" "gray74" "grey74" "gray73" "grey73" - "gray72" "grey72" "gray71" "grey71" "gray70" "grey70" "gray69" - "grey69" "gray68" "grey68" "gray67" "grey67" "gray66" "grey66" - "gray65" "grey65" "gray64" "grey64" "gray63" "grey63" "gray62" - "grey62" "gray61" "grey61" "gray60" "grey60" "gray59" "grey59" - "gray58" "grey58" "gray57" "grey57" "gray56" "grey56" "gray55" - "grey55" "gray54" "grey54" "gray53" "grey53" "gray52" "grey52" - "gray51" "grey51" "gray50" "grey50" "gray49" "grey49" "gray48" - "grey48" "gray47" "grey47" "gray46" "grey46" "gray45" "grey45" - "gray44" "grey44" "gray43" "grey43" "gray42" "grey42" "gray41" - "grey41" "gray40" "grey40" "gray39" "grey39" "gray38" "grey38" - "gray37" "grey37" "gray36" "grey36" "gray35" "grey35" "gray34" - "grey34" "gray33" "grey33" "gray32" "grey32" "gray31" "grey31" - "gray30" "grey30" "gray29" "grey29" "gray28" "grey28" "gray27" - "grey27" "gray26" "grey26" "gray25" "grey25" "gray24" "grey24" - "gray23" "grey23" "gray22" "grey22" "gray21" "grey21" "gray20" - "grey20" "gray19" "grey19" "gray18" "grey18" "gray17" "grey17" - "gray16" "grey16" "gray15" "grey15" "gray14" "grey14" "gray13" - "grey13" "gray12" "grey12" "gray11" "grey11" "gray10" "grey10" - "gray9" "grey9" "gray8" "grey8" "gray7" "grey7" "gray6" "grey6" - "gray5" "grey5" "gray4" "grey4" "gray3" "grey3" "gray2" "grey2" - "gray1" "grey1" "gray0" "grey0" - "LightPink1" "LightPink2" "LightPink3" "LightPink4" - "pink1" "pink2" "pink3" "pink4" - "PaleVioletRed1" "PaleVioletRed2" "PaleVioletRed3" "PaleVioletRed4" - "LavenderBlush1" "LavenderBlush2" "LavenderBlush3" "LavenderBlush4" - "VioletRed1" "VioletRed2" "VioletRed3" "VioletRed4" - "HotPink1" "HotPink2" "HotPink3" "HotPink4" - "DeepPink1" "DeepPink2" "DeepPink3" "DeepPink4" - "maroon1" "maroon2" "maroon3" "maroon4" - "orchid1" "orchid2" "orchid3" "orchid4" - "plum1" "plum2" "plum3" "plum4" - "thistle1" "thistle2" "thistle3" "thistle4" - "MediumOrchid1" "MediumOrchid2" "MediumOrchid3" "MediumOrchid4" - "DarkOrchid1" "DarkOrchid2" "DarkOrchid3" "DarkOrchid4" - "purple1" "purple2" "purple3" "purple4" - "MediumPurple1" "MediumPurple2" "MediumPurple3" "MediumPurple4" - "SlateBlue1" "SlateBlue2" "SlateBlue3" "SlateBlue4" - "RoyalBlue1" "RoyalBlue2" "RoyalBlue3" "RoyalBlue4" - "LightSteelBlue1" "LightSteelBlue2" "LightSteelBlue3" "LightSteelBlue4" - "SlateGray1" "SlateGray2" "SlateGray3" "SlateGray4" - "DodgerBlue1" "DodgerBlue2" "DodgerBlue3" "DodgerBlue4" - "SteelBlue1" "SteelBlue2" "SteelBlue3" "SteelBlue4" - "SkyBlue1" "SkyBlue2" "SkyBlue3" "SkyBlue4" - "LightSkyBlue1" "LightSkyBlue2" "LightSkyBlue3" "LightSkyBlue4" - "LightBlue1" "LightBlue2" "LightBlue3" "LightBlue4" - "CadetBlue1" "CadetBlue2" "CadetBlue3" "CadetBlue4" - "azure1" "azure2" "azure3" "azure4" - "LightCyan1" "LightCyan2" "LightCyan3" "LightCyan4" - "PaleTurquoise1" "PaleTurquoise2" "PaleTurquoise3" "PaleTurquoise4" - "DarkSlateGray1" "DarkSlateGray2" "DarkSlateGray3" "DarkSlateGray4" - "aquamarine1" "aquamarine2" "aquamarine3" "aquamarine4" - "SeaGreen1" "SeaGreen2" "SeaGreen3" "SeaGreen4" - "honeydew1" "honeydew2" "honeydew3" "honeydew4" - "DarkSeaGreen1" "DarkSeaGreen2" "DarkSeaGreen3" "DarkSeaGreen4" - "PaleGreen1" "PaleGreen2" "PaleGreen3" "PaleGreen4" - "DarkOliveGreen1" "DarkOliveGreen2" "DarkOliveGreen3" "DarkOliveGreen4" - "OliveDrab1" "OliveDrab2" "OliveDrab3" "OliveDrab4" - "ivory1" "ivory2" "ivory3" "ivory4" - "LightYellow1" "LightYellow2" "LightYellow3" "LightYellow4" - "khaki1" "khaki2" "khaki3" "khaki4" - "LemonChiffon1" "LemonChiffon2" "LemonChiffon3" "LemonChiffon4" - "LightGoldenrod1" "LightGoldenrod2" "LightGoldenrod3" "LightGoldenrod4" - "cornsilk1" "cornsilk2" "cornsilk3" "cornsilk4" - "goldenrod1" "goldenrod2" "goldenrod3" "goldenrod4" - "DarkGoldenrod1" "DarkGoldenrod2" "DarkGoldenrod3" "DarkGoldenrod4" - "wheat1" "wheat2" "wheat3" "wheat4" - "NavajoWhite1" "NavajoWhite2" "NavajoWhite3" "NavajoWhite4" - "burlywood1" "burlywood2" "burlywood3" "burlywood4" - "AntiqueWhite1" "AntiqueWhite2" "AntiqueWhite3" "AntiqueWhite4" - "bisque1" "bisque2" "bisque3" "bisque4" - "tan1" "tan2" "tan3" "tan4" - "PeachPuff1" "PeachPuff2" "PeachPuff3" "PeachPuff4" - "seashell1" "seashell2" "seashell3" "seashell4" - "chocolate1" "chocolate2" "chocolate3" "chocolate4" - "sienna1" "sienna2" "sienna3" "sienna4" - "LightSalmon1" "LightSalmon2" "LightSalmon3" "LightSalmon4" - "salmon1" "salmon2" "salmon3" "salmon4" - "coral1" "coral2" "coral3" "coral4" - "tomato1" "tomato2" "tomato3" "tomato4" - "MistyRose1" "MistyRose2" "MistyRose3" "MistyRose4" - "snow1" "snow2" "snow3" "snow4" - "RosyBrown1" "RosyBrown2" "RosyBrown3" "RosyBrown4" - "IndianRed1" "IndianRed2" "IndianRed3" "IndianRed4" - "firebrick1" "firebrick2" "firebrick3" "firebrick4" - "brown1" "brown2" "brown3" "brown4" - "magenta1" "magenta2" "magenta3" "magenta4" - "blue1" "blue2" "blue3" "blue4" - "DeepSkyBlue1" "DeepSkyBlue2" "DeepSkyBlue3" "DeepSkyBlue4" - "turquoise1" "turquoise2" "turquoise3" "turquoise4" - "cyan1" "cyan2" "cyan3" "cyan4" - "SpringGreen1" "SpringGreen2" "SpringGreen3" "SpringGreen4" - "green1" "green2" "green3" "green4" - "chartreuse1" "chartreuse2" "chartreuse3" "chartreuse4" - "yellow1" "yellow2" "yellow3" "yellow4" - "gold1" "gold2" "gold3" "gold4" - "orange1" "orange2" "orange3" "orange4" - "DarkOrange1" "DarkOrange2" "DarkOrange3" "DarkOrange4" - "OrangeRed1" "OrangeRed2" "OrangeRed3" "OrangeRed4" - "red1" "red2" "red3" "red4" - "lavender blush" "LavenderBlush" "ghost white" "GhostWhite" - "lavender" "alice blue" "AliceBlue" "azure" "light cyan" - "LightCyan" "mint cream" "MintCream" "honeydew" "ivory" - "light goldenrod yellow" "LightGoldenrodYellow" "light yellow" - "LightYellow" "beige" "floral white" "FloralWhite" "old lace" - "OldLace" "blanched almond" "BlanchedAlmond" "moccasin" - "papaya whip" "PapayaWhip" "bisque" "antique white" - "AntiqueWhite" "linen" "peach puff" "PeachPuff" "seashell" - "misty rose" "MistyRose" "snow" "light pink" "LightPink" "pink" - "hot pink" "HotPink" "deep pink" "DeepPink" "maroon" - "pale violet red" "PaleVioletRed" "violet red" "VioletRed" - "medium violet red" "MediumVioletRed" "violet" "plum" "thistle" - "orchid" "medium orchid" "MediumOrchid" "dark orchid" - "DarkOrchid" "purple" "blue violet" "BlueViolet" "medium purple" - "MediumPurple" "light slate blue" "LightSlateBlue" - "medium slate blue" "MediumSlateBlue" "slate blue" "SlateBlue" - "dark slate blue" "DarkSlateBlue" "midnight blue" "MidnightBlue" - "navy" "navy blue" "NavyBlue" "dark blue" "DarkBlue" - "light steel blue" "LightSteelBlue" "cornflower blue" - "CornflowerBlue" "dodger blue" "DodgerBlue" "royal blue" - "RoyalBlue" "light slate gray" "light slate grey" - "LightSlateGray" "LightSlateGrey" "slate gray" "slate grey" - "SlateGray" "SlateGrey" "dark slate gray" "dark slate grey" - "DarkSlateGray" "DarkSlateGrey" "steel blue" "SteelBlue" - "cadet blue" "CadetBlue" "light sky blue" "LightSkyBlue" - "sky blue" "SkyBlue" "light blue" "LightBlue" "powder blue" - "PowderBlue" "pale turquoise" "PaleTurquoise" "turquoise" - "medium turquoise" "MediumTurquoise" "dark turquoise" - "DarkTurquoise" "dark cyan" "DarkCyan" "aquamarine" - "medium aquamarine" "MediumAquamarine" "light sea green" - "LightSeaGreen" "medium sea green" "MediumSeaGreen" "sea green" - "SeaGreen" "dark sea green" "DarkSeaGreen" "pale green" - "PaleGreen" "lime green" "LimeGreen" "dark green" "DarkGreen" - "forest green" "ForestGreen" "light green" "LightGreen" - "green yellow" "GreenYellow" "yellow green" "YellowGreen" - "olive drab" "OliveDrab" "dark olive green" "DarkOliveGreen" - "lemon chiffon" "LemonChiffon" "khaki" "dark khaki" "DarkKhaki" - "cornsilk" "pale goldenrod" "PaleGoldenrod" "light goldenrod" - "LightGoldenrod" "goldenrod" "dark goldenrod" "DarkGoldenrod" - "wheat" "navajo white" "NavajoWhite" "tan" "burlywood" - "sandy brown" "SandyBrown" "peru" "chocolate" "saddle brown" - "SaddleBrown" "sienna" "rosy brown" "RosyBrown" "dark salmon" - "DarkSalmon" "coral" "tomato" "light salmon" "LightSalmon" - "salmon" "light coral" "LightCoral" "indian red" "IndianRed" - "firebrick" "brown" "dark red" "DarkRed" "magenta" - "dark magenta" "DarkMagenta" "dark violet" "DarkViolet" - "medium blue" "MediumBlue" "blue" "deep sky blue" "DeepSkyBlue" - "cyan" "medium spring green" "MediumSpringGreen" "spring green" - "SpringGreen" "green" "lawn green" "LawnGreen" "chartreuse" - "yellow" "gold" "orange" "dark orange" "DarkOrange" "orange red" - "OrangeRed" "red" "white" "white smoke" "WhiteSmoke" "gainsboro" - "light gray" "light grey" "LightGray" "LightGrey" "gray" "grey" - "dark gray" "dark grey" "DarkGray" "DarkGrey" "dim gray" - "dim grey" "DimGray" "DimGrey" "black"))) + '("gray100" "grey100" "gray99" "grey99" "gray98" "grey98" "gray97" + "grey97" "gray96" "grey96" "gray95" "grey95" "gray94" "grey94" + "gray93" "grey93" "gray92" "grey92" "gray91" "grey91" "gray90" + "grey90" "gray89" "grey89" "gray88" "grey88" "gray87" "grey87" + "gray86" "grey86" "gray85" "grey85" "gray84" "grey84" "gray83" + "grey83" "gray82" "grey82" "gray81" "grey81" "gray80" "grey80" + "gray79" "grey79" "gray78" "grey78" "gray77" "grey77" "gray76" + "grey76" "gray75" "grey75" "gray74" "grey74" "gray73" "grey73" + "gray72" "grey72" "gray71" "grey71" "gray70" "grey70" "gray69" + "grey69" "gray68" "grey68" "gray67" "grey67" "gray66" "grey66" + "gray65" "grey65" "gray64" "grey64" "gray63" "grey63" "gray62" + "grey62" "gray61" "grey61" "gray60" "grey60" "gray59" "grey59" + "gray58" "grey58" "gray57" "grey57" "gray56" "grey56" "gray55" + "grey55" "gray54" "grey54" "gray53" "grey53" "gray52" "grey52" + "gray51" "grey51" "gray50" "grey50" "gray49" "grey49" "gray48" + "grey48" "gray47" "grey47" "gray46" "grey46" "gray45" "grey45" + "gray44" "grey44" "gray43" "grey43" "gray42" "grey42" "gray41" + "grey41" "gray40" "grey40" "gray39" "grey39" "gray38" "grey38" + "gray37" "grey37" "gray36" "grey36" "gray35" "grey35" "gray34" + "grey34" "gray33" "grey33" "gray32" "grey32" "gray31" "grey31" + "gray30" "grey30" "gray29" "grey29" "gray28" "grey28" "gray27" + "grey27" "gray26" "grey26" "gray25" "grey25" "gray24" "grey24" + "gray23" "grey23" "gray22" "grey22" "gray21" "grey21" "gray20" + "grey20" "gray19" "grey19" "gray18" "grey18" "gray17" "grey17" + "gray16" "grey16" "gray15" "grey15" "gray14" "grey14" "gray13" + "grey13" "gray12" "grey12" "gray11" "grey11" "gray10" "grey10" + "gray9" "grey9" "gray8" "grey8" "gray7" "grey7" "gray6" "grey6" + "gray5" "grey5" "gray4" "grey4" "gray3" "grey3" "gray2" "grey2" + "gray1" "grey1" "gray0" "grey0" + "LightPink1" "LightPink2" "LightPink3" "LightPink4" + "pink1" "pink2" "pink3" "pink4" + "PaleVioletRed1" "PaleVioletRed2" "PaleVioletRed3" "PaleVioletRed4" + "LavenderBlush1" "LavenderBlush2" "LavenderBlush3" "LavenderBlush4" + "VioletRed1" "VioletRed2" "VioletRed3" "VioletRed4" + "HotPink1" "HotPink2" "HotPink3" "HotPink4" + "DeepPink1" "DeepPink2" "DeepPink3" "DeepPink4" + "maroon1" "maroon2" "maroon3" "maroon4" + "orchid1" "orchid2" "orchid3" "orchid4" + "plum1" "plum2" "plum3" "plum4" + "thistle1" "thistle2" "thistle3" "thistle4" + "MediumOrchid1" "MediumOrchid2" "MediumOrchid3" "MediumOrchid4" + "DarkOrchid1" "DarkOrchid2" "DarkOrchid3" "DarkOrchid4" + "purple1" "purple2" "purple3" "purple4" + "MediumPurple1" "MediumPurple2" "MediumPurple3" "MediumPurple4" + "SlateBlue1" "SlateBlue2" "SlateBlue3" "SlateBlue4" + "RoyalBlue1" "RoyalBlue2" "RoyalBlue3" "RoyalBlue4" + "LightSteelBlue1" "LightSteelBlue2" "LightSteelBlue3" "LightSteelBlue4" + "SlateGray1" "SlateGray2" "SlateGray3" "SlateGray4" + "DodgerBlue1" "DodgerBlue2" "DodgerBlue3" "DodgerBlue4" + "SteelBlue1" "SteelBlue2" "SteelBlue3" "SteelBlue4" + "SkyBlue1" "SkyBlue2" "SkyBlue3" "SkyBlue4" + "LightSkyBlue1" "LightSkyBlue2" "LightSkyBlue3" "LightSkyBlue4" + "LightBlue1" "LightBlue2" "LightBlue3" "LightBlue4" + "CadetBlue1" "CadetBlue2" "CadetBlue3" "CadetBlue4" + "azure1" "azure2" "azure3" "azure4" + "LightCyan1" "LightCyan2" "LightCyan3" "LightCyan4" + "PaleTurquoise1" "PaleTurquoise2" "PaleTurquoise3" "PaleTurquoise4" + "DarkSlateGray1" "DarkSlateGray2" "DarkSlateGray3" "DarkSlateGray4" + "aquamarine1" "aquamarine2" "aquamarine3" "aquamarine4" + "SeaGreen1" "SeaGreen2" "SeaGreen3" "SeaGreen4" + "honeydew1" "honeydew2" "honeydew3" "honeydew4" + "DarkSeaGreen1" "DarkSeaGreen2" "DarkSeaGreen3" "DarkSeaGreen4" + "PaleGreen1" "PaleGreen2" "PaleGreen3" "PaleGreen4" + "DarkOliveGreen1" "DarkOliveGreen2" "DarkOliveGreen3" "DarkOliveGreen4" + "OliveDrab1" "OliveDrab2" "OliveDrab3" "OliveDrab4" + "ivory1" "ivory2" "ivory3" "ivory4" + "LightYellow1" "LightYellow2" "LightYellow3" "LightYellow4" + "khaki1" "khaki2" "khaki3" "khaki4" + "LemonChiffon1" "LemonChiffon2" "LemonChiffon3" "LemonChiffon4" + "LightGoldenrod1" "LightGoldenrod2" "LightGoldenrod3" "LightGoldenrod4" + "cornsilk1" "cornsilk2" "cornsilk3" "cornsilk4" + "goldenrod1" "goldenrod2" "goldenrod3" "goldenrod4" + "DarkGoldenrod1" "DarkGoldenrod2" "DarkGoldenrod3" "DarkGoldenrod4" + "wheat1" "wheat2" "wheat3" "wheat4" + "NavajoWhite1" "NavajoWhite2" "NavajoWhite3" "NavajoWhite4" + "burlywood1" "burlywood2" "burlywood3" "burlywood4" + "AntiqueWhite1" "AntiqueWhite2" "AntiqueWhite3" "AntiqueWhite4" + "bisque1" "bisque2" "bisque3" "bisque4" + "tan1" "tan2" "tan3" "tan4" + "PeachPuff1" "PeachPuff2" "PeachPuff3" "PeachPuff4" + "seashell1" "seashell2" "seashell3" "seashell4" + "chocolate1" "chocolate2" "chocolate3" "chocolate4" + "sienna1" "sienna2" "sienna3" "sienna4" + "LightSalmon1" "LightSalmon2" "LightSalmon3" "LightSalmon4" + "salmon1" "salmon2" "salmon3" "salmon4" + "coral1" "coral2" "coral3" "coral4" + "tomato1" "tomato2" "tomato3" "tomato4" + "MistyRose1" "MistyRose2" "MistyRose3" "MistyRose4" + "snow1" "snow2" "snow3" "snow4" + "RosyBrown1" "RosyBrown2" "RosyBrown3" "RosyBrown4" + "IndianRed1" "IndianRed2" "IndianRed3" "IndianRed4" + "firebrick1" "firebrick2" "firebrick3" "firebrick4" + "brown1" "brown2" "brown3" "brown4" + "magenta1" "magenta2" "magenta3" "magenta4" + "blue1" "blue2" "blue3" "blue4" + "DeepSkyBlue1" "DeepSkyBlue2" "DeepSkyBlue3" "DeepSkyBlue4" + "turquoise1" "turquoise2" "turquoise3" "turquoise4" + "cyan1" "cyan2" "cyan3" "cyan4" + "SpringGreen1" "SpringGreen2" "SpringGreen3" "SpringGreen4" + "green1" "green2" "green3" "green4" + "chartreuse1" "chartreuse2" "chartreuse3" "chartreuse4" + "yellow1" "yellow2" "yellow3" "yellow4" + "gold1" "gold2" "gold3" "gold4" + "orange1" "orange2" "orange3" "orange4" + "DarkOrange1" "DarkOrange2" "DarkOrange3" "DarkOrange4" + "OrangeRed1" "OrangeRed2" "OrangeRed3" "OrangeRed4" + "red1" "red2" "red3" "red4" + "lavender blush" "LavenderBlush" "ghost white" "GhostWhite" + "lavender" "alice blue" "AliceBlue" "azure" "light cyan" + "LightCyan" "mint cream" "MintCream" "honeydew" "ivory" + "light goldenrod yellow" "LightGoldenrodYellow" "light yellow" + "LightYellow" "beige" "floral white" "FloralWhite" "old lace" + "OldLace" "blanched almond" "BlanchedAlmond" "moccasin" + "papaya whip" "PapayaWhip" "bisque" "antique white" + "AntiqueWhite" "linen" "peach puff" "PeachPuff" "seashell" + "misty rose" "MistyRose" "snow" "light pink" "LightPink" "pink" + "hot pink" "HotPink" "deep pink" "DeepPink" "maroon" + "pale violet red" "PaleVioletRed" "violet red" "VioletRed" + "medium violet red" "MediumVioletRed" "violet" "plum" "thistle" + "orchid" "medium orchid" "MediumOrchid" "dark orchid" + "DarkOrchid" "purple" "blue violet" "BlueViolet" "medium purple" + "MediumPurple" "light slate blue" "LightSlateBlue" + "medium slate blue" "MediumSlateBlue" "slate blue" "SlateBlue" + "dark slate blue" "DarkSlateBlue" "midnight blue" "MidnightBlue" + "navy" "navy blue" "NavyBlue" "dark blue" "DarkBlue" + "light steel blue" "LightSteelBlue" "cornflower blue" + "CornflowerBlue" "dodger blue" "DodgerBlue" "royal blue" + "RoyalBlue" "light slate gray" "light slate grey" + "LightSlateGray" "LightSlateGrey" "slate gray" "slate grey" + "SlateGray" "SlateGrey" "dark slate gray" "dark slate grey" + "DarkSlateGray" "DarkSlateGrey" "steel blue" "SteelBlue" + "cadet blue" "CadetBlue" "light sky blue" "LightSkyBlue" + "sky blue" "SkyBlue" "light blue" "LightBlue" "powder blue" + "PowderBlue" "pale turquoise" "PaleTurquoise" "turquoise" + "medium turquoise" "MediumTurquoise" "dark turquoise" + "DarkTurquoise" "dark cyan" "DarkCyan" "aquamarine" + "medium aquamarine" "MediumAquamarine" "light sea green" + "LightSeaGreen" "medium sea green" "MediumSeaGreen" "sea green" + "SeaGreen" "dark sea green" "DarkSeaGreen" "pale green" + "PaleGreen" "lime green" "LimeGreen" "dark green" "DarkGreen" + "forest green" "ForestGreen" "light green" "LightGreen" + "green yellow" "GreenYellow" "yellow green" "YellowGreen" + "olive drab" "OliveDrab" "dark olive green" "DarkOliveGreen" + "lemon chiffon" "LemonChiffon" "khaki" "dark khaki" "DarkKhaki" + "cornsilk" "pale goldenrod" "PaleGoldenrod" "light goldenrod" + "LightGoldenrod" "goldenrod" "dark goldenrod" "DarkGoldenrod" + "wheat" "navajo white" "NavajoWhite" "tan" "burlywood" + "sandy brown" "SandyBrown" "peru" "chocolate" "saddle brown" + "SaddleBrown" "sienna" "rosy brown" "RosyBrown" "dark salmon" + "DarkSalmon" "coral" "tomato" "light salmon" "LightSalmon" + "salmon" "light coral" "LightCoral" "indian red" "IndianRed" + "firebrick" "brown" "dark red" "DarkRed" "magenta" + "dark magenta" "DarkMagenta" "dark violet" "DarkViolet" + "medium blue" "MediumBlue" "blue" "deep sky blue" "DeepSkyBlue" + "cyan" "medium spring green" "MediumSpringGreen" "spring green" + "SpringGreen" "green" "lawn green" "LawnGreen" "chartreuse" + "yellow" "gold" "orange" "dark orange" "DarkOrange" "orange red" + "OrangeRed" "red" "white" "white smoke" "WhiteSmoke" "gainsboro" + "light gray" "light grey" "LightGray" "LightGrey" "gray" "grey" + "dark gray" "dark grey" "DarkGray" "DarkGrey" "dim gray" + "dim grey" "DimGray" "DimGrey" "black")) "List of basic colors available on color displays. For X, the list comes from the `rgb.txt' file,v 10.41 94/02/20. For Nextstep, this is a list of non-PANTONE colors returned by From a4e38cc3753ac416181c0ead758d174093eb3526 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 9 Dec 2024 03:28:30 +0100 Subject: [PATCH 25/57] Don't call purecopy in bindings.el * lisp/bindings.el (mode-line-input-method-map) (mode-line-coding-system-map, mode-line-mule-info, mode-line-client) (mode-line-modified, mode-line-remote) (mode-line-window-dedicated-keymap, propertized-buffer-identification) (completion-ignored-extensions): Remove calls to purecopy. --- lisp/bindings.el | 66 +++++++++++++++++++++++------------------------- 1 file changed, 31 insertions(+), 35 deletions(-) diff --git a/lisp/bindings.el b/lisp/bindings.el index a3b6b15f32b..01aa07b9272 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -67,7 +67,7 @@ corresponding to the mode line clicked." (interactive "e") (with-selected-window (posn-window (event-start e)) (describe-current-input-method)))) - (purecopy map))) + map)) (defvar mode-line-coding-system-map (let ((map (make-sparse-keymap))) @@ -83,7 +83,7 @@ corresponding to the mode line clicked." (interactive "e") (with-selected-window (posn-window (event-start e)) (call-interactively 'set-buffer-file-coding-system)))) - (purecopy map)) + map) "Local keymap for the coding-system part of the mode line.") (defun mode-line-change-eol (event) @@ -203,11 +203,11 @@ mouse-3: Set coding system" (current-input-method (:propertize ("" current-input-method-title) help-echo (concat - ,(purecopy "Current input method: ") + "Current input method: " current-input-method - ,(purecopy "\n\ + "\n\ mouse-2: Disable input method\n\ -mouse-3: Describe current input method")) +mouse-3: Describe current input method") local-map ,mode-line-input-method-map mouse-face mode-line-highlight)) ,(propertize @@ -228,7 +228,7 @@ mnemonics of the following coding systems: (defvar mode-line-client `(:eval (if (frame-parameter nil 'client) - ,(propertize "@" 'help-echo (purecopy "emacsclient frame")))) + ,(propertize "@" 'help-echo "emacsclient frame"))) "Mode line construct for identifying emacsclient frames.") ;; Autoload if this file no longer dumped. ;;;###autoload @@ -250,15 +250,15 @@ mnemonics of the following coding systems: (list (propertize "%1*" 'help-echo 'mode-line-read-only-help-echo - 'local-map (purecopy (make-mode-line-mouse-map - 'mouse-1 - #'mode-line-toggle-read-only)) + 'local-map (make-mode-line-mouse-map + 'mouse-1 + #'mode-line-toggle-read-only) 'mouse-face 'mode-line-highlight) (propertize "%1+" 'help-echo 'mode-line-modified-help-echo - 'local-map (purecopy (make-mode-line-mouse-map - 'mouse-1 #'mode-line-toggle-modified)) + 'local-map (make-mode-line-mouse-map + 'mouse-1 #'mode-line-toggle-modified) 'mouse-face 'mode-line-highlight)) "Mode line construct for displaying whether current buffer is modified.") ;;;###autoload @@ -268,16 +268,16 @@ mnemonics of the following coding systems: (list (propertize "%1@" 'mouse-face 'mode-line-highlight - 'help-echo (purecopy (lambda (window _object _point) - (format "%s" - (with-selected-window window - (if (stringp default-directory) - (concat - (if (file-remote-p default-directory) - "Current directory is remote: " - "Current directory is local: ") - default-directory) - "Current directory is nil"))))))) + 'help-echo (lambda (window _object _point) + (format "%s" + (with-selected-window window + (if (stringp default-directory) + (concat + (if (file-remote-p default-directory) + "Current directory is remote: " + "Current directory is local: ") + default-directory) + "Current directory is nil")))))) "Mode line construct to indicate a remote buffer.") ;;;###autoload (put 'mode-line-remote 'risky-local-variable t) @@ -301,8 +301,8 @@ Value is used for `mode-line-frame-identification', which see." (defvar mode-line-window-dedicated-keymap (let ((map (make-sparse-keymap))) (define-key map [mode-line mouse-1] #'toggle-window-dedicated) - (purecopy map)) "\ -Keymap for what is displayed by `mode-line-window-dedicated'.") + map) + "Keymap for what is displayed by `mode-line-window-dedicated'.") (defun mode-line-window-control () "Compute mode line construct for window dedicated state. @@ -648,8 +648,8 @@ text properties for face, help-echo, and local-map to it." (list (propertize fmt 'face 'mode-line-buffer-id 'help-echo - (purecopy "Buffer name -mouse-1: Previous buffer\nmouse-3: Next buffer") + "Buffer name +mouse-1: Previous buffer\nmouse-3: Next buffer" 'mouse-face 'mode-line-highlight 'local-map mode-line-buffer-identification-keymap))) @@ -823,8 +823,7 @@ Actually, STRING need not be a string; any mode-line construct is okay. See `mode-line-format'.") ;;;###autoload (put 'minor-mode-alist 'risky-local-variable t) -;; Don't use purecopy here--some people want to change these strings, -;; also string properties are lost when put into pure space. + (setq minor-mode-alist '((abbrev-mode " Abbrev") (overwrite-mode overwrite-mode) @@ -842,14 +841,11 @@ okay. See `mode-line-format'.") (setq completion-ignored-extensions (append (cond ((memq system-type '(ms-dos windows-nt)) - (mapcar 'purecopy - '(".o" "~" ".bin" ".bak" ".obj" ".map" ".ico" ".pif" ".lnk" - ".a" ".ln" ".blg" ".bbl" ".dll" ".drv" ".vxd" ".386"))) + '(".o" "~" ".bin" ".bak" ".obj" ".map" ".ico" ".pif" ".lnk" + ".a" ".ln" ".blg" ".bbl" ".dll" ".drv" ".vxd" ".386")) (t - (mapcar 'purecopy - '(".o" "~" ".bin" ".lbin" ".so" - ".a" ".ln" ".blg" ".bbl")))) - (mapcar 'purecopy + '(".o" "~" ".bin" ".lbin" ".so" + ".a" ".ln" ".blg" ".bbl"))) '(".elc" ".lof" ".glo" ".idx" ".lot" ;; VCS metadata directories @@ -879,7 +875,7 @@ okay. See `mode-line-format'.") ".cp" ".fn" ".ky" ".pg" ".tp" ".vr" ".cps" ".fns" ".kys" ".pgs" ".tps" ".vrs" ;; Python byte-compiled - ".pyc" ".pyo")))) + ".pyc" ".pyo"))) ;; Suffixes used for executables. (setq exec-suffixes From 04408e198f1acc2eeae2ca299de994ba38116d1a Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 9 Dec 2024 03:39:56 +0100 Subject: [PATCH 26/57] Don't call purecopy in progmodes/*.el * lisp/progmodes/compile.el (compile-command): * lisp/progmodes/etags.el (tags-compression-info-list): * lisp/progmodes/grep.el (grep-program, find-program, xargs-program): * lisp/progmodes/js.el (interpreter-mode-alist): * lisp/progmodes/python.el (interpreter-mode-alist): * lisp/progmodes/ruby-mode.el (auto-mode-alist, interpreter-mode-alist): * lisp/progmodes/vera-mode.el: Remove calls to purecopy. --- lisp/progmodes/compile.el | 2 +- lisp/progmodes/etags.el | 4 ++-- lisp/progmodes/grep.el | 6 +++--- lisp/progmodes/js.el | 2 +- lisp/progmodes/python.el | 2 +- lisp/progmodes/ruby-mode.el | 20 ++++++++++---------- lisp/progmodes/vera-mode.el | 2 +- 7 files changed, 19 insertions(+), 19 deletions(-) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index ac1042e21e6..49c1694f5d5 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -935,7 +935,7 @@ The value nil as an element means to try the default directory." (string :tag "Directory")))) ;;;###autoload -(defcustom compile-command (purecopy "make -k ") +(defcustom compile-command "make -k " "Last shell command used to do a compilation; default for next compilation. Sometimes it is useful for files to supply local values for this variable. diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index ca69817953e..2b40dbc6150 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -44,7 +44,7 @@ invoke `visit-tags-table', which is the only reliable way of setting the value of this variable, whether buffer-local or global. Use the `etags' program to make a tags table file.") ;; Make M-x set-variable tags-file-name like M-x visit-tags-table. -;;;###autoload (put 'tags-file-name 'variable-interactive (purecopy "fVisit tags table: ")) +;;;###autoload (put 'tags-file-name 'variable-interactive "fVisit tags table: ") ;;;###autoload (put 'tags-file-name 'safe-local-variable 'stringp) (defgroup etags nil "Tags tables." @@ -73,7 +73,7 @@ Use the `etags' program to make a tags table file." ;;;###autoload (defcustom tags-compression-info-list - (purecopy '("" ".Z" ".bz2" ".gz" ".xz" ".tgz")) + '("" ".Z" ".bz2" ".gz" ".xz" ".tgz") "List of extensions tried by etags when `auto-compression-mode' is on. An empty string means search the non-compressed file." :version "24.1" ; added xz diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index ed8d6e9e0d9..d70c78da00f 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -545,18 +545,18 @@ redundant).") This gets tacked on the end of the generated expressions.") ;;;###autoload -(defvar grep-program (purecopy "grep") +(defvar grep-program "grep" "The default grep program for `grep-command' and `grep-find-command'. This variable's value takes effect when `grep-compute-defaults' is called.") ;;;###autoload -(defvar find-program (purecopy "find") +(defvar find-program "find" "The default find program. This is used by commands like `grep-find-command', `find-dired' and others.") ;;;###autoload -(defvar xargs-program (purecopy "xargs") +(defvar xargs-program "xargs" "The default xargs program for `grep-find-command'. See `grep-find-use-xargs'. This variable's value takes effect when `grep-compute-defaults' is called.") diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index dbf721e8d0f..d10a7ab7198 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -4041,7 +4041,7 @@ one of the aforementioned options instead of using this mode." ;;;###autoload (dolist (name (list "node" "nodejs" "gjs" "rhino")) - (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'js-mode))) + (add-to-list 'interpreter-mode-alist (cons name 'js-mode))) (provide 'js) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index cfa3cc59568..cdc1f267ea3 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -291,7 +291,7 @@ ;;;###autoload (add-to-list 'auto-mode-alist (cons python--auto-mode-alist-regexp 'python-mode)) ;;;###autoload -(add-to-list 'interpreter-mode-alist (cons (purecopy "python[0-9.]*") 'python-mode)) +(add-to-list 'interpreter-mode-alist '("python[0-9.]*" python-mode)) (defgroup python nil "Python Language's flying circus support for Emacs." diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 4c37ef45ddf..8170dd8970f 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -2733,20 +2733,20 @@ Currently there are `ruby-mode' and `ruby-ts-mode'." ;;;###autoload (add-to-list 'auto-mode-alist - (cons (purecopy (concat "\\(?:\\.\\(?:" - "rbw?\\|ru\\|rake\\|thor\\|axlsx" - "\\|jbuilder\\|rabl\\|gemspec\\|podspec" - "\\)" - "\\|/" - "\\(?:Gem\\|Rake\\|Cap\\|Thor" - "\\|Puppet\\|Berks\\|Brew\\|Fast" - "\\|Vagrant\\|Guard\\|Pod\\)file" - "\\)\\'")) + (cons (concat "\\(?:\\.\\(?:" + "rbw?\\|ru\\|rake\\|thor\\|axlsx" + "\\|jbuilder\\|rabl\\|gemspec\\|podspec" + "\\)" + "\\|/" + "\\(?:Gem\\|Rake\\|Cap\\|Thor" + "\\|Puppet\\|Berks\\|Brew\\|Fast" + "\\|Vagrant\\|Guard\\|Pod\\)file" + "\\)\\'") 'ruby-mode)) ;;;###autoload (dolist (name (list "ruby" "rbx" "jruby" "j?ruby\\(?:[0-9.]+\\)")) - (add-to-list 'interpreter-mode-alist (cons (purecopy name) 'ruby-mode))) + (add-to-list 'interpreter-mode-alist (cons name 'ruby-mode))) ;; See ruby-ts-mode.el for why we do this. (setq major-mode-remap-defaults diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index 184cce66ae4..b3002127ff1 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -208,7 +208,7 @@ If nil, TAB always indents current line." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Mode definition -;;;###autoload (add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode)) +;;;###autoload (add-to-list 'auto-mode-alist '("\\.vr[hi]?\\'" vera-mode)) ;;;###autoload (define-derived-mode vera-mode prog-mode "Vera" From e44b1bf5cca00edb87452f864e9c450116d8f830 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 9 Dec 2024 03:47:37 +0100 Subject: [PATCH 27/57] Don't call purecopy in textmodes/*.el * lisp/textmodes/bibtex.el (bibtex-url, bibtex-search-crossref): * lisp/textmodes/fill.el (adaptive-fill-regexp) (adaptive-fill-first-line-regexp): * lisp/textmodes/ispell.el (ispell-menu-map) (ispell-skip-region-alist, ispell-tex-skip-alists): * lisp/textmodes/rst.el (auto-mode-alist): * lisp/textmodes/texinfo.el (texinfo-open-quote): * lisp/textmodes/tex-mode.el (tex-directory, tex-run-command) (latex-run-command, slitex-run-command, tex-start-options) (tex-start-commands, tex-bibtex-command, tex-dvi-print-command) (tex-alt-dvi-print-command, tex-dvi-view-command) (tex-show-queue-command, tex-open-quote, tex-close-quote): * lisp/textmodes/texinfo.el (texinfo-open-quote) (texinfo-close-quote): Remove calls to purecopy. --- lisp/textmodes/bibtex.el | 4 +- lisp/textmodes/fill.el | 4 +- lisp/textmodes/ispell.el | 83 +++++++++++++++++++------------------- lisp/textmodes/rst.el | 2 +- lisp/textmodes/tex-mode.el | 30 +++++++------- lisp/textmodes/texinfo.el | 4 +- 6 files changed, 63 insertions(+), 64 deletions(-) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 99a97c9bb8d..eb3ae58e70f 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -3556,12 +3556,12 @@ BOUND limits the search." (define-button-type 'bibtex-url 'action 'bibtex-button-action 'bibtex-function #'bibtex-url - 'help-echo (purecopy "mouse-2, RET: follow URL")) + 'help-echo "mouse-2, RET: follow URL") (define-button-type 'bibtex-search-crossref 'action 'bibtex-button-action 'bibtex-function #'bibtex-search-crossref - 'help-echo (purecopy "mouse-2, RET: follow crossref")) + 'help-echo "mouse-2, RET: follow crossref") (defun bibtex-button (beg end type &rest args) "Make a BibTeX button from BEG to END of type TYPE in the current buffer." diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index 11c67d2dc51..b7bb444f105 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -103,7 +103,7 @@ reinserts the fill prefix in each resulting line." ;; Added `%' for TeX comments. ;; RMS: deleted the code to match `1.' and `(1)'. ;; Update mail-mode's paragraph-separate if you change this. - (purecopy "[-–!|#%;>*·•‣⁃◦ \t]*") + "[-–!|#%;>*·•‣⁃◦ \t]*" "Regexp to match text at start of line that constitutes indentation. If Adaptive Fill mode is enabled, a prefix matching this pattern on the first and second lines of a paragraph is used as the @@ -114,7 +114,7 @@ line, but in that case `adaptive-fill-first-line-regexp' also plays a role." :type 'regexp) -(defcustom adaptive-fill-first-line-regexp (purecopy "\\`[ \t]*\\'") +(defcustom adaptive-fill-first-line-regexp "\\`[ \t]*\\'" "Regexp specifying whether to set fill prefix from a one-line paragraph. When a paragraph has just one line, then after `adaptive-fill-regexp' finds the prefix at the beginning of the line, if it doesn't diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 404f682d379..d37a8c8af8d 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1427,66 +1427,66 @@ The variable `ispell-library-directory' defines their location." ;; Define commands in menu in opposite order you want them to appear. (let ((map (make-sparse-keymap "Spell"))) (define-key map [ispell-change-dictionary] - `(menu-item ,(purecopy "Change Dictionary...") ispell-change-dictionary - :help ,(purecopy "Supply explicit dictionary file name"))) + '(menu-item "Change Dictionary..." ispell-change-dictionary + :help "Supply explicit dictionary file name")) (define-key map [ispell-kill-ispell] - `(menu-item ,(purecopy "Kill Process") - (lambda () (interactive) (ispell-kill-ispell nil 'clear)) + `(menu-item "Kill Process" + ,(lambda () (interactive) (ispell-kill-ispell nil 'clear)) :enable (and (boundp 'ispell-process) ispell-process (eq (ispell-process-status) 'run)) - :help ,(purecopy "Terminate Ispell subprocess"))) + :help "Terminate Ispell subprocess")) (define-key map [ispell-pdict-save] - `(menu-item ,(purecopy "Save Dictionary") - (lambda () (interactive) (ispell-pdict-save t t)) - :help ,(purecopy "Save personal dictionary"))) + `(menu-item "Save Dictionary" + ,(lambda () (interactive) (ispell-pdict-save t t)) + :help "Save personal dictionary")) (define-key map [ispell-customize] - `(menu-item ,(purecopy "Customize...") - (lambda () (interactive) (customize-group 'ispell)) - :help ,(purecopy "Customize spell checking options"))) + `(menu-item "Customize..." + ,(lambda () (interactive) (customize-group 'ispell)) + :help "Customize spell checking options")) (define-key map [ispell-help] ;; use (x-popup-menu last-nonmenu-event(list "" ispell-help-list)) ? - `(menu-item ,(purecopy "Help") - (lambda () (interactive) (describe-function 'ispell-help)) - :help ,(purecopy "Show standard Ispell keybindings and commands"))) + `(menu-item "Help" + ,(lambda () (interactive) (describe-function 'ispell-help)) + :help "Show standard Ispell keybindings and commands")) (define-key map [flyspell-mode] - `(menu-item ,(purecopy "Automatic spell checking (Flyspell)") + '(menu-item "Automatic spell checking (Flyspell)" flyspell-mode - :help ,(purecopy "Check spelling while you edit the text") + :help "Check spelling while you edit the text" :button (:toggle . (bound-and-true-p flyspell-mode)))) (define-key map [ispell-complete-word] - `(menu-item ,(purecopy "Complete Word") ispell-complete-word - :help ,(purecopy "Complete word at cursor using dictionary"))) + '(menu-item "Complete Word" ispell-complete-word + :help "Complete word at cursor using dictionary")) (define-key map [ispell-complete-word-interior-frag] - `(menu-item ,(purecopy "Complete Word Fragment") + '(menu-item "Complete Word Fragment" ispell-complete-word-interior-frag - :help ,(purecopy "Complete word fragment at cursor"))) + :help "Complete word fragment at cursor")) (define-key map [ispell-continue] - `(menu-item ,(purecopy "Continue Spell-Checking") ispell-continue + '(menu-item "Continue Spell-Checking" ispell-continue :enable (and (boundp 'ispell-region-end) (marker-position ispell-region-end) (equal (marker-buffer ispell-region-end) (current-buffer))) - :help ,(purecopy "Continue spell checking last region"))) + :help "Continue spell checking last region")) (define-key map [ispell-word] - `(menu-item ,(purecopy "Spell-Check Word") ispell-word - :help ,(purecopy "Spell-check word at cursor"))) + '(menu-item "Spell-Check Word" ispell-word + :help "Spell-check word at cursor")) (define-key map [ispell-comments-and-strings] - `(menu-item ,(purecopy "Spell-Check Comments") + '(menu-item "Spell-Check Comments" ispell-comments-and-strings - :help ,(purecopy "Spell-check only comments and strings"))) + :help "Spell-check only comments and strings")) (define-key map [ispell-region] - `(menu-item ,(purecopy "Spell-Check Region") ispell-region + '(menu-item "Spell-Check Region" ispell-region :enable mark-active - :help ,(purecopy "Spell-check text in marked region"))) + :help "Spell-check text in marked region")) (define-key map [ispell-message] - `(menu-item ,(purecopy "Spell-Check Message") ispell-message + '(menu-item "Spell-Check Message" ispell-message :visible (eq major-mode 'mail-mode) - :help ,(purecopy "Skip headers and included message text"))) + :help "Skip headers and included message text")) (define-key map [ispell-buffer] - `(menu-item ,(purecopy "Spell-Check Buffer") ispell-buffer - :help ,(purecopy "Check spelling of selected buffer"))) + '(menu-item "Spell-Check Buffer" ispell-buffer + :help "Check spelling of selected buffer")) map) "Key map for ispell menu.") ;;;###autoload @@ -1659,21 +1659,21 @@ objects as practicable, without too many false matches happening." ;;;###autoload (defvar ispell-skip-region-alist - `((ispell-words-keyword forward-line) + '((ispell-words-keyword forward-line) (ispell-dictionary-keyword forward-line) (ispell-pdict-keyword forward-line) (ispell-parsing-keyword forward-line) - (,(purecopy "^---*BEGIN PGP [A-Z ]*--*") - . ,(purecopy "^---*END PGP [A-Z ]*--*")) + ("^---*BEGIN PGP [A-Z ]*--*" + . "^---*END PGP [A-Z ]*--*") ;; assume multiline uuencoded file? "\nM.*$"? - (,(purecopy "^begin [0-9][0-9][0-9] [^ \t]+$") . ,(purecopy "\nend\n")) - (,(purecopy "^%!PS-Adobe-[123].0") . ,(purecopy "\n%%EOF\n")) - (,(purecopy "^---* \\(Start of \\)?[Ff]orwarded [Mm]essage") - . ,(purecopy "^---* End of [Ff]orwarded [Mm]essage")) + ("^begin [0-9][0-9][0-9] [^ \t]+$" . "\nend\n") + ("^%!PS-Adobe-[123].0" . "\n%%EOF\n") + ("^---* \\(Start of \\)?[Ff]orwarded [Mm]essage" + . "^---* End of [Ff]orwarded [Mm]essage") ;; Matches e-mail addresses, file names, http addresses, etc. The ;; `-+' `_+' patterns are necessary for performance reasons when ;; `-' or `_' part of word syntax. -; (,(purecopy "\\(--+\\|_+\\|\\(/\\w\\|\\(\\(\\w\\|[-_]\\)+[.:@]\\)\\)\\(\\w\\|[-_]\\)*\\([.:/@]+\\(\\w\\|[-_~=?&]\\)+\\)+\\)")) +; ("\\(--+\\|_+\\|\\(/\\w\\|\\(\\(\\w\\|[-_]\\)+[.:@]\\)\\)\\(\\w\\|[-_]\\)*\\([.:/@]+\\(\\w\\|[-_~=?&]\\)+\\)+\\)") ;; above checks /.\w sequences ;;("\\(--+\\|\\(/\\|\\(\\(\\w\\|[-_]\\)+[.:@]\\)\\)\\(\\w\\|[-_]\\)*\\([.:/@]+\\(\\w\\|[-_~=?&]\\)+\\)+\\)") ;; This is a pretty complex regexp. It can be simplified to the following: @@ -1696,7 +1696,6 @@ Valid forms include: ;;;###autoload (defvar ispell-tex-skip-alists - (purecopy '((;;("%\\[" . "%\\]") ; AMStex block comment... ;; All the standard LaTeX keywords from L. Lamport's guide: ;; \cite, \hspace, \hspace*, \hyphenation, \include, \includeonly, \input, @@ -1715,7 +1714,7 @@ Valid forms include: ("\\(figure\\|table\\)\\*?" ispell-tex-arg-end 0) ("list" ispell-tex-arg-end 2) ("program" . "\\\\end[ \t]*{program}") - ("verbatim\\*?" . "\\\\end[ \t]*{verbatim\\*?}")))) + ("verbatim\\*?" . "\\\\end[ \t]*{verbatim\\*?}"))) "Lists of regions to be skipped in TeX mode. First list is used raw. Second list has key placed inside \\begin{}. diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 25b04e55253..8826c19edba 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -1325,7 +1325,7 @@ The hook for `text-mode' is run before this one." ;; Use rst-mode for *.rst and *.rest files. Many ReStructured-Text files ;; use *.txt, but this is too generic to be set as a default. -;;;###autoload (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode))) +;;;###autoload (add-to-list 'auto-mode-alist '("\\.re?st\\'" . rst-mode)) ;;;###autoload (define-derived-mode rst-mode text-mode "ReST" "Major mode for editing reStructuredText documents. diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index c82e589632e..41da2865315 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -64,7 +64,7 @@ :group 'tex-run) ;;;###autoload -(defcustom tex-directory (purecopy ".") +(defcustom tex-directory "." "Directory in which temporary files are written. You can make this `/tmp' if your TEXINPUTS has no relative directories in it and you don't try to apply \\[tex-region] or \\[tex-buffer] when there are @@ -98,7 +98,7 @@ if the variable is non-nil." :group 'tex-file) ;;;###autoload -(defcustom tex-run-command (purecopy "tex") +(defcustom tex-run-command "tex" "Command used to run TeX subjob. TeX Mode sets `tex-command' to this string. See the documentation of that variable." @@ -106,7 +106,7 @@ See the documentation of that variable." :group 'tex-run) ;;;###autoload -(defcustom latex-run-command (purecopy "latex") +(defcustom latex-run-command "latex" "Command used to run LaTeX subjob. LaTeX Mode sets `tex-command' to this string. See the documentation of that variable." @@ -114,7 +114,7 @@ See the documentation of that variable." :group 'tex-run) ;;;###autoload -(defcustom slitex-run-command (purecopy "slitex") +(defcustom slitex-run-command "slitex" "Command used to run SliTeX subjob. SliTeX Mode sets `tex-command' to this string. See the documentation of that variable." @@ -122,7 +122,7 @@ See the documentation of that variable." :group 'tex-run) ;;;###autoload -(defcustom tex-start-options (purecopy "") +(defcustom tex-start-options "" "TeX options to use when starting TeX. These immediately precede the commands in `tex-start-commands' and the input file name, with no separating space and are not shell-quoted. @@ -132,7 +132,7 @@ If nil, TeX runs with no options. See the documentation of `tex-command'." :version "22.1") ;;;###autoload -(defcustom tex-start-commands (purecopy "\\nonstopmode\\input") +(defcustom tex-start-commands "\\nonstopmode\\input" "TeX commands to use when starting TeX. They are shell-quoted and precede the input file name, with a separating space. If nil, no commands are used. See the documentation of `tex-command'." @@ -163,7 +163,7 @@ Combined with `latex-standard-block-names' for minibuffer completion." :group 'tex-run) ;;;###autoload -(defcustom tex-bibtex-command (purecopy "bibtex") +(defcustom tex-bibtex-command "bibtex" "Command used by `tex-bibtex-file' to gather bibliographic data. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end." @@ -171,7 +171,7 @@ otherwise, the file name, preceded by blank, is added at the end." :group 'tex-run) ;;;###autoload -(defcustom tex-dvi-print-command (purecopy "lpr -d") +(defcustom tex-dvi-print-command "lpr -d" "Command used by \\[tex-print] to print a .dvi file. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end." @@ -179,7 +179,7 @@ otherwise, the file name, preceded by blank, is added at the end." :group 'tex-view) ;;;###autoload -(defcustom tex-alt-dvi-print-command (purecopy "lpr -d") +(defcustom tex-alt-dvi-print-command "lpr -d" "Command used by \\[tex-print] with a prefix arg to print a .dvi file. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end. @@ -199,9 +199,9 @@ use." ;;;###autoload (defcustom tex-dvi-view-command - (cond ((eq window-system 'x) (purecopy "xdvi")) - ((eq window-system 'w32) (purecopy "yap")) - (t (purecopy "dvi2tty * | cat -s"))) + (cond ((eq window-system 'x) "xdvi") + ((eq window-system 'w32) "yap") + (t "dvi2tty * | cat -s")) "Command used by \\[tex-view] to display a `.dvi' file. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by a space, is added at the end. @@ -214,7 +214,7 @@ will lead to a warning. Set it to a string instead." :group 'tex-view) ;;;###autoload -(defcustom tex-show-queue-command (purecopy "lpq") +(defcustom tex-show-queue-command "lpq" "Command used by \\[tex-show-print-queue] to show the print queue. Should show the queue(s) that \\[tex-print] puts jobs on." :type 'string @@ -230,14 +230,14 @@ Normally set to either `plain-tex-mode' or `latex-mode'." :group 'tex) ;;;###autoload -(defcustom tex-open-quote (purecopy "``") +(defcustom tex-open-quote "``" "String inserted by typing \\[tex-insert-quote] to open a quotation." :type 'string :options '("``" "\"<" "\"`" "<<" "«") :group 'tex) ;;;###autoload -(defcustom tex-close-quote (purecopy "''") +(defcustom tex-close-quote "''" "String inserted by typing \\[tex-insert-quote] to close a quotation." :type 'string :options '("''" "\">" "\"'" ">>" "»") diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index bd371514df0..639368b7319 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -61,12 +61,12 @@ :group 'docs) ;;;###autoload -(defcustom texinfo-open-quote (purecopy "``") +(defcustom texinfo-open-quote "``" "String inserted by typing \\[texinfo-insert-quote] to open a quotation." :type 'string) ;;;###autoload -(defcustom texinfo-close-quote (purecopy "''") +(defcustom texinfo-close-quote "''" "String inserted by typing \\[texinfo-insert-quote] to close a quotation." :type 'string) From 065b6f2fa7a75fda446dc755edfee555b6e6d704 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 9 Dec 2024 20:40:56 +0100 Subject: [PATCH 28/57] Don't call purecopy in help-mode.el * lisp/help-mode.el (help-function, help-variable, help-type) (help-face, help-coding-system, help-input-method) (help-character-set, help-symbol, help-back, help-forward) (help-info-variable, help-info, help-man) (help-customization-group, help-url, help-customize-variable) (help-customize-face, help-function-def, help-function-cmacro) (help-variable-def, help-face-def, help-package) (help-package-def, help-theme-def, help-theme-edit) (help-dir-local-var-def, help-news, help-back-label) (help-forward-label, help-xref-symbol-regexp) (help-xref-info-regexp, help-xref-man-regexp) (help-xref-customization-group-regexp, help-xref-url-regexp): Remove calls to purecopy. --- lisp/help-mode.el | 88 +++++++++++++++++++++++------------------------ 1 file changed, 43 insertions(+), 45 deletions(-) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 33b8eccab2c..f7c6278d052 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -170,92 +170,92 @@ The format is (FUNCTION ARGS...).") (define-button-type 'help-function :supertype 'help-xref 'help-function 'describe-function - 'help-echo (purecopy "mouse-2, RET: describe this function")) + 'help-echo "mouse-2, RET: describe this function") (define-button-type 'help-variable :supertype 'help-xref 'help-function 'describe-variable - 'help-echo (purecopy "mouse-2, RET: describe this variable")) + 'help-echo "mouse-2, RET: describe this variable") (define-button-type 'help-type :supertype 'help-xref 'help-function #'cl-describe-type - 'help-echo (purecopy "mouse-2, RET: describe this type")) + 'help-echo "mouse-2, RET: describe this type") (define-button-type 'help-face :supertype 'help-xref 'help-function 'describe-face - 'help-echo (purecopy "mouse-2, RET: describe this face")) + 'help-echo "mouse-2, RET: describe this face") (define-button-type 'help-coding-system :supertype 'help-xref 'help-function 'describe-coding-system - 'help-echo (purecopy "mouse-2, RET: describe this coding system")) + 'help-echo "mouse-2, RET: describe this coding system") (define-button-type 'help-input-method :supertype 'help-xref 'help-function 'describe-input-method - 'help-echo (purecopy "mouse-2, RET: describe this input method")) + 'help-echo "mouse-2, RET: describe this input method") (define-button-type 'help-character-set :supertype 'help-xref 'help-function 'describe-character-set - 'help-echo (purecopy "mouse-2, RET: describe this character set")) + 'help-echo "mouse-2, RET: describe this character set") ;; Make some more idiosyncratic button types. (define-button-type 'help-symbol :supertype 'help-xref 'help-function #'describe-symbol - 'help-echo (purecopy "mouse-2, RET: describe this symbol")) + 'help-echo "mouse-2, RET: describe this symbol") (define-button-type 'help-back :supertype 'help-xref 'help-function #'help-xref-go-back - 'help-echo (purecopy "mouse-2, RET: go back to previous help buffer")) + 'help-echo "mouse-2, RET: go back to previous help buffer") (define-button-type 'help-forward :supertype 'help-xref 'help-function #'help-xref-go-forward - 'help-echo (purecopy "mouse-2, RET: move forward to next help buffer")) + 'help-echo "mouse-2, RET: move forward to next help buffer") (define-button-type 'help-info-variable :supertype 'help-xref ;; the name of the variable is put before the argument to Info 'help-function (lambda (_a v) (info v)) - 'help-echo (purecopy "mouse-2, RET: read this Info node")) + 'help-echo "mouse-2, RET: read this Info node") (define-button-type 'help-info :supertype 'help-xref 'help-function #'info - 'help-echo (purecopy "mouse-2, RET: read this Info node")) + 'help-echo "mouse-2, RET: read this Info node") (define-button-type 'help-man :supertype 'help-xref 'help-function #'man - 'help-echo (purecopy "mouse-2, RET: read this man page")) + 'help-echo "mouse-2, RET: read this man page") (define-button-type 'help-customization-group :supertype 'help-xref 'help-function #'customize-group - 'help-echo (purecopy "mouse-2, RET: display this customization group")) + 'help-echo "mouse-2, RET: display this customization group") (define-button-type 'help-url :supertype 'help-xref 'help-function #'browse-url - 'help-echo (purecopy "mouse-2, RET: view this URL in a browser")) + 'help-echo "mouse-2, RET: view this URL in a browser") (define-button-type 'help-customize-variable :supertype 'help-xref 'help-function (lambda (v) - (customize-variable v)) - 'help-echo (purecopy "mouse-2, RET: customize variable")) + (customize-variable v)) + 'help-echo "mouse-2, RET: customize variable") (define-button-type 'help-customize-face :supertype 'help-xref 'help-function (lambda (v) - (customize-face v)) - 'help-echo (purecopy "mouse-2, RET: customize face")) + (customize-face v)) + 'help-echo "mouse-2, RET: customize face") (defun help-function-def--button-function (fun &optional file type) (or file @@ -293,7 +293,7 @@ The format is (FUNCTION ARGS...).") (define-button-type 'help-function-def :supertype 'help-xref 'help-function #'help-function-def--button-function - 'help-echo (purecopy "mouse-2, RET: find function's definition")) + 'help-echo "mouse-2, RET: find function's definition") (define-button-type 'help-function-cmacro ; FIXME: Obsolete since 24.4. :supertype 'help-xref @@ -314,7 +314,7 @@ The format is (FUNCTION ARGS...).") (forward-line 0) (message "Unable to find location in file"))) (message "Unable to find file"))) - 'help-echo (purecopy "mouse-2, RET: find function's compiler macro")) + 'help-echo "mouse-2, RET: find function's compiler macro") (define-button-type 'help-variable-def :supertype 'help-xref @@ -335,7 +335,7 @@ The format is (FUNCTION ARGS...).") (widen)) (goto-char position)) (message "Unable to find location in file")))) - 'help-echo (purecopy "mouse-2, RET: find variable's definition")) + 'help-echo "mouse-2, RET: find variable's definition") (define-button-type 'help-face-def :supertype 'help-xref @@ -357,27 +357,27 @@ The format is (FUNCTION ARGS...).") (widen)) (goto-char position)) (message "Unable to find location in file")))) - 'help-echo (purecopy "mouse-2, RET: find face's definition")) + 'help-echo "mouse-2, RET: find face's definition") (define-button-type 'help-package :supertype 'help-xref 'help-function 'describe-package - 'help-echo (purecopy "mouse-2, RET: Describe package")) + 'help-echo "mouse-2, RET: Describe package") (define-button-type 'help-package-def :supertype 'help-xref 'help-function (lambda (file) (dired file)) - 'help-echo (purecopy "mouse-2, RET: visit package directory")) + 'help-echo "mouse-2, RET: visit package directory") (define-button-type 'help-theme-def :supertype 'help-xref 'help-function #'find-file - 'help-echo (purecopy "mouse-2, RET: visit theme file")) + 'help-echo "mouse-2, RET: visit theme file") (define-button-type 'help-theme-edit :supertype 'help-xref 'help-function #'customize-create-theme - 'help-echo (purecopy "mouse-2, RET: edit this theme file")) + 'help-echo "mouse-2, RET: edit this theme file") (define-button-type 'help-dir-local-var-def :supertype 'help-xref @@ -385,7 +385,7 @@ The format is (FUNCTION ARGS...).") ;; FIXME: this should go to the point where the ;; local variable was defined. (find-file file)) - 'help-echo (purecopy "mouse-2, RET: open directory-local variables file")) + 'help-echo "mouse-2, RET: open directory-local variables file") (define-button-type 'help-news :supertype 'help-xref 'help-function @@ -394,7 +394,7 @@ The format is (FUNCTION ARGS...).") (view-file file) (view-file-other-window file)) (goto-char pos)) - 'help-echo (purecopy "mouse-2, RET: show corresponding NEWS announcement")) + 'help-echo "mouse-2, RET: show corresponding NEWS announcement") ;;;###autoload (defun help-mode--add-function-link (str fun) @@ -446,21 +446,21 @@ Commands: ;; similar should be done for widget doc strings, which currently use ;; another mechanism. -(defvar help-back-label (purecopy "[back]") +(defvar help-back-label "[back]" "Label to use by `help-make-xrefs' for the go-back reference.") -(defvar help-forward-label (purecopy "[forward]") +(defvar help-forward-label "[forward]" "Label to use by `help-make-xrefs' for the go-forward reference.") (defconst help-xref-symbol-regexp - (purecopy (concat "\\(\\<\\(\\(variable\\|option\\)\\|" ; Link to var - "\\(function\\|command\\|call\\)\\|" ; Link to function - "\\(face\\)\\|" ; Link to face - "\\(symbol\\|program\\|property\\)\\|" ; Don't link - "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)" - "[ \t\n]+\\)?" - "\\(\\\\\\+\\)?" - "['`‘]\\(\\(?:\\sw\\|\\s_\\)+\\|`\\)['’]")) + (concat "\\(\\<\\(\\(variable\\|option\\)\\|" ; Link to var + "\\(function\\|command\\|call\\)\\|" ; Link to function + "\\(face\\)\\|" ; Link to face + "\\(symbol\\|program\\|property\\)\\|" ; Don't link + "\\(source \\(?:code \\)?\\(?:of\\|for\\)\\)\\)" + "[ \t\n]+\\)?" + "\\(\\\\\\+\\)?" + "['`‘]\\(\\(?:\\sw\\|\\s_\\)+\\|`\\)['’]") "Regexp matching doc string references to symbols. The words preceding the quoted symbol can be used in doc strings to @@ -475,21 +475,19 @@ when help commands related to multilingual environment (e.g., (defconst help-xref-info-regexp - (purecopy - "\\<[Ii]nfo[ \t\n]+\\(node\\|anchor\\)[ \t\n]+['`‘]\\([^'’]+\\)['’]") + "\\<[Ii]nfo[ \t\n]+\\(node\\|anchor\\)[ \t\n]+['`‘]\\([^'’]+\\)['’]" "Regexp matching doc string references to an Info node.") (defconst help-xref-man-regexp - (purecopy - "\\<[Mm]an[ \t\n]+page[ \t\n]+\\(?:for[ \t\n]+\\)?['`‘\"]\\([^'’\"]+\\)['’\"]") + "\\<[Mm]an[ \t\n]+page[ \t\n]+\\(?:for[ \t\n]+\\)?['`‘\"]\\([^'’\"]+\\)['’\"]" "Regexp matching doc string references to a man page.") (defconst help-xref-customization-group-regexp - (purecopy "\\<[Cc]ustomization[ \t\n]+[Gg]roup[ \t\n]+['`‘]\\([^'’]+\\)['’]") + "\\<[Cc]ustomization[ \t\n]+[Gg]roup[ \t\n]+['`‘]\\([^'’]+\\)['’]" "Regexp matching doc string references to a customization group.") (defconst help-xref-url-regexp - (purecopy "\\<[Uu][Rr][Ll][ \t\n]+['`‘]\\([^'’]+\\)['’]") + "\\<[Uu][Rr][Ll][ \t\n]+['`‘]\\([^'’]+\\)['’]" "Regexp matching doc string references to a URL.") ;;;###autoload From 8bd246d87ea9cf02cab0a229e89b1648e9462c2e Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 9 Dec 2024 20:44:23 +0100 Subject: [PATCH 29/57] Don't call purecopy in vc/*.el * lisp/vc/diff.el (diff-command, diff-switches): * lisp/vc/ediff-hook.el (menu-bar-ediff-misc-menu) (menu-bar-epatch-menu, menu-bar-ediff-merge-menu) (menu-bar-ediff-menu): * lisp/vc/pcvs-defs.el (cvs-global-menu): * lisp/vc/vc-hooks.el (vc-menu-entry) (vc-directory-exclusion-list): * lisp/vc/vc-rcs.el (vc-rcs-master-templates): * lisp/vc/vc-sccs.el (vc-sccs-master-templates): * lisp/vc/vc-src.el (vc-src-master-templates): Remove calls to purecopy. --- lisp/vc/diff.el | 4 +- lisp/vc/ediff-hook.el | 118 +++++++++++++++++++++--------------------- lisp/vc/pcvs-defs.el | 16 +++--- lisp/vc/vc-hooks.el | 6 +-- lisp/vc/vc-rcs.el | 2 +- lisp/vc/vc-sccs.el | 2 +- lisp/vc/vc-src.el | 2 +- 7 files changed, 75 insertions(+), 75 deletions(-) diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el index a64fbc47853..038989bac72 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -38,7 +38,7 @@ :group 'tools) ;;;###autoload -(defcustom diff-switches (purecopy "-u") +(defcustom diff-switches "-u" "A string or list of strings specifying switches to be passed to diff. This variable is also used in the `vc-diff' command (and related @@ -48,7 +48,7 @@ set (`vc-git-diff-switches' for git, for instance), and :type '(choice string (repeat string))) ;;;###autoload -(defcustom diff-command (purecopy "diff") +(defcustom diff-command "diff" "The command to use to run diff." :type 'string) diff --git a/lisp/vc/ediff-hook.el b/lisp/vc/ediff-hook.el index 3c78990d393..b2765dfc941 100644 --- a/lisp/vc/ediff-hook.el +++ b/lisp/vc/ediff-hook.el @@ -52,108 +52,108 @@ ;; define ediff compare menu (define-key menu-bar-ediff-menu [ediff-misc] - `(menu-item ,(purecopy "Ediff Miscellanea") menu-bar-ediff-misc-menu)) + '(menu-item "Ediff Miscellanea" menu-bar-ediff-misc-menu)) (define-key menu-bar-ediff-menu [separator-ediff-misc] menu-bar-separator) (define-key menu-bar-ediff-menu [window] - `(menu-item ,(purecopy "This Window and Next Window") compare-windows - :help ,(purecopy "Compare the current window and the next window"))) + '(menu-item "This Window and Next Window" compare-windows + :help "Compare the current window and the next window")) (define-key menu-bar-ediff-menu [ediff-windows-linewise] - `(menu-item ,(purecopy "Windows Line-by-line...") ediff-windows-linewise - :help ,(purecopy "Compare windows line-wise"))) + '(menu-item "Windows Line-by-line..." ediff-windows-linewise + :help "Compare windows line-wise")) (define-key menu-bar-ediff-menu [ediff-windows-wordwise] - `(menu-item ,(purecopy "Windows Word-by-word...") ediff-windows-wordwise - :help ,(purecopy "Compare windows word-wise"))) + '(menu-item "Windows Word-by-word..." ediff-windows-wordwise + :help "Compare windows word-wise")) (define-key menu-bar-ediff-menu [separator-ediff-windows] menu-bar-separator) (define-key menu-bar-ediff-menu [ediff-regions-linewise] - `(menu-item ,(purecopy "Regions Line-by-line...") ediff-regions-linewise - :help ,(purecopy "Compare regions line-wise"))) + '(menu-item "Regions Line-by-line..." ediff-regions-linewise + :help "Compare regions line-wise")) (define-key menu-bar-ediff-menu [ediff-regions-wordwise] - `(menu-item ,(purecopy "Regions Word-by-word...") ediff-regions-wordwise - :help ,(purecopy "Compare regions word-wise"))) + '(menu-item "Regions Word-by-word..." ediff-regions-wordwise + :help "Compare regions word-wise")) (define-key menu-bar-ediff-menu [separator-ediff-regions] menu-bar-separator) (define-key menu-bar-ediff-menu [ediff-dir-revision] - `(menu-item ,(purecopy "Directory Revisions...") ediff-directory-revisions - :help ,(purecopy "Compare directory files with their older versions"))) + '(menu-item "Directory Revisions..." ediff-directory-revisions + :help "Compare directory files with their older versions")) (define-key menu-bar-ediff-menu [ediff-revision] - `(menu-item ,(purecopy "File with Revision...") ediff-revision - :help ,(purecopy "Compare file with its older versions"))) + '(menu-item "File with Revision..." ediff-revision + :help "Compare file with its older versions")) (define-key menu-bar-ediff-menu [separator-ediff-directories] menu-bar-separator) (define-key menu-bar-ediff-menu [ediff-directories3] - `(menu-item ,(purecopy "Three Directories...") ediff-directories3 - :help ,(purecopy "Compare files common to three directories simultaneously"))) + '(menu-item "Three Directories..." ediff-directories3 + :help "Compare files common to three directories simultaneously")) (define-key menu-bar-ediff-menu [ediff-directories] - `(menu-item ,(purecopy "Two Directories...") ediff-directories - :help ,(purecopy "Compare files common to two directories simultaneously"))) + '(menu-item "Two Directories..." ediff-directories + :help "Compare files common to two directories simultaneously")) (define-key menu-bar-ediff-menu [separator-ediff-files] menu-bar-separator) (define-key menu-bar-ediff-menu [ediff-buffers3] - `(menu-item ,(purecopy "Three Buffers...") ediff-buffers3 - :help ,(purecopy "Compare three buffers simultaneously"))) + '(menu-item "Three Buffers..." ediff-buffers3 + :help "Compare three buffers simultaneously")) (define-key menu-bar-ediff-menu [ediff-files3] - `(menu-item ,(purecopy "Three Files...") ediff-files3 - :help ,(purecopy "Compare three files simultaneously"))) + '(menu-item "Three Files..." ediff-files3 + :help "Compare three files simultaneously")) (define-key menu-bar-ediff-menu [ediff-buffers] - `(menu-item ,(purecopy "Two Buffers...") ediff-buffers - :help ,(purecopy "Compare two buffers simultaneously"))) + '(menu-item "Two Buffers..." ediff-buffers + :help "Compare two buffers simultaneously")) (define-key menu-bar-ediff-menu [ediff-files] - `(menu-item ,(purecopy "Two Files...") ediff-files - :help ,(purecopy "Compare two files simultaneously"))) + '(menu-item "Two Files..." ediff-files + :help "Compare two files simultaneously")) ;; define ediff merge menu (define-key menu-bar-ediff-merge-menu [ediff-merge-dir-revisions-with-ancestor] - `(menu-item ,(purecopy "Directory Revisions with Ancestor...") + '(menu-item "Directory Revisions with Ancestor..." ediff-merge-directory-revisions-with-ancestor - :help ,(purecopy "Merge versions of the files in the same directory by comparing the files with common ancestors"))) + :help "Merge versions of the files in the same directory by comparing the files with common ancestors")) (define-key menu-bar-ediff-merge-menu [ediff-merge-dir-revisions] - `(menu-item ,(purecopy "Directory Revisions...") ediff-merge-directory-revisions - :help ,(purecopy "Merge versions of the files in the same directory (without using ancestor information)"))) + '(menu-item "Directory Revisions..." ediff-merge-directory-revisions + :help "Merge versions of the files in the same directory (without using ancestor information)")) (define-key menu-bar-ediff-merge-menu [ediff-merge-revisions-with-ancestor] - `(menu-item ,(purecopy "Revisions with Ancestor...") + '(menu-item "Revisions with Ancestor..." ediff-merge-revisions-with-ancestor - :help ,(purecopy "Merge versions of the same file by comparing them with a common ancestor"))) + :help "Merge versions of the same file by comparing them with a common ancestor")) (define-key menu-bar-ediff-merge-menu [ediff-merge-revisions] - `(menu-item ,(purecopy "Revisions...") ediff-merge-revisions - :help ,(purecopy "Merge versions of the same file (without using ancestor information)"))) + '(menu-item "Revisions..." ediff-merge-revisions + :help "Merge versions of the same file (without using ancestor information)")) (define-key menu-bar-ediff-merge-menu [separator-ediff-merge] menu-bar-separator) (define-key menu-bar-ediff-merge-menu [ediff-merge-directories-with-ancestor] - `(menu-item ,(purecopy "Directories with Ancestor...") + '(menu-item "Directories with Ancestor..." ediff-merge-directories-with-ancestor - :help ,(purecopy "Merge files common to a pair of directories by comparing the files with common ancestors"))) + :help "Merge files common to a pair of directories by comparing the files with common ancestors")) (define-key menu-bar-ediff-merge-menu [ediff-merge-directories] - `(menu-item ,(purecopy "Directories...") ediff-merge-directories - :help ,(purecopy "Merge files common to a pair of directories"))) + '(menu-item "Directories..." ediff-merge-directories + :help "Merge files common to a pair of directories")) (define-key menu-bar-ediff-merge-menu [separator-ediff-merge-dirs] menu-bar-separator) (define-key menu-bar-ediff-merge-menu [ediff-merge-buffers-with-ancestor] - `(menu-item ,(purecopy "Buffers with Ancestor...") ediff-merge-buffers-with-ancestor - :help ,(purecopy "Merge buffers by comparing their contents with a common ancestor"))) + '(menu-item "Buffers with Ancestor..." ediff-merge-buffers-with-ancestor + :help "Merge buffers by comparing their contents with a common ancestor")) (define-key menu-bar-ediff-merge-menu [ediff-merge-buffers] - `(menu-item ,(purecopy "Buffers...") ediff-merge-buffers - :help ,(purecopy "Merge buffers (without using ancestor information)"))) + '(menu-item "Buffers..." ediff-merge-buffers + :help "Merge buffers (without using ancestor information)")) (define-key menu-bar-ediff-merge-menu [ediff-merge-files-with-ancestor] - `(menu-item ,(purecopy "Files with Ancestor...") ediff-merge-files-with-ancestor - :help ,(purecopy "Merge files by comparing them with a common ancestor"))) + '(menu-item "Files with Ancestor..." ediff-merge-files-with-ancestor + :help "Merge files by comparing them with a common ancestor")) (define-key menu-bar-ediff-merge-menu [ediff-merge-files] - `(menu-item ,(purecopy "Files...") ediff-merge-files - :help ,(purecopy "Merge files (without using ancestor information)"))) + '(menu-item "Files..." ediff-merge-files + :help "Merge files (without using ancestor information)")) ;; define epatch menu (define-key menu-bar-epatch-menu [ediff-patch-buffer] - `(menu-item ,(purecopy "To a Buffer...") ediff-patch-buffer - :help ,(purecopy "Apply a patch to the contents of a buffer"))) + '(menu-item "To a Buffer..." ediff-patch-buffer + :help "Apply a patch to the contents of a buffer")) (define-key menu-bar-epatch-menu [ediff-patch-file] - `(menu-item ,(purecopy "To a File...") ediff-patch-file - :help ,(purecopy "Apply a patch to a file"))) + '(menu-item "To a File..." ediff-patch-file + :help "Apply a patch to a file")) ;; define ediff miscellanea (define-key menu-bar-ediff-misc-menu [emultiframe] - `(menu-item ,(purecopy "Use separate control buffer frame") + '(menu-item "Use separate control buffer frame" ediff-toggle-multiframe - :help ,(purecopy "Switch between the single-frame presentation mode and the multi-frame mode") + :help "Switch between the single-frame presentation mode and the multi-frame mode" :button (:toggle . (eq (bound-and-true-p ediff-window-setup-function) #'ediff-setup-windows-multiframe)))) ;; FIXME: Port XEmacs's toolbar support! @@ -163,14 +163,14 @@ ;; :selected (if (featurep 'ediff-tbar) ;; (ediff-use-toolbar-p))] (define-key menu-bar-ediff-misc-menu [eregistry] - `(menu-item ,(purecopy "List Ediff Sessions") ediff-show-registry - :help ,(purecopy "List all active Ediff sessions; it is a convenient way to find and resume such a session"))) + '(menu-item "List Ediff Sessions" ediff-show-registry + :help "List all active Ediff sessions; it is a convenient way to find and resume such a session")) (define-key menu-bar-ediff-misc-menu [ediff-cust] - `(menu-item ,(purecopy "Customize Ediff") ediff-customize - :help ,(purecopy "Change some of the parameters that govern the behavior of Ediff"))) + '(menu-item "Customize Ediff" ediff-customize + :help "Change some of the parameters that govern the behavior of Ediff")) (define-key menu-bar-ediff-misc-menu [ediff-doc] - `(menu-item ,(purecopy "Ediff Manual") ediff-documentation - :help ,(purecopy "Bring up the Ediff manual"))) + '(menu-item "Ediff Manual" ediff-documentation + :help "Bring up the Ediff manual")) (provide 'ediff-hook) ;;; ediff-hook.el ends here diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el index 05f07c6e999..c335d3ee608 100644 --- a/lisp/vc/pcvs-defs.el +++ b/lisp/vc/pcvs-defs.el @@ -292,17 +292,17 @@ It is expected to call the function.") (defvar cvs-global-menu (let ((m (make-sparse-keymap "PCL-CVS"))) (define-key m [status] - `(menu-item ,(purecopy "Directory Status") cvs-status - :help ,(purecopy "A more verbose status of a workarea"))) + '(menu-item "Directory Status" cvs-status + :help "A more verbose status of a workarea")) (define-key m [checkout] - `(menu-item ,(purecopy "Checkout Module") cvs-checkout - :help ,(purecopy "Check out a module from the repository"))) + '(menu-item "Checkout Module" cvs-checkout + :help "Check out a module from the repository")) (define-key m [update] - `(menu-item ,(purecopy "Update Directory") cvs-update - :help ,(purecopy "Fetch updates from the repository"))) + '(menu-item "Update Directory" cvs-update + :help "Fetch updates from the repository")) (define-key m [examine] - `(menu-item ,(purecopy "Examine Directory") cvs-examine - :help ,(purecopy "Examine the current state of a workarea"))) + '(menu-item "Examine Directory" cvs-examine + :help "Examine the current state of a workarea")) (fset 'cvs-global-menu m)) "Global menu used by PCL-CVS.") diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 8fd1aa90b31..a090bfad125 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -121,9 +121,9 @@ An empty list disables VC altogether." ;; Note: we don't actually have a darcs back end yet. ;; Also, Arch is unsupported, and the Meta-CVS back end has been removed. ;; The Arch back end will be retrieved and fixed if it is ever required. -(defcustom vc-directory-exclusion-list (purecopy '("SCCS" "RCS" "CVS" "MCVS" +(defcustom vc-directory-exclusion-list '("SCCS" "RCS" "CVS" "MCVS" ".src" ".svn" ".git" ".hg" ".bzr" - "_MTN" "_darcs" "{arch}")) + "_MTN" "_darcs" "{arch}") "List of directory names to be ignored when walking directory trees." :type '(repeat string) :group 'vc) @@ -683,7 +683,7 @@ Before doing that, check if there are any old backups and get rid of them." (vc-dir-resynch-file file)))) (defvar vc-menu-entry - `(menu-item ,(purecopy "Version Control") vc-menu-map + '(menu-item "Version Control" vc-menu-map :filter vc-menu-map-filter)) (when (boundp 'menu-bar-tools-menu) diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 33377ce1cc8..12373d256c0 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -96,7 +96,7 @@ to use --brief and sets this variable to remember whether it worked." ;; for a registered backend without loading every backend. ;;;###autoload (defcustom vc-rcs-master-templates - (purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) + '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s") "Where to look for RCS master files. For a description of possible values, see `vc-check-master-templates'." :type '(choice (const :tag "Use standard RCS file names" diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el index 7e87849337a..8fa2ffdc5ba 100644 --- a/lisp/vc/vc-sccs.el +++ b/lisp/vc/vc-sccs.el @@ -77,7 +77,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." ;; for a registered backend without loading every backend. ;;;###autoload (defcustom vc-sccs-master-templates - (purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) + '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir) "Where to look for SCCS master files. For a description of possible values, see `vc-check-master-templates'." :type '(choice (const :tag "Use standard SCCS file names" diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el index ff19b0f7696..90bd8df544c 100644 --- a/lisp/vc/vc-src.el +++ b/lisp/vc/vc-src.el @@ -116,7 +116,7 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." ;; for a registered backend without loading every backend. ;;;###autoload (defcustom vc-src-master-templates - (purecopy '("%s.src/%s,v")) + '("%s.src/%s,v") "Where to look for SRC master files. For a description of possible values, see `vc-check-master-templates'." :type '(choice (const :tag "Use standard SRC file names" From b0afe306b748a3fa140cde580239d0f99669850a Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 9 Dec 2024 21:11:45 +0100 Subject: [PATCH 30/57] Don't call purecopy in dnd.el * lisp/dnd.el (dnd-protocol-alist): * lisp/pgtk-dnd.el (pgtk-dnd-types-alist, pgtk-dnd-known-types): * lisp/x-dnd.el (x-dnd-types-alist, x-dnd-known-types): Remove calls to purecopy. --- lisp/dnd.el | 10 ++++---- lisp/pgtk-dnd.el | 36 ++++++++++++++-------------- lisp/x-dnd.el | 61 ++++++++++++++++++++++++------------------------ 3 files changed, 53 insertions(+), 54 deletions(-) diff --git a/lisp/dnd.el b/lisp/dnd.el index bf8d3908619..99120c11f8d 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -42,11 +42,11 @@ ;;;###autoload (defcustom dnd-protocol-alist - `((,(purecopy "^file:///") . dnd-open-local-file) ; XDND format. - (,(purecopy "^file://[^/]") . dnd-open-file) ; URL with host - (,(purecopy "^file:/[^/]") . dnd-open-local-file) ; Old KDE, Motif, Sun - (,(purecopy "^file:[^/]") . dnd-open-local-file) ; MS-Windows - (,(purecopy "^\\(https?\\|ftp\\|nfs\\)://") . dnd-open-file)) + '(("^file:///" . dnd-open-local-file) ; XDND format. + ("^file://[^/]" . dnd-open-file) ; URL with host + ("^file:/[^/]" . dnd-open-local-file) ; Old KDE, Motif, Sun + ("^file:[^/]" . dnd-open-local-file) ; MS-Windows + ("^\\(https?\\|ftp\\|nfs\\)://" . dnd-open-file)) "The functions to call for different protocols when a drop is made. This variable is used by `dnd-handle-multiple-urls'. The list contains of (REGEXP . FUNCTION) pairs. diff --git a/lisp/pgtk-dnd.el b/lisp/pgtk-dnd.el index edc51320a79..526d0cfda95 100644 --- a/lisp/pgtk-dnd.el +++ b/lisp/pgtk-dnd.el @@ -55,15 +55,15 @@ The default value for this variable is `pgtk-dnd-default-test-function'." :group 'pgtk) (defcustom pgtk-dnd-types-alist - `((,(purecopy "text/uri-list") . pgtk-dnd-handle-uri-list) - (,(purecopy "FILE_NAME") . pgtk-dnd-handle-file-name) - (,(purecopy "UTF8_STRING") . pgtk-dnd-insert-utf8-text) - (,(purecopy "text/plain;charset=UTF-8") . pgtk-dnd-insert-utf8-text) - (,(purecopy "text/plain;charset=utf-8") . pgtk-dnd-insert-utf8-text) - (,(purecopy "text/plain") . dnd-insert-text) - (,(purecopy "COMPOUND_TEXT") . pgtk-dnd-insert-ctext) - (,(purecopy "STRING") . dnd-insert-text) - (,(purecopy "TEXT") . dnd-insert-text)) + `(("text/uri-list" . pgtk-dnd-handle-uri-list) + ("FILE_NAME" . pgtk-dnd-handle-file-name) + ("UTF8_STRING" . pgtk-dnd-insert-utf8-text) + ("text/plain;charset=UTF-8" . pgtk-dnd-insert-utf8-text) + ("text/plain;charset=utf-8" . pgtk-dnd-insert-utf8-text) + ("text/plain" . dnd-insert-text) + ("COMPOUND_TEXT" . pgtk-dnd-insert-ctext) + ("STRING" . dnd-insert-text) + ("TEXT" . dnd-insert-text)) "Which function to call to handle a drop of that type. If the type for the drop is not present, or the function is nil, the drop is rejected. The function takes three arguments, WINDOW, ACTION @@ -77,15 +77,15 @@ if drop is successful, nil if not." :group 'pgtk) (defcustom pgtk-dnd-known-types - (mapcar 'purecopy '("text/uri-list" - "FILE_NAME" - "UTF8_STRING" - "text/plain;charset=UTF-8" - "text/plain;charset=utf-8" - "text/plain" - "COMPOUND_TEXT" - "STRING" - "TEXT")) + '("text/uri-list" + "FILE_NAME" + "UTF8_STRING" + "text/plain;charset=UTF-8" + "text/plain;charset=utf-8" + "text/plain" + "COMPOUND_TEXT" + "STRING" + "TEXT") "The types accepted by default for dropped data. The types are chosen in the order they appear in the list." :version "22.1" diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 063b1dd6228..866ef7a5704 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -58,21 +58,21 @@ The default value for this variable is `x-dnd-default-test-function'." :group 'x) (defcustom x-dnd-types-alist - `((,(purecopy "text/uri-list") . x-dnd-handle-uri-list) - (,(purecopy "text/x-moz-url") . x-dnd-handle-moz-url) - (,(purecopy "_NETSCAPE_URL") . x-dnd-handle-uri-list) - (,(purecopy "FILE_NAME") . x-dnd-handle-file-name) - (,(purecopy "UTF8_STRING") . x-dnd-insert-utf8-text) - (,(purecopy "text/plain;charset=UTF-8") . x-dnd-insert-utf8-text) - (,(purecopy "text/plain;charset=utf-8") . x-dnd-insert-utf8-text) - (,(purecopy "text/unicode") . x-dnd-insert-utf16-text) - (,(purecopy "text/plain") . dnd-insert-text) - (,(purecopy "COMPOUND_TEXT") . x-dnd-insert-ctext) - (,(purecopy "STRING") . dnd-insert-text) - (,(purecopy "TEXT") . dnd-insert-text) - (,(purecopy "DndTypeFile") . x-dnd-handle-offix-file) - (,(purecopy "DndTypeFiles") . x-dnd-handle-offix-files) - (,(purecopy "DndTypeText") . dnd-insert-text)) + '(("text/uri-list" . x-dnd-handle-uri-list) + ("text/x-moz-url" . x-dnd-handle-moz-url) + ("_NETSCAPE_URL" . x-dnd-handle-uri-list) + ("FILE_NAME" . x-dnd-handle-file-name) + ("UTF8_STRING" . x-dnd-insert-utf8-text) + ("text/plain;charset=UTF-8" . x-dnd-insert-utf8-text) + ("text/plain;charset=utf-8" . x-dnd-insert-utf8-text) + ("text/unicode" . x-dnd-insert-utf16-text) + ("text/plain" . dnd-insert-text) + ("COMPOUND_TEXT" . x-dnd-insert-ctext) + ("STRING" . dnd-insert-text) + ("TEXT" . dnd-insert-text) + ("DndTypeFile" . x-dnd-handle-offix-file) + ("DndTypeFiles" . x-dnd-handle-offix-files) + ("DndTypeText" . dnd-insert-text)) "Functions to call to handle drag-and-drop of known types. If the type of the drop is not present in the alist, or the function corresponding to the type is nil, the drop of that @@ -90,22 +90,21 @@ excluding `ask') if drop is successful, nil if not." :group 'x) (defcustom x-dnd-known-types - (mapcar 'purecopy - '("XdndDirectSave0" - "text/uri-list" - "text/x-moz-url" - "_NETSCAPE_URL" - "FILE_NAME" - "UTF8_STRING" - "text/plain;charset=UTF-8" - "text/plain;charset=utf-8" - "text/unicode" - "text/plain" - "COMPOUND_TEXT" - "STRING" - "TEXT" - "DndTypeFile" - "DndTypeText")) + '("XdndDirectSave0" + "text/uri-list" + "text/x-moz-url" + "_NETSCAPE_URL" + "FILE_NAME" + "UTF8_STRING" + "text/plain;charset=UTF-8" + "text/plain;charset=utf-8" + "text/unicode" + "text/plain" + "COMPOUND_TEXT" + "STRING" + "TEXT" + "DndTypeFile" + "DndTypeText") "The types accepted by default for dropped data. The types are chosen in the order they appear in the list." :version "22.1" From 8da7086be6d0b0387c3ffbede062c4349045af70 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 9 Dec 2024 21:17:09 +0100 Subject: [PATCH 31/57] Don't call purecopy in emacs-lisp/*.el * lisp/emacs-lisp/byte-run.el (define-obsolete-face-alias) (make-obsolete-variable, make-obsolete): * lisp/emacs-lisp/cl-extra.el (cl-type-definition): * lisp/emacs-lisp/cl-preloaded.el (cl-assertion-failed): * lisp/emacs-lisp/cl-print.el (help-byte-code): * lisp/emacs-lisp/derived.el (define-derived-mode): * lisp/emacs-lisp/easy-mmode.el (define-minor-mode): * lisp/emacs-lisp/eldoc.el (eldoc-minor-mode-string): * lisp/emacs-lisp/gv.el (make-obsolete-generalized-variable): * lisp/emacs-lisp/lisp-mode.el (lisp-imenu-generic-expression): * lisp/emacs-lisp/loaddefs-gen.el (loaddefs-generate--parse-file): * lisp/emacs-lisp/warnings.el (warning-type-format): Remove calls to purecopy. --- lisp/emacs-lisp/byte-run.el | 6 +- lisp/emacs-lisp/cl-extra.el | 2 +- lisp/emacs-lisp/cl-preloaded.el | 2 +- lisp/emacs-lisp/cl-print.el | 2 +- lisp/emacs-lisp/derived.el | 6 +- lisp/emacs-lisp/easy-mmode.el | 2 +- lisp/emacs-lisp/eldoc.el | 2 +- lisp/emacs-lisp/gv.el | 2 +- lisp/emacs-lisp/lisp-mode.el | 110 ++++++++++++++++---------------- lisp/emacs-lisp/loaddefs-gen.el | 2 +- lisp/emacs-lisp/warnings.el | 2 +- 11 files changed, 69 insertions(+), 69 deletions(-) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index f1486f70634..c6ed967c893 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -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 @@ -578,7 +578,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 @@ -633,7 +633,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). diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 4108512b3fa..8d06b0712b4 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -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)) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 4b1bd2a9aff..7432cd6e4ce 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -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 diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index e8e6502e66f..0d96f87b3b3 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -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. diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index 2423426dca0..cc733c312cc 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -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)) diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 9c429828b13..73ab5bbed6c 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -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)) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 417c0145be4..aa1871ac482 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -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))) diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index fa9b437fcfd..cce15faa1e0 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -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 diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 4b89eb91387..dddeb8f53d9 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -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'.") diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el index 6e843f741d8..5578e10abf2 100644 --- a/lisp/emacs-lisp/loaddefs-gen.el +++ b/lisp/emacs-lisp/loaddefs-gen.el @@ -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)))) diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index b11e1ebeb70..192d2331bcc 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -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'.") From 5afc27335468ae4b6d99be91e37b3557f1bfddc8 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 9 Dec 2024 21:19:21 +0100 Subject: [PATCH 32/57] Don't call purecopy in mouse.el * lisp/mouse.el (context-menu-entry, mouse-buffer-menu-mode-groups) (x-fixed-font-alist): Remove calls to purecopy. --- lisp/mouse.el | 145 ++++++++++++++++++++++++-------------------------- 1 file changed, 70 insertions(+), 75 deletions(-) diff --git a/lisp/mouse.el b/lisp/mouse.el index 410e52b2ecb..8502d204a98 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -664,7 +664,7 @@ Some context functions add menu items below the separator." menu) (defvar context-menu-entry - `(menu-item ,(purecopy "Context Menu") ,(make-sparse-keymap) + `(menu-item "Context Menu" ,(make-sparse-keymap) :filter ,(lambda (_) (context-menu-map))) "Menu item that creates the context menu and can be bound to a mouse key.") @@ -2676,7 +2676,6 @@ a large number if you prefer a mixed multitude. The default is 4." :version "20.3") (defvar mouse-buffer-menu-mode-groups - (mapcar (lambda (arg) (cons (purecopy (car arg)) (purecopy (cdr arg)))) '(("Info\\|Help\\|Apropos\\|Man" . "Help") ("\\bVM\\b\\|\\bMH\\b\\|Message\\b\\|Mail\\|Group\\|Score\\|Summary\\|Article" . "Mail/News") @@ -2688,7 +2687,7 @@ a large number if you prefer a mixed multitude. The default is 4." ("\\blog\\b\\|diff\\|\\bvc\\b\\|cvs\\|Git\\|Annotate" . "Version Control") ("Threads\\|Memory\\|Disassembly\\|Breakpoints\\|Frames\\|Locals\\|Registers\\|Inferior I/O\\|Debugger" . "GDB") - ("Lisp" . "Lisp"))) + ("Lisp" . "Lisp")) "How to group various major modes together in \\[mouse-buffer-menu]. Each element has the form (REGEXP . GROUPNAME). If the major mode's name string matches REGEXP, use GROUPNAME instead.") @@ -2853,81 +2852,77 @@ and selects that window." (defvar x-fixed-font-alist (list - (purecopy "Font Menu") + "Font Menu" (cons - (purecopy "Misc") - (mapcar - (lambda (arg) (cons (purecopy (car arg)) (purecopy (cdr arg)))) - ;; For these, we specify the pixel height and width. + "Misc" + ;; For these, we specify the pixel height and width. '(("fixed" "fixed") - ("6x10" "-misc-fixed-medium-r-normal--10-*-*-*-c-60-iso8859-1" "6x10") - ("6x12" - "-misc-fixed-medium-r-semicondensed--12-*-*-*-c-60-iso8859-1" "6x12") - ("6x13" - "-misc-fixed-medium-r-semicondensed--13-*-*-*-c-60-iso8859-1" "6x13") - ("7x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-70-iso8859-1" "7x13") - ("7x14" "-misc-fixed-medium-r-normal--14-*-*-*-c-70-iso8859-1" "7x14") - ("8x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-80-iso8859-1" "8x13") - ("9x15" "-misc-fixed-medium-r-normal--15-*-*-*-c-90-iso8859-1" "9x15") - ("10x20" "-misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1" "10x20") - ("11x18" "-misc-fixed-medium-r-normal--18-*-*-*-c-110-iso8859-1" "11x18") - ("12x24" "-misc-fixed-medium-r-normal--24-*-*-*-c-120-iso8859-1" "12x24") - ("") - ("clean 5x8" - "-schumacher-clean-medium-r-normal--8-*-*-*-c-50-iso8859-1") - ("clean 6x8" - "-schumacher-clean-medium-r-normal--8-*-*-*-c-60-iso8859-1") - ("clean 8x8" - "-schumacher-clean-medium-r-normal--8-*-*-*-c-80-iso8859-1") - ("clean 8x10" - "-schumacher-clean-medium-r-normal--10-*-*-*-c-80-iso8859-1") - ("clean 8x14" - "-schumacher-clean-medium-r-normal--14-*-*-*-c-80-iso8859-1") - ("clean 8x16" - "-schumacher-clean-medium-r-normal--16-*-*-*-c-80-iso8859-1") - ("") - ("sony 8x16" "-sony-fixed-medium-r-normal--16-*-*-*-c-80-iso8859-1") - ;; We don't seem to have these; who knows what they are. - ;; ("fg-18" "fg-18") - ;; ("fg-25" "fg-25") - ("lucidasanstypewriter-12" "-b&h-lucidatypewriter-medium-r-normal-sans-*-120-*-*-*-*-iso8859-1") - ("lucidasanstypewriter-bold-14" "-b&h-lucidatypewriter-bold-r-normal-sans-*-140-*-*-*-*-iso8859-1") - ("lucidasanstypewriter-bold-24" - "-b&h-lucidatypewriter-bold-r-normal-sans-*-240-*-*-*-*-iso8859-1") - ;; ("lucidatypewriter-bold-r-24" "-b&h-lucidatypewriter-bold-r-normal-sans-24-240-75-75-m-140-iso8859-1") - ;; ("fixed-medium-20" "-misc-fixed-medium-*-*-*-20-*-*-*-*-*-*-*") - ))) + ("6x10" "-misc-fixed-medium-r-normal--10-*-*-*-c-60-iso8859-1" "6x10") + ("6x12" + "-misc-fixed-medium-r-semicondensed--12-*-*-*-c-60-iso8859-1" "6x12") + ("6x13" + "-misc-fixed-medium-r-semicondensed--13-*-*-*-c-60-iso8859-1" "6x13") + ("7x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-70-iso8859-1" "7x13") + ("7x14" "-misc-fixed-medium-r-normal--14-*-*-*-c-70-iso8859-1" "7x14") + ("8x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-80-iso8859-1" "8x13") + ("9x15" "-misc-fixed-medium-r-normal--15-*-*-*-c-90-iso8859-1" "9x15") + ("10x20" "-misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1" "10x20") + ("11x18" "-misc-fixed-medium-r-normal--18-*-*-*-c-110-iso8859-1" "11x18") + ("12x24" "-misc-fixed-medium-r-normal--24-*-*-*-c-120-iso8859-1" "12x24") + ("") + ("clean 5x8" + "-schumacher-clean-medium-r-normal--8-*-*-*-c-50-iso8859-1") + ("clean 6x8" + "-schumacher-clean-medium-r-normal--8-*-*-*-c-60-iso8859-1") + ("clean 8x8" + "-schumacher-clean-medium-r-normal--8-*-*-*-c-80-iso8859-1") + ("clean 8x10" + "-schumacher-clean-medium-r-normal--10-*-*-*-c-80-iso8859-1") + ("clean 8x14" + "-schumacher-clean-medium-r-normal--14-*-*-*-c-80-iso8859-1") + ("clean 8x16" + "-schumacher-clean-medium-r-normal--16-*-*-*-c-80-iso8859-1") + ("") + ("sony 8x16" "-sony-fixed-medium-r-normal--16-*-*-*-c-80-iso8859-1") + ;; We don't seem to have these; who knows what they are. + ;; ("fg-18" "fg-18") + ;; ("fg-25" "fg-25") + ("lucidasanstypewriter-12" "-b&h-lucidatypewriter-medium-r-normal-sans-*-120-*-*-*-*-iso8859-1") + ("lucidasanstypewriter-bold-14" "-b&h-lucidatypewriter-bold-r-normal-sans-*-140-*-*-*-*-iso8859-1") + ("lucidasanstypewriter-bold-24" + "-b&h-lucidatypewriter-bold-r-normal-sans-*-240-*-*-*-*-iso8859-1") + ;; ("lucidatypewriter-bold-r-24" "-b&h-lucidatypewriter-bold-r-normal-sans-24-240-75-75-m-140-iso8859-1") + ;; ("fixed-medium-20" "-misc-fixed-medium-*-*-*-20-*-*-*-*-*-*-*") + )) (cons - (purecopy "Courier") - (mapcar - (lambda (arg) (cons (purecopy (car arg)) (purecopy (cdr arg)))) - ;; For these, we specify the point height. - '(("8" "-adobe-courier-medium-r-normal--*-80-*-*-m-*-iso8859-1") - ("10" "-adobe-courier-medium-r-normal--*-100-*-*-m-*-iso8859-1") - ("12" "-adobe-courier-medium-r-normal--*-120-*-*-m-*-iso8859-1") - ("14" "-adobe-courier-medium-r-normal--*-140-*-*-m-*-iso8859-1") - ("18" "-adobe-courier-medium-r-normal--*-180-*-*-m-*-iso8859-1") - ("24" "-adobe-courier-medium-r-normal--*-240-*-*-m-*-iso8859-1") - ("8 bold" "-adobe-courier-bold-r-normal--*-80-*-*-m-*-iso8859-1") - ("10 bold" "-adobe-courier-bold-r-normal--*-100-*-*-m-*-iso8859-1") - ("12 bold" "-adobe-courier-bold-r-normal--*-120-*-*-m-*-iso8859-1") - ("14 bold" "-adobe-courier-bold-r-normal--*-140-*-*-m-*-iso8859-1") - ("18 bold" "-adobe-courier-bold-r-normal--*-180-*-*-m-*-iso8859-1") - ("24 bold" "-adobe-courier-bold-r-normal--*-240-*-*-m-*-iso8859-1") - ("8 slant" "-adobe-courier-medium-o-normal--*-80-*-*-m-*-iso8859-1") - ("10 slant" "-adobe-courier-medium-o-normal--*-100-*-*-m-*-iso8859-1") - ("12 slant" "-adobe-courier-medium-o-normal--*-120-*-*-m-*-iso8859-1") - ("14 slant" "-adobe-courier-medium-o-normal--*-140-*-*-m-*-iso8859-1") - ("18 slant" "-adobe-courier-medium-o-normal--*-180-*-*-m-*-iso8859-1") - ("24 slant" "-adobe-courier-medium-o-normal--*-240-*-*-m-*-iso8859-1") - ("8 bold slant" "-adobe-courier-bold-o-normal--*-80-*-*-m-*-iso8859-1") - ("10 bold slant" "-adobe-courier-bold-o-normal--*-100-*-*-m-*-iso8859-1") - ("12 bold slant" "-adobe-courier-bold-o-normal--*-120-*-*-m-*-iso8859-1") - ("14 bold slant" "-adobe-courier-bold-o-normal--*-140-*-*-m-*-iso8859-1") - ("18 bold slant" "-adobe-courier-bold-o-normal--*-180-*-*-m-*-iso8859-1") - ("24 bold slant" "-adobe-courier-bold-o-normal--*-240-*-*-m-*-iso8859-1") - )))) + "Courier" + ;; For these, we specify the point height. + '(("8" "-adobe-courier-medium-r-normal--*-80-*-*-m-*-iso8859-1") + ("10" "-adobe-courier-medium-r-normal--*-100-*-*-m-*-iso8859-1") + ("12" "-adobe-courier-medium-r-normal--*-120-*-*-m-*-iso8859-1") + ("14" "-adobe-courier-medium-r-normal--*-140-*-*-m-*-iso8859-1") + ("18" "-adobe-courier-medium-r-normal--*-180-*-*-m-*-iso8859-1") + ("24" "-adobe-courier-medium-r-normal--*-240-*-*-m-*-iso8859-1") + ("8 bold" "-adobe-courier-bold-r-normal--*-80-*-*-m-*-iso8859-1") + ("10 bold" "-adobe-courier-bold-r-normal--*-100-*-*-m-*-iso8859-1") + ("12 bold" "-adobe-courier-bold-r-normal--*-120-*-*-m-*-iso8859-1") + ("14 bold" "-adobe-courier-bold-r-normal--*-140-*-*-m-*-iso8859-1") + ("18 bold" "-adobe-courier-bold-r-normal--*-180-*-*-m-*-iso8859-1") + ("24 bold" "-adobe-courier-bold-r-normal--*-240-*-*-m-*-iso8859-1") + ("8 slant" "-adobe-courier-medium-o-normal--*-80-*-*-m-*-iso8859-1") + ("10 slant" "-adobe-courier-medium-o-normal--*-100-*-*-m-*-iso8859-1") + ("12 slant" "-adobe-courier-medium-o-normal--*-120-*-*-m-*-iso8859-1") + ("14 slant" "-adobe-courier-medium-o-normal--*-140-*-*-m-*-iso8859-1") + ("18 slant" "-adobe-courier-medium-o-normal--*-180-*-*-m-*-iso8859-1") + ("24 slant" "-adobe-courier-medium-o-normal--*-240-*-*-m-*-iso8859-1") + ("8 bold slant" "-adobe-courier-bold-o-normal--*-80-*-*-m-*-iso8859-1") + ("10 bold slant" "-adobe-courier-bold-o-normal--*-100-*-*-m-*-iso8859-1") + ("12 bold slant" "-adobe-courier-bold-o-normal--*-120-*-*-m-*-iso8859-1") + ("14 bold slant" "-adobe-courier-bold-o-normal--*-140-*-*-m-*-iso8859-1") + ("18 bold slant" "-adobe-courier-bold-o-normal--*-180-*-*-m-*-iso8859-1") + ("24 bold slant" "-adobe-courier-bold-o-normal--*-240-*-*-m-*-iso8859-1") + ))) "X fonts suitable for use in Emacs.") (declare-function generate-fontset-menu "fontset" ()) @@ -3653,7 +3648,7 @@ is copied instead of being cut." (global-set-key [S-down-mouse-1] #'mouse-appearance-menu)) ;; C-down-mouse-2 is bound in facemenu.el. (global-set-key [C-down-mouse-3] - `(menu-item ,(purecopy "Menu Bar") ignore + `(menu-item "Menu Bar" ignore :filter ,(lambda (_) (if (zerop (or (frame-parameter nil 'menu-bar-lines) 0)) (mouse-menu-bar-map) From d6aeb1a2606e1dece860f2b35623245d9eb865c3 Mon Sep 17 00:00:00 2001 From: Stefan Kangas Date: Mon, 9 Dec 2024 21:26:25 +0100 Subject: [PATCH 33/57] Delete remaining calls to purecopy * lisp/button.el (default-button): * lisp/calendar/holidays.el (holiday-solar-holidays) (holiday-bahai-holidays, holiday-islamic-holidays) (holiday-christian-holidays, holiday-hebrew-holidays) (holiday-oriental-holidays, holiday-general-holidays): * lisp/comint.el (comint-file-name-prefix): * lisp/composite.el (unicode-category-table): * lisp/cus-face.el (custom-declare-face): * lisp/custom.el (custom-add-load, custom-add-package-version) (custom-add-version, custom-add-link, custom-declare-group) (custom-declare-variable): * lisp/dired.el (dired-listing-switches): * lisp/epa-hook.el (epa-file-name-regexp): * lisp/faces.el (x-font-regexp, x-font-regexp-head) (x-font-regexp-slant, x-font-regexp-weight, ) (set-face-attribute, set-face-documentation, face-x-resources) (face-font-registry-alternatives, face-font-family-alternatives) (term-file-prefix): * lisp/find-file.el (ff-special-constructs): * lisp/format.el (format-alist): * lisp/help.el (help-for-help): * lisp/image-file.el (image-file-name-extensions): * lisp/info.el: * lisp/isearch.el (isearch-help-for-help-internal) (search-whitespace-regexp): * lisp/jka-cmpr-hook.el (jka-compr-load-suffixes) (jka-compr-mode-alist-additions) (jka-compr-compression-info-list, jka-compr-build-file-regexp): * lisp/language/ethiopic.el (font-ccl-encoder-alist): * lisp/language/korea-util.el (default-korean-keyboard): * lisp/language/tibetan.el (tibetan-precomposition-rule-regexp) (tibetan-precomposed-regexp): * lisp/locate.el (locate-ls-subdir-switches): * lisp/lpr.el (lpr-command): * lisp/mail/rmail.el (rmail-secondary-file-regexp) (rmail-secondary-file-directory, rmail-highlighted-headers) (rmail-ignored-headers, rmail-spool-directory, rmail-file-name): * lisp/mail/sendmail.el (mail-default-directory) (mail-signature-file, mail-citation-prefix-regexp) (mail-personal-alias-file, mail-header-separator): * lisp/menu-bar.el (yank-menu): * lisp/net/eudc.el (eudc-tools-menu): * lisp/newcomment.el (comment-padding, comment-end): * lisp/obsolete/autoload.el (autoload-generate-file-autoloads): * lisp/progmodes/hideshow.el (hs-special-modes-alist): * lisp/ps-print.el (ps-page-dimensions-database): * lisp/rfn-eshadow.el (file-name-shadow-tty-properties): * lisp/shell.el (shell-dumb-shell-regexp): * lisp/simple.el (overwrite-mode-binary, overwrite-mode-textual) (mark-inactive, shell-command-switch) (next-error-overlay-arrow-position): * lisp/subr.el (package--builtin-versions, eval-after-load): * lisp/tab-bar.el ([tab-bar]): * lisp/term/pgtk-win.el (x-gtk-stock-map): * lisp/term/x-win.el (x-gtk-stock-map): * lisp/tool-bar.el ([tool-bar]): * lisp/widget.el (define-widget): Remove calls to purecopy. --- lisp/button.el | 2 +- lisp/calendar/holidays.el | 21 ++++------- lisp/comint.el | 2 +- lisp/composite.el | 10 ++--- lisp/cus-face.el | 4 +- lisp/custom.el | 18 ++++----- lisp/dired.el | 2 +- lisp/epa-hook.el | 2 +- lisp/faces.el | 39 +++++++------------ lisp/find-file.el | 2 +- lisp/format.el | 27 +++++++------ lisp/help.el | 2 +- lisp/image-file.el | 2 +- lisp/info.el | 6 +-- lisp/isearch.el | 4 +- lisp/jka-cmpr-hook.el | 38 +++++++++---------- lisp/language/ethiopic.el | 2 +- lisp/language/korea-util.el | 6 +-- lisp/language/tibetan.el | 14 +++---- lisp/locate.el | 2 +- lisp/lpr.el | 3 +- lisp/mail/rmail.el | 14 +++---- lisp/mail/sendmail.el | 10 ++--- lisp/menu-bar.el | 4 +- lisp/net/eudc.el | 24 ++++++------ lisp/newcomment.el | 4 +- lisp/obsolete/autoload.el | 3 +- lisp/progmodes/hideshow.el | 3 +- lisp/ps-print.el | 75 ++++++++++++++++++------------------- lisp/rfn-eshadow.el | 2 +- lisp/shell.el | 2 +- lisp/simple.el | 10 ++--- lisp/subr.el | 4 +- lisp/tab-bar.el | 2 +- lisp/term/pgtk-win.el | 4 +- lisp/term/x-win.el | 4 +- lisp/tool-bar.el | 4 +- lisp/widget.el | 2 +- 38 files changed, 172 insertions(+), 207 deletions(-) diff --git a/lisp/button.el b/lisp/button.el index 1a732bee98b..9f0d2ca2cef 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -97,7 +97,7 @@ Disabling the mode will remove all buttons in the current buffer." (put 'default-button 'type 'button) ;; `action' may be either a function to call, or a marker to go to. (put 'default-button 'action #'ignore) -(put 'default-button 'help-echo (purecopy "mouse-2, RET: Push this button")) +(put 'default-button 'help-echo "mouse-2, RET: Push this button") ;; Make overlay buttons go away if their underlying text is deleted. (put 'default-button 'evaporate t) ;; Prevent insertions adjacent to text-property buttons from diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index c7499938c6a..81c82e01a5f 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -44,7 +44,6 @@ ;;;###autoload (defcustom holiday-general-holidays - (mapcar 'purecopy '((holiday-fixed 1 1 "New Year's Day") (holiday-float 1 1 3 "Martin Luther King Day") (holiday-fixed 2 2 "Groundhog Day") @@ -61,7 +60,7 @@ (holiday-float 10 1 2 "Columbus Day") (holiday-fixed 10 31 "Halloween") (holiday-fixed 11 11 "Veteran's Day") - (holiday-float 11 4 4 "Thanksgiving"))) + (holiday-float 11 4 4 "Thanksgiving")) "General holidays. Default value is for the United States. See the documentation for `calendar-holidays' for details." :type 'sexp) @@ -70,7 +69,6 @@ See the documentation for `calendar-holidays' for details." ;;;###autoload (defcustom holiday-oriental-holidays - (mapcar 'purecopy '((holiday-chinese-new-year) (if calendar-chinese-all-holidays-flag (append @@ -81,7 +79,7 @@ See the documentation for `calendar-holidays' for details." (holiday-chinese 8 15 "Mid-Autumn Festival") (holiday-chinese 9 9 "Double Ninth Festival") (holiday-chinese-winter-solstice) - )))) + ))) "Oriental holidays. See the documentation for `calendar-holidays' for details." :version "23.1" ; added more holidays @@ -107,14 +105,13 @@ See the documentation for `calendar-holidays' for details." ;;;###autoload (defcustom holiday-hebrew-holidays - (mapcar 'purecopy '((holiday-hebrew-passover) (holiday-hebrew-rosh-hashanah) (holiday-hebrew-hanukkah) (if calendar-hebrew-all-holidays-flag (append (holiday-hebrew-tisha-b-av) - (holiday-hebrew-misc))))) + (holiday-hebrew-misc)))) "Jewish holidays. See the documentation for `calendar-holidays' for details." :type 'sexp @@ -125,7 +122,6 @@ See the documentation for `calendar-holidays' for details." ;;;###autoload (defcustom holiday-christian-holidays - (mapcar 'purecopy '((holiday-easter-etc) ; respects calendar-christian-all-holidays-flag (holiday-fixed 12 25 "Christmas") (if calendar-christian-all-holidays-flag @@ -134,7 +130,7 @@ See the documentation for `calendar-holidays' for details." (holiday-julian 12 25 "Christmas (Julian calendar)") (holiday-greek-orthodox-easter) (holiday-fixed 8 15 "Assumption") - (holiday-advent 0 "Advent"))))) + (holiday-advent 0 "Advent")))) "Christian holidays. See the documentation for `calendar-holidays' for details." :type 'sexp) @@ -143,7 +139,6 @@ See the documentation for `calendar-holidays' for details." ;;;###autoload (defcustom holiday-islamic-holidays - (mapcar 'purecopy '((holiday-islamic-new-year) (holiday-islamic 9 1 "Ramadan Begins") (if calendar-islamic-all-holidays-flag @@ -154,7 +149,7 @@ See the documentation for `calendar-holidays' for details." (holiday-islamic 8 15 "Shab-e-Bara't") (holiday-islamic 9 27 "Shab-e Qadr") (holiday-islamic 10 1 "Id-al-Fitr") - (holiday-islamic 12 10 "Id-al-Adha"))))) + (holiday-islamic 12 10 "Id-al-Adha")))) "Islamic holidays. See the documentation for `calendar-holidays' for details." :type 'sexp) @@ -163,7 +158,6 @@ See the documentation for `calendar-holidays' for details." ;;;###autoload (defcustom holiday-bahai-holidays - (mapcar 'purecopy '((holiday-bahai-new-year) (holiday-bahai-ridvan) ; respects calendar-bahai-all-holidays-flag (holiday-fixed 5 23 "Declaration of the Báb") @@ -174,7 +168,7 @@ See the documentation for `calendar-holidays' for details." (if calendar-bahai-all-holidays-flag (append (holiday-fixed 11 26 "Day of the Covenant") - (holiday-fixed 11 28 "Ascension of `Abdu’l-Bahá"))))) + (holiday-fixed 11 28 "Ascension of `Abdu’l-Bahá")))) "Bahá’í holidays. See the documentation for `calendar-holidays' for details." :type 'sexp) @@ -183,7 +177,6 @@ See the documentation for `calendar-holidays' for details." ;;;###autoload (defcustom holiday-solar-holidays - (mapcar 'purecopy '((solar-equinoxes-solstices) (holiday-sexp calendar-daylight-savings-starts (format "Daylight Saving Time Begins %s" @@ -194,7 +187,7 @@ See the documentation for `calendar-holidays' for details." (format "Daylight Saving Time Ends %s" (solar-time-string (/ calendar-daylight-savings-ends-time (float 60)) - calendar-daylight-time-zone-name))))) + calendar-daylight-time-zone-name)))) "Sun-related holidays. See the documentation for `calendar-holidays' for details." :type 'sexp) diff --git a/lisp/comint.el b/lisp/comint.el index d966625550c..c21f0d77f2c 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -3234,7 +3234,7 @@ Note that this applies to `comint-dynamic-complete-filename' only." :group 'comint-completion) ;;;###autoload -(defvar comint-file-name-prefix (purecopy "") +(defvar comint-file-name-prefix "" "Prefix prepended to absolute file names taken from process input. This is used by Comint's and shell's completion functions, and by shell's directory tracking functions.") diff --git a/lisp/composite.el b/lisp/composite.el index 326e8f10aee..73ec8b1813c 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -755,7 +755,7 @@ All non-spacing characters have this function in ;; Allow for bootstrapping without uni-*.el. (when unicode-category-table - (let ((elt `([,(purecopy "\\c.\\c^+") 1 compose-gstring-for-graphic] + (let ((elt `(["\\c.\\c^+" 1 compose-gstring-for-graphic] [nil 0 compose-gstring-for-graphic]))) (map-char-table #'(lambda (key val) @@ -764,7 +764,7 @@ All non-spacing characters have this function in unicode-category-table)) ;; for dotted-circle (aset composition-function-table #x25CC - `([,(purecopy ".\\c^") 0 compose-gstring-for-dotted-circle])) + `([".\\c^" 0 compose-gstring-for-dotted-circle])) ;; For prettier display of fractions (set-char-table-range composition-function-table @@ -772,10 +772,10 @@ All non-spacing characters have this function in ;; We use font-shape-gstring so that if the font doesn't support ;; fractional display, the characters are shown separately, not as ;; a composed cluster. - (list (vector (purecopy "[1-9][0-9][0-9]\u2044[0-9]+") + (list (vector "[1-9][0-9][0-9]\u2044[0-9]+" 3 'font-shape-gstring) - (vector (purecopy "[1-9][0-9]\u2044[0-9]+") 2 'font-shape-gstring) - (vector (purecopy "[1-9]\u2044[0-9]+") 1 'font-shape-gstring)))) + (vector "[1-9][0-9]\u2044[0-9]+" 2 'font-shape-gstring) + (vector "[1-9]\u2044[0-9]+" 1 'font-shape-gstring)))) (defun compose-gstring-for-terminal (gstring _direction) "Compose glyph-string GSTRING for terminal display. diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 478092c30cb..e700b0d0b90 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -35,10 +35,10 @@ (not (documentation-stringp doc))) (error "Invalid (or missing) doc string %S" doc)) (unless (get face 'face-defface-spec) - (face-spec-set face (purecopy spec) 'face-defface-spec) + (face-spec-set face spec 'face-defface-spec) (push (cons 'defface face) current-load-list) (when doc - (set-face-documentation face (purecopy doc))) + (set-face-documentation face doc)) (custom-handle-all-keywords face args 'custom-face) (run-hooks 'custom-define-hook)) face) diff --git a/lisp/custom.el b/lisp/custom.el index 63d2eea4d94..bb3c0740cc0 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -166,7 +166,7 @@ not the default value itself. DEFAULT is stored as SYMBOL's standard value, in SYMBOL's property `standard-value'. At the same time, SYMBOL's property `force-value' is set to nil, as the value is no longer rogue." - (put symbol 'standard-value (purecopy (list default))) + (put symbol 'standard-value (list default)) ;; Maybe this option was rogue in an earlier version. It no longer is. (when (get symbol 'force-value) (put symbol 'force-value nil)) @@ -207,7 +207,7 @@ set to nil, as the value is no longer rogue." (when (memq value '(permanent permanent-only)) (put symbol 'permanent-local t))) ((eq keyword :type) - (put symbol 'custom-type (purecopy value))) + (put symbol 'custom-type value)) ((eq keyword :options) (if (get symbol 'custom-options) ;; Slow safe code to avoid duplicates. @@ -488,7 +488,7 @@ information." (setq members (cdr members))) (when doc ;; This text doesn't get into DOC. - (put symbol 'group-documentation (purecopy doc))) + (put symbol 'group-documentation doc)) (while args (let ((arg (car args))) (setq args (cdr args)) @@ -500,7 +500,7 @@ information." (error "Keyword %s is missing an argument" keyword)) (setq args (cdr args)) (cond ((eq keyword :prefix) - (put symbol 'custom-prefix (purecopy value))) + (put symbol 'custom-prefix value)) (t (custom-handle-keyword symbol keyword value 'custom-group)))))) @@ -587,8 +587,6 @@ Third argument TYPE is the custom option type." (defun custom-handle-keyword (symbol keyword value type) "For customization option SYMBOL, handle KEYWORD with VALUE. Fourth argument TYPE is the custom option type." - (if purify-flag - (setq value (purecopy value))) (cond ((eq keyword :group) (custom-add-to-group value symbol type)) ((eq keyword :version) @@ -641,22 +639,22 @@ For other custom types, this has no effect." "To the custom option SYMBOL add the link WIDGET." (let ((links (get symbol 'custom-links))) (unless (member widget links) - (put symbol 'custom-links (cons (purecopy widget) links))))) + (put symbol 'custom-links (cons widget links))))) (defun custom-add-version (symbol version) "To the custom option SYMBOL add the version VERSION." - (put symbol 'custom-version (purecopy version))) + (put symbol 'custom-version version)) (defun custom-add-package-version (symbol version) "To the custom option SYMBOL add the package version VERSION." - (put symbol 'custom-package-version (purecopy version))) + (put symbol 'custom-package-version version)) (defun custom-add-load (symbol load) "To the custom option SYMBOL add the dependency LOAD. LOAD should be either a library file name, or a feature name." (let ((loads (get symbol 'custom-loads))) (unless (member load loads) - (put symbol 'custom-loads (cons (purecopy load) loads))))) + (put symbol 'custom-loads (cons load loads))))) (defun custom-autoload (symbol load &optional noset) "Mark SYMBOL as autoloaded custom variable and add dependency LOAD. diff --git a/lisp/dired.el b/lisp/dired.el index 9895229694a..6dd88c330ee 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -60,7 +60,7 @@ :group 'dired) ;;;###autoload -(defcustom dired-listing-switches (purecopy "-al") +(defcustom dired-listing-switches "-al" "Switches passed to `ls' for Dired. MUST contain the `l' option. May contain all other options that don't contradict `-l'; may contain even `F', `b', `i' and `s'. See also the variable diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el index 458db3e0323..ab65dab132e 100644 --- a/lisp/epa-hook.el +++ b/lisp/epa-hook.el @@ -35,7 +35,7 @@ (if (fboundp 'epa-file-name-regexp-update) (epa-file-name-regexp-update))) -(defcustom epa-file-name-regexp (purecopy "\\.gpg\\(~\\|\\.~[0-9]+~\\)?\\'") +(defcustom epa-file-name-regexp "\\.gpg\\(~\\|\\.~[0-9]+~\\)?\\'" "Regexp which matches filenames to be encrypted with GnuPG. If you set this outside Custom while epa-file is already enabled, diff --git a/lisp/faces.el b/lisp/faces.el index f8ec0f1a187..5abccde45c9 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -25,7 +25,7 @@ ;;; Code: -(defcustom term-file-prefix (purecopy "term/") +(defcustom term-file-prefix "term/" "If non-nil, Emacs startup performs terminal-specific initialization. It does this by: (load (concat term-file-prefix (getenv \"TERM\"))) @@ -99,7 +99,6 @@ a font height that isn't optimal." ;; unavailable, and we fall back on the courier and helv families, ;; which are generally available. (defcustom face-font-family-alternatives - (mapcar (lambda (arg) (mapcar 'purecopy arg)) '(("Monospace" "Cascadia Code" "Lucida Console" "courier" "fixed") ;; Monospace Serif is an Emacs invention, intended to work around @@ -137,7 +136,7 @@ a font height that isn't optimal." ;; https://en.wikipedia.org/wiki/List_of_typefaces_included_with_Microsoft_Windows "Calibri" "Tahoma" "Lucida Sans Unicode" "helv" "helvetica" "arial" "fixed") - ("helv" "helvetica" "arial" "fixed"))) + ("helv" "helvetica" "arial" "fixed")) "Alist of alternative font family names. Each element has the form (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...). If fonts of family FAMILY can't be loaded, try ALTERNATIVE1, then @@ -152,7 +151,6 @@ ALTERNATIVE2 etc." ;; This is defined originally in xfaces.c. (defcustom face-font-registry-alternatives - (mapcar (lambda (arg) (mapcar 'purecopy arg)) (if (featurep 'w32) '(("iso8859-1" "ms-oemlatin") ("gb2312.1980" "gb2312" "gbk" "gb18030") @@ -162,7 +160,7 @@ ALTERNATIVE2 etc." '(("gb2312.1980" "gb2312.80&gb8565.88" "gbk" "gb18030") ("jisx0208.1990" "jisx0208.1983" "jisx0208.1978") ("ksc5601.1989" "ksx1001.1992" "ksc5601.1987") - ("muletibetan-2" "muletibetan-0")))) + ("muletibetan-2" "muletibetan-0"))) "Alist of alternative font registry names. Each element has the form (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...). If fonts of registry REGISTRY can be loaded, font selection @@ -354,11 +352,6 @@ is either `foreground-color', `background-color', or a keyword." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defcustom face-x-resources - (mapcar - (lambda (arg) - ;; FIXME; can we purecopy some of the conses too? - (cons (car arg) - (cons (purecopy (car (cdr arg))) (purecopy (cdr (cdr arg)))))) '((:family (".attributeFamily" . "Face.AttributeFamily")) (:foundry (".attributeFoundry" . "Face.AttributeFoundry")) (:width (".attributeWidth" . "Face.AttributeWidth")) @@ -381,7 +374,7 @@ is either `foreground-color', `background-color', or a keyword." (:bold (".attributeBold" . "Face.AttributeBold")) (:italic (".attributeItalic" . "Face.AttributeItalic")) (:font (".attributeFont" . "Face.AttributeFont")) - (:inherit (".attributeInherit" . "Face.AttributeInherit")))) + (:inherit (".attributeInherit" . "Face.AttributeInherit"))) "List of X resources and classes for face attributes. Each element has the form (ATTRIBUTE ENTRY1 ENTRY2...) where ATTRIBUTE is the name of a face attribute, and each ENTRY is a cons of the form @@ -664,7 +657,7 @@ If FACE is a face-alias, get the documentation for the target face." (defun set-face-documentation (face string) "Set the documentation string for FACE to STRING." ;; Perhaps the text should go in DOC. - (put face 'face-documentation (purecopy string))) + (put face 'face-documentation string)) (define-obsolete-function-alias 'face-doc-string #'face-documentation "29.1") @@ -863,7 +856,6 @@ setting `:weight' to `bold', and a value of t for `:italic' is equivalent to setting `:slant' to `italic'. But if `:weight' is specified in the face spec, `:bold' is ignored, and if `:slant' is specified, `:italic' is ignored." - (setq args (purecopy args)) (let ((where (if (null frame) 0 frame)) (spec args) family foundry orig-family orig-foundry) @@ -893,15 +885,13 @@ is specified, `:italic' is ignored." (setq family orig-family) (setq foundry orig-foundry))) (when (or (stringp family) (eq family 'unspecified)) - (internal-set-lisp-face-attribute face :family (purecopy family) - where)) + (internal-set-lisp-face-attribute face :family family where)) (when (or (stringp foundry) (eq foundry 'unspecified)) - (internal-set-lisp-face-attribute face :foundry (purecopy foundry) - where))) + (internal-set-lisp-face-attribute face :foundry foundry where))) (while args (unless (memq (car args) '(:family :foundry)) (internal-set-lisp-face-attribute face (car args) - (purecopy (cadr args)) + (cadr args) where)) (setq args (cddr args))))) @@ -3192,16 +3182,15 @@ This face is used by `show-paren-mode'." (encoding "[^-]+") ) (setq x-font-regexp - (purecopy (concat "\\`\\*?[-?*]" + (concat "\\`\\*?[-?*]" foundry - family - weight\? - slant\? - swidth - adstyle - pixelsize - pointsize - resx - resy - spacing - avgwidth - - registry - encoding "\\*?\\'" - ))) + registry - encoding "\\*?\\'")) (setq x-font-regexp-head - (purecopy (concat "\\`[-?*]" foundry - family - weight\? - slant\? - "\\([-*?]\\|\\'\\)"))) - (setq x-font-regexp-slant (purecopy (concat - slant -))) - (setq x-font-regexp-weight (purecopy (concat - weight -))) + (concat "\\`[-?*]" foundry - family - weight\? - slant\? + "\\([-*?]\\|\\'\\)")) + (setq x-font-regexp-slant (concat - slant -)) + (setq x-font-regexp-weight (concat - weight -)) nil) diff --git a/lisp/find-file.el b/lisp/find-file.el index 65e980d38fc..ad1a450c25e 100644 --- a/lisp/find-file.el +++ b/lisp/find-file.el @@ -182,7 +182,7 @@ To override this, give an argument to `ff-find-other-file'." ;;;###autoload (defcustom ff-special-constructs ;; C/C++ include, for NeXTstep too - `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") . + `(("^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]" . ,(lambda () (match-string 2)))) ;; We include `ff-treat-as-special' documentation here so that autoload ;; can make it available to be read prior to loading this file. diff --git a/lisp/format.el b/lisp/format.el index fc44436874b..350d6725c69 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -65,27 +65,26 @@ (put 'buffer-auto-save-file-format 'permanent-local t) (defvar format-alist - ;; FIXME: maybe each item can be purecopied instead of just the strings. - `((text/enriched ,(purecopy "Extended MIME text/enriched format.") - ,(purecopy "Content-[Tt]ype:[ \t]*text/enriched") + `((text/enriched "Extended MIME text/enriched format." + "Content-[Tt]ype:[ \t]*text/enriched" enriched-decode enriched-encode t enriched-mode) - (plain ,(purecopy "ISO 8859-1 standard format, no text properties.") + (plain "ISO 8859-1 standard format, no text properties." ;; Plain only exists so that there is an obvious neutral choice in ;; the completion list. nil nil nil nil nil) - (TeX ,(purecopy "TeX (encoding)") + (TeX "TeX (encoding)" nil iso-tex2iso iso-iso2tex t nil) - (gtex ,(purecopy "German TeX (encoding)") + (gtex "German TeX (encoding)" nil iso-gtex2iso iso-iso2gtex t nil) - (html ,(purecopy "HTML/SGML \"ISO 8879:1986//ENTITIES Added Latin 1//EN\" (encoding)") + (html "HTML/SGML \"ISO 8879:1986//ENTITIES Added Latin 1//EN\" (encoding)" nil iso-sgml2iso iso-iso2sgml t nil) - (rot13 ,(purecopy "rot13") + (rot13 "rot13" nil rot13-region rot13-region t nil) - (duden ,(purecopy "Duden Ersatzdarstellung") + (duden "Duden Ersatzdarstellung" nil ;; FROM-FN used to call the "diac" command which is not widely ;; available and apparently not under a free software license: @@ -93,14 +92,14 @@ ;; Reliable round-trip conversion is not possible anyway and ;; would be by heuristic method, so make it write-only for now. iso-cvt-write-only iso-iso2duden t nil) - (de646 ,(purecopy "German ASCII (ISO 646)") + (de646 "German ASCII (ISO 646)" nil - ,(purecopy "iconv -f iso646-de -t utf-8") - ,(purecopy "iconv -f utf-8 -t iso646-de") t nil) - (denet ,(purecopy "net German") + "iconv -f iso646-de -t utf-8" + "iconv -f utf-8 -t iso646-de" t nil) + (denet "net German" nil iso-german iso-cvt-read-only t nil) - (esnet ,(purecopy "net Spanish") + (esnet "net Spanish" nil iso-spanish iso-cvt-read-only t nil)) "List of information about understood file formats. diff --git a/lisp/help.el b/lisp/help.el index ef0b7ffc01d..9ec3466d823 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -395,7 +395,7 @@ Do not call this in the scope of `with-help-window'." (defalias 'help #'help-for-help) (make-help-screen help-for-help - (purecopy "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or ?") + "Type a help option: [abcCdefFgiIkKlLmnprstvw.] C-[cdefmnoptw] or ?" (concat "(Type " (help--key-description-fontified (kbd "")) diff --git a/lisp/image-file.el b/lisp/image-file.el index 57e9799dc34..efc4ec97528 100644 --- a/lisp/image-file.el +++ b/lisp/image-file.el @@ -37,7 +37,7 @@ ;;;###autoload (defcustom image-file-name-extensions - (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg" "webp")) + '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg" "webp") "A list of image-file filename extensions. Filenames having one of these extensions are considered image files, in addition to those matching `image-file-name-regexps'. diff --git a/lisp/info.el b/lisp/info.el index 9025fd13363..0a471795326 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -830,7 +830,7 @@ Select the window used, if it has been made." (select-window window)))) -;;;###autoload (put 'info 'info-file (purecopy "emacs")) +;;;###autoload (put 'info 'info-file "emacs") ;;;###autoload (defun info (&optional file-or-node buffer) "Enter Info, the documentation browser. @@ -4757,7 +4757,7 @@ in the first element of the returned list (which is treated specially in (cdr where)) where))) -;;;###autoload (put 'Info-goto-emacs-command-node 'info-file (purecopy "emacs")) +;;;###autoload (put 'Info-goto-emacs-command-node 'info-file "emacs") ;;;###autoload (defun Info-goto-emacs-command-node (command) "Go to the Info node in the Emacs manual for command COMMAND. @@ -4799,7 +4799,7 @@ COMMAND must be a symbol or string." (if (> num-matches 2) "them" "it"))))) (error "Couldn't find documentation for %s" command)))) -;;;###autoload (put 'Info-goto-emacs-key-command-node 'info-file (purecopy "emacs")) +;;;###autoload (put 'Info-goto-emacs-key-command-node 'info-file "emacs") ;;;###autoload (defun Info-goto-emacs-key-command-node (key) "Go to the node in the Emacs manual which describes the command bound to KEY. diff --git a/lisp/isearch.el b/lisp/isearch.el index 315fd36cfea..1343c71f610 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -115,7 +115,7 @@ is called to let you enter the search string, and RET terminates editing and does a nonincremental search.)" :type 'boolean) -(defcustom search-whitespace-regexp (purecopy "[ \t]+") +(defcustom search-whitespace-regexp "[ \t]+" "If non-nil, regular expression to match a sequence of whitespace chars. When you enter a space or spaces in the incremental search, it will match any sequence matched by this regexp. As an exception, @@ -497,7 +497,7 @@ this variable is nil.") (eval-when-compile (require 'help-macro)) (make-help-screen isearch-help-for-help-internal - (purecopy "Type a help option: [bkm] or ?") + "Type a help option: [bkm] or ?" "You have typed %THIS-KEY%, the help character. Type a Help option: \(Type \\\\[help-quit] to exit the Help command.) diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index 7e502f02b3c..048ec2e091e 100644 --- a/lisp/jka-cmpr-hook.el +++ b/lisp/jka-cmpr-hook.el @@ -78,19 +78,18 @@ Otherwise, it is nil.") (defun jka-compr-build-file-regexp () - (purecopy - (let ((re-anchored '()) - (re-free '())) - (dolist (e jka-compr-compression-info-list) - (let ((re (jka-compr-info-regexp e))) - (if (string-match "\\\\'\\'" re) - (push (substring re 0 (match-beginning 0)) re-anchored) - (push re re-free)))) - (concat - (if re-free (concat (mapconcat 'identity re-free "\\|") "\\|")) - "\\(?:" - (mapconcat 'identity re-anchored "\\|") - "\\)" file-name-version-regexp "?\\'")))) + (let ((re-anchored '()) + (re-free '())) + (dolist (e jka-compr-compression-info-list) + (let ((re (jka-compr-info-regexp e))) + (if (string-match "\\\\'\\'" re) + (push (substring re 0 (match-beginning 0)) re-anchored) + (push re re-free)))) + (concat + (if re-free (concat (mapconcat 'identity re-free "\\|") "\\|")) + "\\(?:" + (mapconcat 'identity re-anchored "\\|") + "\\)" file-name-version-regexp "?\\'"))) ;; Functions for accessing the return value of jka-compr-get-compression-info ;; FIXME: Use cl-defstruct! @@ -202,7 +201,6 @@ options through Custom does this automatically." ;; uncomp-message uncomp-prog uncomp-args ;; can-append strip-extension-flag file-magic-bytes ;; uncompress-function] - (mapcar 'purecopy `(["\\.Z\\'" "compressing" "compress" ("-c") ;; gzip is more common than uncompress. It can only read, not write. @@ -261,7 +259,7 @@ options through Custom does this automatically." ["\\.tzst\\'" "zstd compressing" "zstd" ("-c" "-q") "zstd uncompressing" "zstd" ("-c" "-q" "-d") - t nil "\050\265\057\375"])) + t nil "\050\265\057\375"]) "List of vectors that describe available compression techniques. Each element, which describes a compression technique, is a vector of @@ -329,10 +327,10 @@ variables. Setting this through Custom does that automatically." :group 'jka-compr) (defcustom jka-compr-mode-alist-additions - (purecopy '(("\\.tgz\\'" . tar-mode) - ("\\.tbz2?\\'" . tar-mode) - ("\\.txz\\'" . tar-mode) - ("\\.tzst\\'" . tar-mode))) + '(("\\.tgz\\'" . tar-mode) + ("\\.tbz2?\\'" . tar-mode) + ("\\.txz\\'" . tar-mode) + ("\\.tzst\\'" . tar-mode)) "List of pairs added to `auto-mode-alist' when installing jka-compr. Uninstalling jka-compr removes all pairs from `auto-mode-alist' that installing added. @@ -346,7 +344,7 @@ variables. Setting this through Custom does that automatically." :set 'jka-compr-set :group 'jka-compr) -(defcustom jka-compr-load-suffixes (purecopy '(".gz")) +(defcustom jka-compr-load-suffixes '(".gz") "List of compression related suffixes to try when loading files. Enabling Auto Compression mode appends this list to `load-file-rep-suffixes', which see. Disabling Auto Compression mode removes all suffixes diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el index 7490f5351c8..0617e505008 100644 --- a/lisp/language/ethiopic.el +++ b/lisp/language/ethiopic.el @@ -56,7 +56,7 @@ "CCL program to encode an Ethiopic code to code point of Ethiopic font.") (setq font-ccl-encoder-alist - (cons (cons (purecopy "ethiopic") ccl-encode-ethio-font) font-ccl-encoder-alist)) + (cons (cons "ethiopic" ccl-encode-ethio-font) font-ccl-encoder-alist)) (set-language-info-alist "Ethiopic" '((setup-function . setup-ethiopic-environment-internal) diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el index 665745c1eb0..66a4b6ce550 100644 --- a/lisp/language/korea-util.el +++ b/lisp/language/korea-util.el @@ -29,10 +29,10 @@ ;;;###autoload (defvar default-korean-keyboard - (purecopy (if (string-search "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) + (if (string-search "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" - "")) - "The kind of Korean keyboard for Korean (Hangul) input method. + "") + "The kind of Korean keyboard for Korean (Hangul) input method. \"\" for 2, \"3\" for 3, and \"3f\" for 3f.") ;; functions useful for Korean text input diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el index 28f8c229d3d..98478105041 100644 --- a/lisp/language/tibetan.el +++ b/lisp/language/tibetan.el @@ -574,19 +574,17 @@ The result of matching is to be used for indexing alists at conversion from a roman transcription to the corresponding Tibetan character.") (defvar tibetan-precomposed-regexp - (purecopy - (eval-when-compile - (concat "^" - (regexp-opt (mapcar #'car tibetan-precomposed-transcription-alist) - t)))) + (eval-when-compile + (concat "^" + (regexp-opt (mapcar #'car tibetan-precomposed-transcription-alist) + t))) "Regexp string to match a romanized Tibetan complex consonant. The result of matching is to be used for indexing alists when the input key from an input method is converted to the corresponding precomposed glyph.") (defvar tibetan-precomposition-rule-regexp - (purecopy - (eval-when-compile - (regexp-opt (mapcar #'car tibetan-precomposition-rule-alist) t))) + (eval-when-compile + (regexp-opt (mapcar #'car tibetan-precomposition-rule-alist) t)) "Regexp string to match a sequence of Tibetan consonantic components. That is, one base consonant and one or more subjoined consonants. The result of matching is to be used for indexing alist when the component diff --git a/lisp/locate.el b/lisp/locate.el index c6a1e9b6e46..ce601bc2a50 100644 --- a/lisp/locate.el +++ b/lisp/locate.el @@ -182,7 +182,7 @@ or `locate-make-command-line', determines the database." :type '(choice (const :tag "None" nil) face)) ;;;###autoload -(defcustom locate-ls-subdir-switches (purecopy "-al") +(defcustom locate-ls-subdir-switches "-al" "`ls' switches for inserting subdirectories in `*Locate*' buffers. This should contain the \"-l\" switch, but not the \"-F\" or \"-b\" switches." :type 'string diff --git a/lisp/lpr.el b/lisp/lpr.el index c860c633b73..10864c29a73 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -94,14 +94,13 @@ This switch is used in conjunction with `printer-name'." ;;;###autoload (defcustom lpr-command - (purecopy (cond (lpr-windows-system "") (lpr-lp-system "lp") (t - "lpr"))) + "lpr")) "Name of program for printing a file. On MS-DOS and MS-Windows systems, if the value is an empty string then diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index e38ab12fae6..0e7597b89bd 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -152,7 +152,7 @@ its character representation and its display representation.") :group 'rmail) ;;;###autoload -(defcustom rmail-file-name (purecopy "~/RMAIL") +(defcustom rmail-file-name "~/RMAIL" "Name of user's primary mail file." :type 'string :group 'rmail @@ -160,7 +160,6 @@ its character representation and its display representation.") ;;;###autoload (defcustom rmail-spool-directory - (purecopy (cond ((file-exists-p "/var/mail") ;; SVR4 and recent BSD are said to use this. ;; Rather than trying to know precisely which systems use it, @@ -169,7 +168,7 @@ its character representation and its display representation.") ;; Many GNU/Linux systems use this name. ((file-exists-p "/var/spool/mail") "/var/spool/mail/") ((memq system-type '(hpux usg-unix-v)) "/usr/mail/") - (t "/usr/spool/mail/"))) + (t "/usr/spool/mail/")) "Name of directory used by system mailer for delivering new mail. Its name should end with a slash." :initialize #'custom-initialize-delay @@ -316,7 +315,6 @@ Setting this variable has an effect only before reading a mail." ;;;###autoload (defcustom rmail-ignored-headers - (purecopy (concat "^via:\\|^mail-from:\\|^origin:\\|^references:\\|^sender:" "\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:" "\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:" @@ -336,7 +334,7 @@ Setting this variable has an effect only before reading a mail." "\\|^Received-SPF:" "\\|^Authentication-Results:" "\\|^resent-face:\\|^resent-x.*:\\|^resent-organization:\\|^resent-openpgp:" - "\\|^x-.*:")) + "\\|^x-.*:") "Regexp to match header fields that Rmail should normally hide. \(See also `rmail-nonignored-headers', which overrides this regexp.) This variable is used for reformatting the message header, @@ -385,7 +383,7 @@ If nil, display all header fields except those matched by :version "29.1") ;;;###autoload -(defcustom rmail-highlighted-headers (purecopy "^From:\\|^Subject:") +(defcustom rmail-highlighted-headers "^From:\\|^Subject:" "Regexp to match Header fields that Rmail should normally highlight. A value of nil means don't highlight. Uses the face `rmail-highlight'." :type '(choice regexp (const :tag "None" nil)) @@ -436,12 +434,12 @@ the frame where you have the RMAIL buffer displayed." :group 'rmail-reply) ;;;###autoload -(defcustom rmail-secondary-file-directory (purecopy "~/") +(defcustom rmail-secondary-file-directory "~/" "Directory for additional secondary Rmail files." :type 'directory :group 'rmail-files) ;;;###autoload -(defcustom rmail-secondary-file-regexp (purecopy "\\.xmail\\'") +(defcustom rmail-secondary-file-regexp "\\.xmail\\'" "Regexp for which files are secondary Rmail files." :type 'regexp :group 'rmail-files) diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index a720df51d14..875d0f80d3a 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -160,7 +160,7 @@ This is used by the default mail-sending commands. See also :version "24.1") ;;;###autoload -(defcustom mail-header-separator (purecopy "--text follows this line--") +(defcustom mail-header-separator "--text follows this line--" "Line used to separate headers from text in messages being composed." :type 'string) @@ -201,7 +201,7 @@ The default file is defined in sendmail's configuration file, e.g. :type '(choice (const :tag "Sendmail default" nil) file)) ;;;###autoload -(defcustom mail-personal-alias-file (purecopy "~/.mailrc") +(defcustom mail-personal-alias-file "~/.mailrc" "If non-nil, the name of the user's personal mail alias file. This file typically should be in same format as the `.mailrc' file used by the `Mail' or `mailx' program. @@ -258,7 +258,7 @@ regardless of what part of it (if any) is included in the cited text.") ;;;###autoload (defcustom mail-citation-prefix-regexp - (purecopy "\\([ \t]*\\(\\w\\|[_.]\\)+>+\\|[ \t]*[>|]\\)+") + "\\([ \t]*\\(\\w\\|[_.]\\)+>+\\|[ \t]*[>|]\\)+" "Regular expression to match a citation prefix plus whitespace. It should match whatever sort of citation prefixes you want to handle, with whitespace before and after; it should also match just whitespace. @@ -377,12 +377,12 @@ and should insert whatever you want to insert." :risky t) ;;;###autoload -(defcustom mail-signature-file (purecopy "~/.signature") +(defcustom mail-signature-file "~/.signature" "File containing the text inserted at end of mail buffer." :type 'file) ;;;###autoload -(defcustom mail-default-directory (purecopy "~/") +(defcustom mail-default-directory "~/" "Value of `default-directory' for Mail mode buffers. This directory is used for auto-save files of Mail mode buffers. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index b625a317c56..0454ed292fe 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -488,7 +488,7 @@ in the tool bar will close the current window where possible." (or (not (boundp 'xref-backend-functions)) (eq (car xref-backend-functions) 'etags--xref-backend))) -(defvar yank-menu (cons (purecopy "Select Yank") nil)) +(defvar yank-menu '("Select Yank" nil)) (fset 'yank-menu (cons 'keymap yank-menu)) (defvar menu-bar-edit-menu @@ -2211,7 +2211,7 @@ key, a click, or a menu-item")) (define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu)) (define-key global-map [menu-bar help-menu] - (cons (purecopy "Help") menu-bar-help-menu)) + (cons "Help" menu-bar-help-menu)) (define-key global-map [menu-bar mouse-1] 'menu-bar-open-mouse) diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 9e640768285..c6e93d470de 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -1319,25 +1319,25 @@ This does nothing except loading eudc by autoload side-effect." (defvar eudc-tools-menu (let ((map (make-sparse-keymap "Directory Servers"))) (define-key map [phone] - `(menu-item ,(purecopy "Get Phone") eudc-get-phone - :help ,(purecopy "Get the phone field of name from the directory server"))) + '(menu-item "Get Phone" eudc-get-phone + :help "Get the phone field of name from the directory server")) (define-key map [email] - `(menu-item ,(purecopy "Get Email") eudc-get-email - :help ,(purecopy "Get the email field of NAME from the directory server"))) + '(menu-item "Get Email" eudc-get-email + :help "Get the email field of NAME from the directory server")) (define-key map [separator-eudc-email] menu-bar-separator) (define-key map [expand-inline] - `(menu-item ,(purecopy "Expand Inline Query") eudc-expand-inline - :help ,(purecopy "Query the directory server, and expand the query string before point"))) + '(menu-item "Expand Inline Query" eudc-expand-inline + :help "Query the directory server, and expand the query string before point")) (define-key map [query] - `(menu-item ,(purecopy "Query with Form") eudc-query-form - :help ,(purecopy "Display a form to query the directory server"))) + '(menu-item "Query with Form" eudc-query-form + :help "Display a form to query the directory server")) (define-key map [separator-eudc-query] menu-bar-separator) (define-key map [new] - `(menu-item ,(purecopy "New Server") eudc-set-server - :help ,(purecopy "Set the directory server to SERVER using PROTOCOL"))) + '(menu-item "New Server" eudc-set-server + :help "Set the directory server to SERVER using PROTOCOL")) (define-key map [load] - `(menu-item ,(purecopy "Load Hotlist of Servers") eudc-load-eudc - :help ,(purecopy "Load the Emacs Unified Directory Client"))) + '(menu-item "Load Hotlist of Servers" eudc-load-eudc + :help "Load the Emacs Unified Directory Client")) map)) (fset 'eudc-tools-menu (symbol-value 'eudc-tools-menu))) diff --git a/lisp/newcomment.el b/lisp/newcomment.el index 04b5746eeae..f63d0abd663 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -136,7 +136,7 @@ by the close of the first pair.") (put 'comment-end-skip 'safe-local-variable 'stringp) ;;;###autoload -(defvar comment-end (purecopy "") +(defvar comment-end "" "String to insert to end a new comment. Should be an empty string if comments are terminated by end-of-line.") ;;;###autoload @@ -288,7 +288,7 @@ See `comment-styles' for a list of available styles." :group 'comment) ;;;###autoload -(defcustom comment-padding (purecopy " ") +(defcustom comment-padding " " "Padding string that `comment-region' puts between comment chars and text. Can also be an integer which will be automatically turned into a string of the corresponding number of spaces. diff --git a/lisp/obsolete/autoload.el b/lisp/obsolete/autoload.el index 850ec83e645..ad3854c12ed 100644 --- a/lisp/obsolete/autoload.el +++ b/lisp/obsolete/autoload.el @@ -415,8 +415,7 @@ FILE's modification time." load-name outfile)) (let ((standard-output (marker-buffer output-start)) (print-quoted t)) - (princ `(push (purecopy - ',(cons (intern package) version)) + (princ `(push ',(cons (intern package) version) package--builtin-versions)) (princ "\n"))))) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 07616960565..92d07229584 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -257,7 +257,6 @@ This has effect only if `search-invisible' is set to `open'." ;; FIXME: Currently the check is made via ;; (assoc major-mode hs-special-modes-alist) so it doesn't pay attention ;; to the mode hierarchy. - (mapcar #'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c-ts-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) @@ -270,7 +269,7 @@ This has effect only if `search-invisible' is set to `open'." (lua-ts-mode "{\\|\\[\\[" "}\\|\\]\\]" "--" nil) (mhtml-mode "{\\|<[^/>]*?" "}\\|]*[^/]>" "