Commit 16a7bce7 authored by João Távora's avatar João Távora

Merge branch 'master' into this scratch branch

scratch/allow-custom-null-and-false-objects-in-jsonc
parents 4aed7ee7 38111b5e
Pipeline #20 failed with stage
......@@ -83,6 +83,10 @@ Syntax check is done ``on-the-fly''. It is started whenever
@code{flymake-mode} is started, unless
@code{flymake-start-on-flymake-mode} is nil;
@item
the buffer is saved, unless @code{flymake-start-on-save-buffer} is
nil;
@item
a newline character is added to the buffer, unless
@code{flymake-start-syntax-check-on-newline} is nil;
......@@ -220,6 +224,10 @@ after a newline character is inserted into the buffer.
A boolean flag indicating whether to start syntax check immediately
after enabling @code{flymake-mode}.
@item flymake-start-on-save-buffer
A boolean flag indicating whether to start syntax check after saving
the buffer.
@item flymake-error
A custom face for highlighting regions for which an error has been
reported.
......
......@@ -183,6 +183,9 @@ shown in the currently selected window.
You should instead set properties on known diagnostic symbols, like
':error' and ':warning', as demonstrated in the Flymake manual.
*** New customizable variable 'flymake-start-on-save-buffer'
Control whether Flymake starts checking the buffer on save.
** Package
*** New 'package-quickstart' feature
When 'package-quickstart' is non-nil, package.el precomputes a big autoloads
......@@ -572,6 +575,11 @@ manual for more details.
* Lisp Changes in Emacs 27.1
+++
** Face specifications (of the kind used in `face-remapping-alist')
now support filters, allowing faces to vary between windows display
the same buffer.
+++
** New function assoc-delete-all.
......
......@@ -2014,17 +2014,47 @@ think it does, because \"free\" is pretty hard to define in practice."
:version "25.1"
:type '(choice integer (const :tag "Never issue warning" nil)))
(defun abort-if-file-too-large (size op-type filename)
(declare-function x-popup-dialog "menu.c" (position contents &optional header))
(defun files--ask-user-about-large-file (size op-type filename offer-raw)
(let ((prompt (format "File %s is large (%s), really %s?"
(file-name-nondirectory filename)
(file-size-human-readable size) op-type)))
(if (not offer-raw)
(if (y-or-n-p prompt) nil 'abort)
(let* ((use-dialog (and (display-popup-menus-p)
last-input-event
(listp last-nonmenu-event)
use-dialog-box))
(choice
(if use-dialog
(x-popup-dialog t `(,prompt
("Yes" . ?y)
("No" . ?n)
("Open in raw mode" . ?r)))
(read-char-choice
(concat prompt " (y)es or (n)o or (r)aw ")
'(?y ?Y ?n ?N ?r ?R)))))
(cond ((memq choice '(?y ?Y)) nil)
((memq choice '(?r ?R)) 'raw)
(t 'abort))))))
(defun abort-if-file-too-large (size op-type filename &optional offer-raw)
"If file SIZE larger than `large-file-warning-threshold', allow user to abort.
OP-TYPE specifies the file operation being performed (for message to user)."
(when (and large-file-warning-threshold size
(> size large-file-warning-threshold)
;; No point in warning if we can't read it.
(file-readable-p filename)
(not (y-or-n-p (format "File %s is large (%s), really %s? "
(file-name-nondirectory filename)
(file-size-human-readable size) op-type))))
(user-error "Aborted")))
OP-TYPE specifies the file operation being performed (for message
to user). If OFFER-RAW is true, give user the additional option
to open the file in raw mode. If the user chooses this option,
`abort-if-file-too-large' returns the symbol `raw'. Otherwise, it
returns nil or exits non-locally."
(let ((choice (and large-file-warning-threshold size
(> size large-file-warning-threshold)
;; No point in warning if we can't read it.
(file-readable-p filename)
(files--ask-user-about-large-file
size op-type filename offer-raw))))
(when (eq choice 'abort)
(user-error "Aborted"))
choice))
(defun warn-maybe-out-of-memory (size)
"Warn if an attempt to open file of SIZE bytes may run out of memory."
......@@ -2104,7 +2134,10 @@ the various files."
(setq buf other))))
;; Check to see if the file looks uncommonly large.
(when (not (or buf nowarn))
(abort-if-file-too-large (nth 7 attributes) "open" filename)
(when (eq (abort-if-file-too-large
(nth 7 attributes) "open" filename t)
'raw)
(setf rawfile t))
(warn-maybe-out-of-memory (nth 7 attributes)))
(if buf
;; We are using an existing buffer.
......
......@@ -2036,6 +2036,7 @@ If search string is empty, just beep."
(defun isearch-yank-kill ()
"Pull string from kill ring into search string."
(interactive)
(unless isearch-mode (isearch-mode t))
(isearch-yank-string (current-kill 0)))
(defun isearch-yank-pop ()
......
......@@ -1110,13 +1110,56 @@ Note that the style variables are always made local to the buffer."
(goto-char start)
(while (progn
(parse-partial-sexp (point) end nil nil st-s 'syntax-table)
(c-clear-char-property (1- (point)) 'syntax-table)
(unless (bobp)
(c-clear-char-property (1- (point)) 'syntax-table))
(setq st-pos (point))
(and (< (point) end)
(not (eq (char-before) ?\")))))
(goto-char (min no-st-pos st-pos))
nil))
(defun c-multiline-string-check-final-quote ()
;; Check that the final quote in the buffer is correctly marked or not with
;; a string-fence syntax-table text propery. The return value has no
;; significance.
(let (pos-ll pos-lt)
(save-excursion
(goto-char (point-max))
(skip-chars-backward "^\"")
(while
(and
(not (bobp))
(cond
((progn
(setq pos-ll (c-literal-limits)
pos-lt (c-literal-type pos-ll))
(memq pos-lt '(c c++)))
;; In a comment.
(goto-char (car pos-ll)))
((save-excursion
(backward-char) ; over "
(eq (logand (skip-chars-backward "\\\\") 1) 1))
;; At an escaped string.
(backward-char)
t)
(t
;; At a significant "
(c-clear-char-property (1- (point)) 'syntax-table)
(setq pos-ll (c-literal-limits)
pos-lt (c-literal-type pos-ll))
nil)))
(skip-chars-backward "^\""))
(cond
((bobp))
((eq pos-lt 'string)
(c-put-char-property (1- (point)) 'syntax-table '(15)))
(t nil)))))
(defvar c-bc-changed-stringiness nil)
;; Non-nil when, in a before-change function, the deletion of a range of text
;; will change the "stringiness" of the subsequent text. Only used when
;; `c-multiline-sting-start-char' is a non-nil value which isn't a character.
(defun c-before-change-check-unbalanced-strings (beg end)
;; If BEG or END is inside an unbalanced string, remove the syntax-table
;; text property from respectively the start or end of the string. Also
......@@ -1175,6 +1218,18 @@ Note that the style variables are always made local to the buffer."
(< (point) (point-max))))))
(setq c-new-END (max (point) c-new-END)))
(c-multiline-string-start-char
(setq c-bc-changed-stringiness
(not (eq (eq end-literal-type 'string)
(eq beg-literal-type 'string))))
;; Deal with deletion of backslashes before "s.
(goto-char end)
(if (and (looking-at "\\\\*\"")
(eq (logand (skip-chars-backward "\\\\" beg) 1) 1))
(setq c-bc-changed-stringiness (not c-bc-changed-stringiness)))
(if (eq beg-literal-type 'string)
(setq c-new-BEG (min (car beg-limits) c-new-BEG))))
((< c-new-END (point-max))
(goto-char (1+ c-new-END)) ; might be a newline.
;; In the following regexp, the initial \n caters for a newline getting
......@@ -1183,7 +1238,6 @@ Note that the style variables are always made local to the buffer."
nil t)
;; We're at an EOLL or point-max.
(setq c-new-END (min (1+ (point)) (point-max)))
;; FIXME!!! Write a clever comment here.
(goto-char c-new-END)
(if (equal (c-get-char-property (1- (point)) 'syntax-table) '(15))
(if (memq (char-before) '(?\n ?\r))
......@@ -1202,14 +1256,16 @@ Note that the style variables are always made local to the buffer."
(if (c-search-backward-char-property 'syntax-table '(15) c-new-BEG)
(c-clear-char-property (point) 'syntax-table))))
(when (eq end-literal-type 'string)
(c-clear-char-property (1- (cdr end-limits)) 'syntax-table))
(unless (and c-multiline-string-start-char
(not (c-characterp c-multiline-string-start-char)))
(when (eq end-literal-type 'string)
(c-clear-char-property (1- (cdr end-limits)) 'syntax-table))
(when (eq beg-literal-type 'string)
(setq c-new-BEG (min c-new-BEG (car beg-limits)))
(c-clear-char-property (car beg-limits) 'syntax-table))))
(when (eq beg-literal-type 'string)
(setq c-new-BEG (min c-new-BEG (car beg-limits)))
(c-clear-char-property (car beg-limits) 'syntax-table)))))
(defun c-after-change-re-mark-unbalanced-strings (beg _end _old-len)
(defun c-after-change-re-mark-unbalanced-strings (beg end _old-len)
;; Mark any unbalanced strings in the region (c-new-BEG c-new-END) with
;; string fence syntax-table text properties.
;;
......@@ -1218,66 +1274,90 @@ Note that the style variables are always made local to the buffer."
;;
;; This function is called exclusively as an after-change function via
;; `c-before-font-lock-functions'.
(c-save-buffer-state
((cll (progn (goto-char c-new-BEG)
(c-literal-limits)))
(beg-literal-type (and cll (c-literal-type cll)))
(beg-limits
(cond
((and (eq beg-literal-type 'string)
(c-unescaped-nls-in-string-p (car cll)))
(cons
(car cll)
(if (and c-multiline-string-start-char
(not (c-characterp c-multiline-string-start-char)))
;; Only the last " might need to be marked.
(c-save-buffer-state
((beg-literal-limits
(progn (goto-char beg) (c-literal-limits)))
(beg-literal-type (c-literal-type beg-literal-limits))
end-literal-limits end-literal-type)
(when (and (eq beg-literal-type 'string)
(c-get-char-property (car beg-literal-limits) 'syntax-table))
(c-clear-char-property (car beg-literal-limits) 'syntax-table)
(setq c-bc-changed-stringiness (not c-bc-changed-stringiness)))
(setq end-literal-limits (progn (goto-char end) (c-literal-limits))
end-literal-type (c-literal-type end-literal-limits))
;; Deal with the insertion of backslashes before a ".
(goto-char end)
(if (and (looking-at "\\\\*\"")
(eq (logand (skip-chars-backward "\\\\" beg) 1) 1))
(setq c-bc-changed-stringiness (not c-bc-changed-stringiness)))
(when (eq (eq (eq beg-literal-type 'string)
(eq end-literal-type 'string))
c-bc-changed-stringiness)
(c-multiline-string-check-final-quote)))
;; There could be several "s needing marking.
(c-save-buffer-state
((cll (progn (goto-char c-new-BEG)
(c-literal-limits)))
(beg-literal-type (and cll (c-literal-type cll)))
(beg-limits
(cond
((and (eq beg-literal-type 'string)
(c-unescaped-nls-in-string-p (car cll)))
(cons
(car cll)
(progn
(goto-char (1+ (car cll)))
(search-forward-regexp
(cdr (assq (char-after (car cll)) c-string-innards-re-alist))
nil t)
(min (1+ (point)) (point-max)))))
((and (null beg-literal-type)
(goto-char beg)
(eq (char-before) c-multiline-string-start-char)
(memq (char-after) c-string-delims))
(cons (point)
(progn
(forward-char)
(search-forward-regexp
(cdr (assq (char-before) c-string-innards-re-alist)) nil t)
(1+ (point)))))
(cll)))
s)
(goto-char
(cond ((null beg-literal-type)
c-new-BEG)
((eq beg-literal-type 'string)
(car beg-limits))
(t ; comment
(cdr beg-limits))))
(while
(and
(< (point) c-new-END)
(progn
(goto-char (1+ (car cll)))
(search-forward-regexp
(cdr (assq (char-after (car cll)) c-string-innards-re-alist))
nil t)
(min (1+ (point)) (point-max)))))
((and (null beg-literal-type)
(goto-char beg)
(eq (char-before) c-multiline-string-start-char)
(memq (char-after) c-string-delims))
(cons (point)
(progn
(forward-char)
(search-forward-regexp
(cdr (assq (char-before) c-string-innards-re-alist)) nil t)
(1+ (point)))))
(cll)))
s)
(goto-char
(cond ((null beg-literal-type)
c-new-BEG)
((eq beg-literal-type 'string)
(car beg-limits))
(t ; comment
(cdr beg-limits))))
(while
(and
(< (point) c-new-END)
(progn
;; Skip over any comments before the next string.
(while (progn
(setq s (parse-partial-sexp (point) c-new-END nil
nil s 'syntax-table))
(and (not (nth 3 s))
(< (point) c-new-END)
(not (memq (char-before) c-string-delims)))))
;; We're at the start of a string.
(memq (char-before) c-string-delims)))
(if (c-unescaped-nls-in-string-p (1- (point)))
(looking-at "[^\"]*")
(looking-at (cdr (assq (char-before) c-string-innards-re-alist))))
(cond
((memq (char-after (match-end 0)) '(?\n ?\r))
(c-put-char-property (1- (point)) 'syntax-table '(15))
(c-put-char-property (match-end 0) 'syntax-table '(15)))
((or (eq (match-end 0) (point-max))
(eq (char-after (match-end 0)) ?\\)) ; \ at EOB
(c-put-char-property (1- (point)) 'syntax-table '(15))))
(goto-char (min (1+ (match-end 0)) (point-max)))
(setq s nil))))
;; Skip over any comments before the next string.
(while (progn
(setq s (parse-partial-sexp (point) c-new-END nil
nil s 'syntax-table))
(and (not (nth 3 s))
(< (point) c-new-END)
(not (memq (char-before) c-string-delims)))))
;; We're at the start of a string.
(memq (char-before) c-string-delims)))
(if (c-unescaped-nls-in-string-p (1- (point)))
(looking-at "\\(\\\\\\(.\\|\n|\\\r\\)\\|[^\"]\\)*")
(looking-at (cdr (assq (char-before) c-string-innards-re-alist))))
(cond
((memq (char-after (match-end 0)) '(?\n ?\r))
(c-put-char-property (1- (point)) 'syntax-table '(15))
(c-put-char-property (match-end 0) 'syntax-table '(15)))
((or (eq (match-end 0) (point-max))
(eq (char-after (match-end 0)) ?\\)) ; \ at EOB
(c-put-char-property (1- (point)) 'syntax-table '(15))))
(goto-char (min (1+ (match-end 0)) (point-max)))
(setq s nil)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Parsing of quotes.
......
......@@ -196,11 +196,17 @@ If nil, never start checking buffer automatically like this."
'flymake-start-on-flymake-mode "26.1")
(defcustom flymake-start-on-flymake-mode t
"Start syntax check when `flymake-mode' is enabled.
"If non-nil, start syntax check when `flymake-mode' is enabled.
Specifically, start it when the buffer is actually displayed."
:version "26.1"
:type 'boolean)
(defcustom flymake-start-on-save-buffer t
"If non-nil start syntax check when a buffer is saved.
Specifically, start it when the saved buffer is actually displayed."
:version "27.1"
:type 'boolean)
(defcustom flymake-log-level -1
"Obsolete and ignored variable."
:type 'integer)
......@@ -962,7 +968,7 @@ Do it only if `flymake-no-changes-timeout' is non-nil."
(flymake--schedule-timer-maybe)))
(defun flymake-after-save-hook ()
(when flymake-mode
(when flymake-start-on-save-buffer
(flymake-log :debug "starting syntax check as buffer was saved")
(flymake-start t)))
......
......@@ -1020,9 +1020,6 @@ define xpr
if $misc == Lisp_Misc_Overlay
xoverlay
end
# if $misc == Lisp_Misc_Save_Value
# xsavevalue
# end
end
if $type == Lisp_Vectorlike
set $size = ((struct Lisp_Vector *) $ptr)->header.size
......
......@@ -1696,7 +1696,7 @@ cleaning up all windows currently displaying the buffer to be killed. */)
{
ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect (save_excursion_restore, save_excursion_save ());
record_unwind_protect_excursion ();
set_buffer_internal (b);
/* First run the query functions; if any query is answered no,
......
......@@ -739,8 +739,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
NEXT;
CASE (Bsave_excursion):
record_unwind_protect (save_excursion_restore,
save_excursion_save ());
record_unwind_protect_excursion ();
NEXT;
CASE (Bsave_current_buffer): /* Obsolete since ??. */
......
......@@ -3429,11 +3429,12 @@ char *choose_face_font (struct frame *, Lisp_Object *, Lisp_Object,
#ifdef HAVE_WINDOW_SYSTEM
void prepare_face_for_display (struct frame *, struct face *);
#endif
int lookup_named_face (struct frame *, Lisp_Object, bool);
int lookup_basic_face (struct frame *, int);
int lookup_named_face (struct window *, struct frame *, Lisp_Object, bool);
int lookup_basic_face (struct window *, struct frame *, int);
int smaller_face (struct frame *, int, int);
int face_with_height (struct frame *, int, int);
int lookup_derived_face (struct frame *, Lisp_Object, int, bool);
int lookup_derived_face (struct window *, struct frame *,
Lisp_Object, int, bool);
void init_frame_faces (struct frame *);
void free_frame_faces (struct frame *);
void recompute_basic_faces (struct frame *);
......@@ -3443,7 +3444,7 @@ int face_for_overlay_string (struct window *, ptrdiff_t, ptrdiff_t *, ptrdiff_t,
bool, Lisp_Object);
int face_at_string_position (struct window *, Lisp_Object, ptrdiff_t, ptrdiff_t,
ptrdiff_t *, enum face_id, bool);
int merge_faces (struct frame *, Lisp_Object, int, int);
int merge_faces (struct window *, Lisp_Object, int, int);
int compute_char_face (struct frame *, int, Lisp_Object);
void free_all_realized_faces (Lisp_Object);
extern char unspecified_fg[], unspecified_bg[];
......
......@@ -2508,8 +2508,7 @@ spec_glyph_lookup_face (struct window *w, GLYPH *glyph)
/* Convert the glyph's specified face to a realized (cache) face. */
if (lface_id > 0)
{
int face_id = merge_faces (XFRAME (w->frame),
Qt, lface_id, DEFAULT_FACE_ID);
int face_id = merge_faces (w, Qt, lface_id, DEFAULT_FACE_ID);
SET_GLYPH_FACE (*glyph, face_id);
}
}
......
......@@ -1016,37 +1016,30 @@ save_excursion_save (void)
void
save_excursion_restore (Lisp_Object info)
{
Lisp_Object tem, tem1;
tem = Fmarker_buffer (XSAVE_OBJECT (info, 0));
Lisp_Object marker = XSAVE_OBJECT (info, 0);
Lisp_Object window = XSAVE_OBJECT (info, 2);
free_misc (info);
Lisp_Object buffer = Fmarker_buffer (marker);
/* If we're unwinding to top level, saved buffer may be deleted. This
means that all of its markers are unchained and so tem is nil. */
if (NILP (tem))
goto out;
means that all of its markers are unchained and so BUFFER is nil. */
if (NILP (buffer))
return;
Fset_buffer (tem);
Fset_buffer (buffer);
/* Point marker. */
tem = XSAVE_OBJECT (info, 0);
Fgoto_char (tem);
unchain_marker (XMARKER (tem));
Fgoto_char (marker);
unchain_marker (XMARKER (marker));
/* If buffer was visible in a window, and a different window was
selected, and the old selected window is still showing this
buffer, restore point in that window. */
tem = XSAVE_OBJECT (info, 2);
if (WINDOWP (tem)
&& !EQ (tem, selected_window)
&& (tem1 = XWINDOW (tem)->contents,
(/* Window is live... */
BUFFERP (tem1)
/* ...and it shows the current buffer. */
&& XBUFFER (tem1) == current_buffer)))
Fset_window_point (tem, make_number (PT));
out:
free_misc (info);
if (WINDOWP (window) && !EQ (window, selected_window))
{
/* Set window point if WINDOW is live and shows the current buffer. */
Lisp_Object contents = XWINDOW (window)->contents;
if (BUFFERP (contents) && XBUFFER (contents) == current_buffer)
Fset_window_point (window, make_number (PT));
}
}
DEFUN ("save-excursion", Fsave_excursion, Ssave_excursion, 0, UNEVALLED, 0,
......@@ -1068,7 +1061,7 @@ usage: (save-excursion &rest BODY) */)
register Lisp_Object val;
ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect (save_excursion_restore, save_excursion_save ());
record_unwind_protect_excursion ();
val = Fprogn (args);
return unbind_to (count, val);
......@@ -3242,7 +3235,7 @@ buffer stay intact. */)
Fundo_boundary ();
ptrdiff_t count = SPECPDL_INDEX ();
record_unwind_protect (save_excursion_restore, save_excursion_save ());
record_unwind_protect_excursion ();
ptrdiff_t i = size_a;
ptrdiff_t j = size_b;
......
......@@ -3414,6 +3414,12 @@ record_unwind_protect_int (void (*function) (int), int arg)
grow_specpdl ();
}
void
record_unwind_protect_excursion (void)
{
record_unwind_protect (save_excursion_restore, save_excursion_save ());
}
void
record_unwind_protect_void (void (*function) (void))
{
......
......@@ -3810,7 +3810,7 @@ font_range (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t *limit,
face_id =
NILP (Vface_remapping_alist)
? DEFAULT_FACE_ID
: lookup_basic_face (f, DEFAULT_FACE_ID);
: lookup_basic_face (w, f, DEFAULT_FACE_ID);
face_id = face_at_string_position (w, string, pos, 0, &ignore,
face_id, false);
......@@ -4559,7 +4559,7 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
CHECK_CHARACTER (ch);
c = XINT (ch);
f = XFRAME (selected_frame);
face_id = lookup_basic_face (f, DEFAULT_FACE_ID);
face_id = lookup_basic_face (NULL, f, DEFAULT_FACE_ID);
pos = -1;
}
else
......
......@@ -587,8 +587,8 @@ draw_fringe_bitmap_1 (struct window *w, struct glyph_row *row, int left_p, int o
if (face_id == DEFAULT_FACE_ID)
{
Lisp_Object face = fringe_faces[which];
face_id = NILP (face) ? lookup_named_face (f, Qfringe, false)
: lookup_derived_face (f, face, FRINGE_FACE_ID, 0);
face_id = NILP (face) ? lookup_named_face (w, f, Qfringe, false)
: lookup_derived_face (w, f, face, FRINGE_FACE_ID, 0);
if (face_id < 0)
face_id = FRINGE_FACE_ID;
}
......@@ -1633,20 +1633,10 @@ If FACE is nil, reset face to default fringe face. */)
if (!n)
error ("Undefined fringe bitmap");
/* The purpose of the following code is to signal an error if FACE
is not a face. This is for the caller's convenience only; the
redisplay code should be able to fail gracefully. Skip the check
if FRINGE_FACE_ID is unrealized (as in batch mode and during
daemon startup). */
if (!NILP (face))
{
struct frame *f = SELECTED_FRAME ();
if (FACE_FROM_ID_OR_NULL (f, FRINGE_FACE_ID)
&& lookup_derived_face (f, face, FRINGE_FACE_ID, 1) < 0)
error ("No such face");
}
/* We used to check, as a convenience to callers, for basic face
validity here, but since validity can depend on the specific
_window_ in which this buffer is being displayed, defer the check
to redisplay, which can cope with bad face specifications. */
fringe_faces[n] = face;
return Qnil;
}
......
......@@ -1131,16 +1131,19 @@ ftfont_open2 (struct frame *f,
return Qnil;
}
}
set_save_integer (val, 1, XSAVE_INTEGER (val, 1) + 1);
size = XINT (AREF (entity, FONT_SIZE_INDEX));
if (size == 0)
size = pixel_size;
if (FT_Set_Pixel_Sizes (ft_face, size, size) != 0)
{
if (XSAVE_INTEGER (val, 1) == 0)
FT_Done_Face (ft_face);
{
FT_Done_Face (ft_face);
cache_data->ft_face = NULL;
}
return Qnil;
}
set_save_integer (val, 1, XSAVE_INTEGER (val, 1) + 1);
ASET (font_object, FONT_FILE_INDEX, filename);
font = XFONT_OBJECT (font_object);
......
......@@ -228,8 +228,8 @@ extern bool suppress_checking EXTERNALLY_VISIBLE;
USE_LSB_TAG not only requires the least 3 bits of pointers returned by
malloc to be 0 but also needs to be able to impose a mult-of-8 alignment
on the few static Lisp_Objects used, all of which are aligned via
'char alignas (GCALIGNMENT) gcaligned;' inside a union. */
on some non-GC Lisp_Objects, all of which are aligned via
GCALIGNED_UNION at the end of a union. */
enum Lisp_Bits
{
......@@ -277,6 +277,12 @@ DEFINE_GDB_SYMBOL_END (VALMASK)
error !;
#endif
#if USE_LSB_TAG
# define GCALIGNED_UNION char alignas (GCALIGNMENT) gcaligned;
#else
# define GCALIGNED_UNION
#endif
/* Lisp_Word is a scalar word suitable for holding a tagged pointer or
integer. Usually it is a pointer to a deliberately-incomplete type
'union Lisp_X'. However, it is EMACS_INT when Lisp_Objects and
......@@ -776,10 +782,10 @@ struct Lisp_Symbol
/* Next symbol in obarray bucket, if the symbol is interned. */
struct Lisp_Symbol *next;
} s;
char alignas (GCALIGNMENT) gcaligned;
GCALIGNED_UNION
} u;
};
verify (alignof (struct Lisp_Symbol) % GCALIGNMENT == 0);
verify (!USE_LSB_TAG || alignof (struct Lisp_Symbol) % GCALIGNMENT == 0);
/* Declare a Lisp-callable function. The MAXARGS parameter has the same
meaning as in the DEFUN macro, and is used to construct a prototype. */
......@@ -890,9 +896,9 @@ union vectorlike_header
Current layout limits the pseudovectors to 63 PVEC_xxx subtypes,
4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */
ptrdiff_t size;
char alignas (GCALIGNMENT) gcaligned;
GCALIGNED_UNION
};
verify (alignof (union vectorlike_header) % GCALIGNMENT == 0);
verify (!USE_LSB_TAG || alignof (union vectorlike_header) % GCALIGNMENT == 0);
INLINE bool
(SYMBOLP) (Lisp_Object x)
......@@ -1250,10 +1256,10 @@ struct Lisp_Cons
struct Lisp_Cons *chain;
} u;
} s;
char alignas (GCALIGNMENT) gcaligned;
GCALIGNED_UNION
} u;
};
verify (alignof (struct Lisp_Cons) % GCALIGNMENT == 0);
verify (!USE_LSB_TAG || alignof (struct Lisp_Cons) % GCALIGNMENT == 0);
INLINE bool
(NILP) (Lisp_Object x)
......@@ -1372,10 +1378,10 @@ struct Lisp_String
unsigned char *data;
} s;
struct Lisp_String *next;
char alignas (GCALIGNMENT) gcaligned;
GCALIGNED_UNION
} u;
};
verify (alignof (struct Lisp_String) % GCALIGNMENT == 0);
verify (!USE_LSB_TAG || alignof (struct Lisp_String) % GCALIGNMENT == 0);
INLINE bool
STRINGP (Lisp_Object x)
......@@ -3977,6 +3983,7 @@ extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object);
extern void record_unwind_protect_ptr (void (*) (void *), void *);
extern void record_unwind_protect_int (void (*) (int), int);
extern void record_unwind_protect_void (void (*) (void));
extern void record_unwind_protect_excursion (void);
extern void record_unwind_protect_nothing (void);
extern void clear_unwind_protect (ptrdiff_t);
extern void set_unwind_protect (ptrdiff_t, void (*) (Lisp_Object), Lisp_Object);
......@@ -4680,13 +4687,14 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
#define SAFE_ALLOCA_LISP(buf, nelt) SAFE_ALLOCA_LISP_EXTRA (buf, nelt, 0)
/* If USE_STACK_LISP_OBJECTS, define macros that and functions that allocate
block-scoped conses and strings. These objects are not
managed by the garbage collector, so they are dangerous: passing them
out of their scope (e.g., to user code) results in undefined behavior.
Conversely, they have better performance because GC is not involved.