summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorAndrea Corallo <akrl@sdf.org>2020-03-29 12:31:24 +0100
committerAndrea Corallo <akrl@sdf.org>2020-03-29 12:31:24 +0100
commit00ee320a620704ae12a1e2104c2d08bf8bbdf0c9 (patch)
tree498c59219b572c89e10f9521b54c98896cb52ca9 /src
parent530faee2752c7b316fa21f2ac4d1266d3e7a38e6 (diff)
parent76b3bd8cbb9a0a01941d9c1766c054960e4bfd97 (diff)
Merge remote-tracking branch 'savannah/master' into HEAD
Diffstat (limited to 'src')
-rw-r--r--src/bignum.h2
-rw-r--r--src/buffer.c32
-rw-r--r--src/buffer.h2
-rw-r--r--src/character.c6
-rw-r--r--src/cmds.c15
-rw-r--r--src/coding.c42
-rw-r--r--src/composite.c17
-rw-r--r--src/data.c77
-rw-r--r--src/editfns.c121
-rw-r--r--src/emacs-module.c9
-rw-r--r--src/fileio.c2
-rw-r--r--src/filelock.c24
-rw-r--r--src/fns.c18
-rw-r--r--src/font.c16
-rw-r--r--src/fringe.c6
-rw-r--r--src/lisp.h32
-rw-r--r--src/module-env-28.h3
-rw-r--r--src/process.c12
-rw-r--r--src/process.h2
-rw-r--r--src/search.c3
-rw-r--r--src/textprop.c15
-rw-r--r--src/window.c5
-rw-r--r--src/xdisp.c20
23 files changed, 216 insertions, 265 deletions
diff --git a/src/bignum.h b/src/bignum.h
index 0c2541a9dc7..ad9021f15fd 100644
--- a/src/bignum.h
+++ b/src/bignum.h
@@ -55,7 +55,7 @@ extern void emacs_mpz_mul_2exp (mpz_t, mpz_t const, EMACS_INT)
ARG_NONNULL ((1, 2));
extern void emacs_mpz_pow_ui (mpz_t, mpz_t const, unsigned long)
ARG_NONNULL ((1, 2));
-extern double mpz_get_d_rounded (mpz_t const);
+extern double mpz_get_d_rounded (mpz_t const) ATTRIBUTE_CONST;
INLINE_HEADER_BEGIN
diff --git a/src/buffer.c b/src/buffer.c
index cc7d4e4817c..70598a7a22a 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -131,6 +131,23 @@ CHECK_OVERLAY (Lisp_Object x)
CHECK_TYPE (OVERLAYP (x), Qoverlayp, x);
}
+/* Convert the position POS to an EMACS_INT that fits in a fixnum.
+ Yield POS's value if POS is already a fixnum, POS's marker position
+ if POS is a marker, and MOST_NEGATIVE_FIXNUM or
+ MOST_POSITIVE_FIXNUM if POS is a negative or positive bignum.
+ Signal an error if POS is not of the proper form. */
+
+EMACS_INT
+fix_position (Lisp_Object pos)
+{
+ if (FIXNUMP (pos))
+ return XFIXNUM (pos);
+ if (MARKERP (pos))
+ return marker_position (pos);
+ CHECK_TYPE (BIGNUMP (pos), Qinteger_or_marker_p, pos);
+ return !NILP (Fnatnump (pos)) ? MOST_POSITIVE_FIXNUM : MOST_NEGATIVE_FIXNUM;
+}
+
/* These setters are used only in this file, so they can be private.
The public setters are inline functions defined in buffer.h. */
static void
@@ -2257,19 +2274,20 @@ so the buffer is truly empty after this. */)
}
void
-validate_region (register Lisp_Object *b, register Lisp_Object *e)
+validate_region (Lisp_Object *b, Lisp_Object *e)
{
- CHECK_FIXNUM_COERCE_MARKER (*b);
- CHECK_FIXNUM_COERCE_MARKER (*e);
+ EMACS_INT beg = fix_position (*b), end = fix_position (*e);
- if (XFIXNUM (*b) > XFIXNUM (*e))
+ if (end < beg)
{
- Lisp_Object tem;
- tem = *b; *b = *e; *e = tem;
+ EMACS_INT tem = beg; beg = end; end = tem;
}
- if (! (BEGV <= XFIXNUM (*b) && XFIXNUM (*e) <= ZV))
+ if (! (BEGV <= beg && end <= ZV))
args_out_of_range_3 (Fcurrent_buffer (), *b, *e);
+
+ *b = make_fixnum (beg);
+ *e = make_fixnum (end);
}
/* Advance BYTE_POS up to a character boundary
diff --git a/src/buffer.h b/src/buffer.h
index fd05fdd37de..31f497ea40a 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -1150,6 +1150,8 @@ extern Lisp_Object interval_insert_behind_hooks;
extern Lisp_Object interval_insert_in_front_hooks;
+extern EMACS_INT fix_position (Lisp_Object);
+#define CHECK_FIXNUM_COERCE_MARKER(x) ((x) = make_fixnum (fix_position (x)))
extern void delete_all_overlays (struct buffer *);
extern void reset_buffer (struct buffer *);
extern void compact_buffer (struct buffer *);
diff --git a/src/character.c b/src/character.c
index 5d419a2e836..d71cb3f145c 100644
--- a/src/character.c
+++ b/src/character.c
@@ -931,10 +931,10 @@ character is not ASCII nor 8-bit character, an error is signaled. */)
}
else
{
- CHECK_FIXNUM_COERCE_MARKER (position);
- if (XFIXNUM (position) < BEGV || XFIXNUM (position) >= ZV)
+ EMACS_INT fixed_pos = fix_position (position);
+ if (! (BEGV <= fixed_pos && fixed_pos < ZV))
args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
- pos = XFIXNAT (position);
+ pos = fixed_pos;
p = CHAR_POS_ADDR (pos);
}
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
diff --git a/src/cmds.c b/src/cmds.c
index 5d7a45e65f6..c342cd88bd8 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -31,15 +31,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
static int internal_self_insert (int, EMACS_INT);
-DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0,
- doc: /* Return buffer position N characters after (before if N negative) point. */)
- (Lisp_Object n)
-{
- CHECK_FIXNUM (n);
-
- return make_fixnum (PT + XFIXNUM (n));
-}
-
/* Add N to point; or subtract N if FORWARD is false. N defaults to 1.
Validate the new location. Return nil. */
static Lisp_Object
@@ -460,7 +451,10 @@ internal_self_insert (int c, EMACS_INT n)
string = concat2 (string, tem);
}
- replace_range (PT, PT + chars_to_delete, string, 1, 1, 1, 0);
+ ptrdiff_t to;
+ if (INT_ADD_WRAPV (PT, chars_to_delete, &to))
+ to = PTRDIFF_MAX;
+ replace_range (PT, to, string, 1, 1, 1, 0);
Fforward_char (make_fixnum (n));
}
else if (n > 1)
@@ -526,7 +520,6 @@ syms_of_cmds (void)
This is run after inserting the character. */);
Vpost_self_insert_hook = Qnil;
- defsubr (&Sforward_point);
defsubr (&Sforward_char);
defsubr (&Sbackward_char);
defsubr (&Sforward_line);
diff --git a/src/coding.c b/src/coding.c
index 8b54281c0bf..0bea2a0c2bc 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -9023,23 +9023,23 @@ DEFUN ("find-coding-systems-region-internal",
}
else
{
- CHECK_FIXNUM_COERCE_MARKER (start);
- CHECK_FIXNUM_COERCE_MARKER (end);
- if (XFIXNUM (start) < BEG || XFIXNUM (end) > Z || XFIXNUM (start) > XFIXNUM (end))
+ EMACS_INT s = fix_position (start);
+ EMACS_INT e = fix_position (end);
+ if (! (BEG <= s && s <= e && e <= Z))
args_out_of_range (start, end);
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
return Qt;
- start_byte = CHAR_TO_BYTE (XFIXNUM (start));
- end_byte = CHAR_TO_BYTE (XFIXNUM (end));
- if (XFIXNUM (end) - XFIXNUM (start) == end_byte - start_byte)
+ start_byte = CHAR_TO_BYTE (s);
+ end_byte = CHAR_TO_BYTE (e);
+ if (e - s == end_byte - start_byte)
return Qt;
- if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT)
+ if (s < GPT && GPT < e)
{
- if ((GPT - XFIXNUM (start)) < (XFIXNUM (end) - GPT))
- move_gap_both (XFIXNUM (start), start_byte);
+ if (GPT - s < e - GPT)
+ move_gap_both (s, start_byte);
else
- move_gap_both (XFIXNUM (end), end_byte);
+ move_gap_both (e, end_byte);
}
}
@@ -9277,25 +9277,25 @@ is nil. */)
}
else
{
- CHECK_FIXNUM_COERCE_MARKER (start);
- CHECK_FIXNUM_COERCE_MARKER (end);
- if (XFIXNUM (start) < BEG || XFIXNUM (end) > Z || XFIXNUM (start) > XFIXNUM (end))
+ EMACS_INT s = fix_position (start);
+ EMACS_INT e = fix_position (end);
+ if (! (BEG <= s && s <= e && e <= Z))
args_out_of_range (start, end);
if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
return Qnil;
- start_byte = CHAR_TO_BYTE (XFIXNUM (start));
- end_byte = CHAR_TO_BYTE (XFIXNUM (end));
- if (XFIXNUM (end) - XFIXNUM (start) == end_byte - start_byte)
+ start_byte = CHAR_TO_BYTE (s);
+ end_byte = CHAR_TO_BYTE (e);
+ if (e - s == end_byte - start_byte)
return Qnil;
- if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT)
+ if (s < GPT && GPT < e)
{
- if ((GPT - XFIXNUM (start)) < (XFIXNUM (end) - GPT))
- move_gap_both (XFIXNUM (start), start_byte);
+ if (GPT - s < e - GPT)
+ move_gap_both (s, start_byte);
else
- move_gap_both (XFIXNUM (end), end_byte);
+ move_gap_both (e, end_byte);
}
- pos = XFIXNUM (start);
+ pos = s;
}
list = Qnil;
diff --git a/src/composite.c b/src/composite.c
index 84de334ce0d..a00a4541f5e 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -1839,27 +1839,24 @@ See `find-composition' for more details. */)
ptrdiff_t start, end, from, to;
int id;
- CHECK_FIXNUM_COERCE_MARKER (pos);
+ EMACS_INT fixed_pos = fix_position (pos);
if (!NILP (limit))
- {
- CHECK_FIXNUM_COERCE_MARKER (limit);
- to = min (XFIXNUM (limit), ZV);
- }
+ to = clip_to_bounds (PTRDIFF_MIN, fix_position (limit), ZV);
else
to = -1;
if (!NILP (string))
{
CHECK_STRING (string);
- if (XFIXNUM (pos) < 0 || XFIXNUM (pos) > SCHARS (string))
+ if (! (0 <= fixed_pos && fixed_pos <= SCHARS (string)))
args_out_of_range (string, pos);
}
else
{
- if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) > ZV)
+ if (! (BEGV <= fixed_pos && fixed_pos <= ZV))
args_out_of_range (Fcurrent_buffer (), pos);
}
- from = XFIXNUM (pos);
+ from = fixed_pos;
if (!find_composition (from, to, &start, &end, &prop, string))
{
@@ -1870,12 +1867,12 @@ See `find-composition' for more details. */)
return list3 (make_fixnum (start), make_fixnum (end), gstring);
return Qnil;
}
- if ((end <= XFIXNUM (pos) || start > XFIXNUM (pos)))
+ if (! (start <= fixed_pos && fixed_pos < end))
{
ptrdiff_t s, e;
if (find_automatic_composition (from, to, &s, &e, &gstring, string)
- && (e <= XFIXNUM (pos) ? e > end : s < start))
+ && (e <= fixed_pos ? e > end : s < start))
return list3 (make_fixnum (s), make_fixnum (e), gstring);
}
if (!composition_valid_p (start, end, prop))
diff --git a/src/data.c b/src/data.c
index 2820f647981..b53b8409b59 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2368,6 +2368,24 @@ bool-vector. IDX starts at 0. */)
/* Arithmetic functions */
+static Lisp_Object
+check_integer_coerce_marker (Lisp_Object x)
+{
+ if (MARKERP (x))
+ return make_fixnum (marker_position (x));
+ CHECK_TYPE (INTEGERP (x), Qinteger_or_marker_p, x);
+ return x;
+}
+
+static Lisp_Object
+check_number_coerce_marker (Lisp_Object x)
+{
+ if (MARKERP (x))
+ return make_fixnum (marker_position (x));
+ CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x);
+ return x;
+}
+
Lisp_Object
arithcompare (Lisp_Object num1, Lisp_Object num2,
enum Arith_Comparison comparison)
@@ -2376,8 +2394,8 @@ arithcompare (Lisp_Object num1, Lisp_Object num2,
bool lt, eq = true, gt;
bool test;
- CHECK_NUMBER_COERCE_MARKER (num1);
- CHECK_NUMBER_COERCE_MARKER (num2);
+ num1 = check_number_coerce_marker (num1);
+ num2 = check_number_coerce_marker (num2);
/* If the comparison is mostly done by comparing two doubles,
set LT, EQ, and GT to the <, ==, > results of that comparison,
@@ -2779,9 +2797,7 @@ floatop_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
argnum++;
if (argnum == nargs)
return make_float (accum);
- Lisp_Object val = args[argnum];
- CHECK_NUMBER_COERCE_MARKER (val);
- next = XFLOATINT (val);
+ next = XFLOATINT (check_number_coerce_marker (args[argnum]));
}
}
@@ -2843,8 +2859,7 @@ bignum_arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
argnum++;
if (argnum == nargs)
return make_integer_mpz ();
- val = args[argnum];
- CHECK_NUMBER_COERCE_MARKER (val);
+ val = check_number_coerce_marker (args[argnum]);
if (FLOATP (val))
return float_arith_driver (code, nargs, args, argnum,
mpz_get_d_rounded (*accum), val);
@@ -2873,8 +2888,7 @@ arith_driver (enum arithop code, ptrdiff_t nargs, Lisp_Object *args,
argnum++;
if (argnum == nargs)
return make_int (accum);
- val = args[argnum];
- CHECK_NUMBER_COERCE_MARKER (val);
+ val = check_number_coerce_marker (args[argnum]);
/* Set NEXT to the next value if it fits, else exit the loop. */
intmax_t next;
@@ -2921,8 +2935,7 @@ usage: (+ &rest NUMBERS-OR-MARKERS) */)
{
if (nargs == 0)
return make_fixnum (0);
- Lisp_Object a = args[0];
- CHECK_NUMBER_COERCE_MARKER (a);
+ Lisp_Object a = check_number_coerce_marker (args[0]);
return nargs == 1 ? a : arith_driver (Aadd, nargs, args, a);
}
@@ -2935,8 +2948,7 @@ usage: (- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS) */)
{
if (nargs == 0)
return make_fixnum (0);
- Lisp_Object a = args[0];
- CHECK_NUMBER_COERCE_MARKER (a);
+ Lisp_Object a = check_number_coerce_marker (args[0]);
if (nargs == 1)
{
if (FIXNUMP (a))
@@ -2956,8 +2968,7 @@ usage: (* &rest NUMBERS-OR-MARKERS) */)
{
if (nargs == 0)
return make_fixnum (1);
- Lisp_Object a = args[0];
- CHECK_NUMBER_COERCE_MARKER (a);
+ Lisp_Object a = check_number_coerce_marker (args[0]);
return nargs == 1 ? a : arith_driver (Amult, nargs, args, a);
}
@@ -2969,8 +2980,7 @@ The arguments must be numbers or markers.
usage: (/ NUMBER &rest DIVISORS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object a = args[0];
- CHECK_NUMBER_COERCE_MARKER (a);
+ Lisp_Object a = check_number_coerce_marker (args[0]);
if (nargs == 1)
{
if (FIXNUMP (a))
@@ -3052,10 +3062,10 @@ integer_remainder (Lisp_Object num, Lisp_Object den, bool modulo)
DEFUN ("%", Frem, Srem, 2, 2, 0,
doc: /* Return remainder of X divided by Y.
Both must be integers or markers. */)
- (register Lisp_Object x, Lisp_Object y)
+ (Lisp_Object x, Lisp_Object y)
{
- CHECK_INTEGER_COERCE_MARKER (x);
- CHECK_INTEGER_COERCE_MARKER (y);
+ x = check_integer_coerce_marker (x);
+ y = check_integer_coerce_marker (y);
return integer_remainder (x, y, false);
}
@@ -3065,8 +3075,8 @@ The result falls between zero (inclusive) and Y (exclusive).
Both X and Y must be numbers or markers. */)
(Lisp_Object x, Lisp_Object y)
{
- CHECK_NUMBER_COERCE_MARKER (x);
- CHECK_NUMBER_COERCE_MARKER (y);
+ x = check_number_coerce_marker (x);
+ y = check_number_coerce_marker (y);
if (FLOATP (x) || FLOATP (y))
return fmod_float (x, y);
return integer_remainder (x, y, true);
@@ -3076,12 +3086,10 @@ static Lisp_Object
minmax_driver (ptrdiff_t nargs, Lisp_Object *args,
enum Arith_Comparison comparison)
{
- Lisp_Object accum = args[0];
- CHECK_NUMBER_COERCE_MARKER (accum);
+ Lisp_Object accum = check_number_coerce_marker (args[0]);
for (ptrdiff_t argnum = 1; argnum < nargs; argnum++)
{
- Lisp_Object val = args[argnum];
- CHECK_NUMBER_COERCE_MARKER (val);
+ Lisp_Object val = check_number_coerce_marker (args[argnum]);
if (!NILP (arithcompare (val, accum, comparison)))
accum = val;
else if (FLOATP (val) && isnan (XFLOAT_DATA (val)))
@@ -3116,8 +3124,7 @@ usage: (logand &rest INTS-OR-MARKERS) */)
{
if (nargs == 0)
return make_fixnum (-1);
- Lisp_Object a = args[0];
- CHECK_INTEGER_COERCE_MARKER (a);
+ Lisp_Object a = check_integer_coerce_marker (args[0]);
return nargs == 1 ? a : arith_driver (Alogand, nargs, args, a);
}
@@ -3129,8 +3136,7 @@ usage: (logior &rest INTS-OR-MARKERS) */)
{
if (nargs == 0)
return make_fixnum (0);
- Lisp_Object a = args[0];
- CHECK_INTEGER_COERCE_MARKER (a);
+ Lisp_Object a = check_integer_coerce_marker (args[0]);
return nargs == 1 ? a : arith_driver (Alogior, nargs, args, a);
}
@@ -3142,8 +3148,7 @@ usage: (logxor &rest INTS-OR-MARKERS) */)
{
if (nargs == 0)
return make_fixnum (0);
- Lisp_Object a = args[0];
- CHECK_INTEGER_COERCE_MARKER (a);
+ Lisp_Object a = check_integer_coerce_marker (args[0]);
return nargs == 1 ? a : arith_driver (Alogxor, nargs, args, a);
}
@@ -3262,9 +3267,9 @@ expt_integer (Lisp_Object x, Lisp_Object y)
DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0,
doc: /* Return NUMBER plus one. NUMBER may be a number or a marker.
Markers are converted to integers. */)
- (register Lisp_Object number)
+ (Lisp_Object number)
{
- CHECK_NUMBER_COERCE_MARKER (number);
+ number = check_number_coerce_marker (number);
if (FIXNUMP (number))
return make_int (XFIXNUM (number) + 1);
@@ -3277,9 +3282,9 @@ Markers are converted to integers. */)
DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0,
doc: /* Return NUMBER minus one. NUMBER may be a number or a marker.
Markers are converted to integers. */)
- (register Lisp_Object number)
+ (Lisp_Object number)
{
- CHECK_NUMBER_COERCE_MARKER (number);
+ number = check_number_coerce_marker (number);
if (FIXNUMP (number))
return make_int (XFIXNUM (number) - 1);
diff --git a/src/editfns.c b/src/editfns.c
index eb15566fb48..90520d0dced 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -725,18 +725,23 @@ boundaries, bind `inhibit-field-text-motion' to t.
This function does not move point. */)
(Lisp_Object n)
{
- ptrdiff_t charpos, bytepos;
+ ptrdiff_t charpos, bytepos, count;
if (NILP (n))
- XSETFASTINT (n, 1);
+ count = 0;
+ else if (FIXNUMP (n))
+ count = clip_to_bounds (-BUF_BYTES_MAX, XFIXNUM (n) - 1, BUF_BYTES_MAX);
else
- CHECK_FIXNUM (n);
+ {
+ CHECK_INTEGER (n);
+ count = NILP (Fnatnump (n)) ? -BUF_BYTES_MAX : BUF_BYTES_MAX;
+ }
- scan_newline_from_point (XFIXNUM (n) - 1, &charpos, &bytepos);
+ scan_newline_from_point (count, &charpos, &bytepos);
/* Return END constrained to the current input field. */
return Fconstrain_to_field (make_fixnum (charpos), make_fixnum (PT),
- XFIXNUM (n) != 1 ? Qt : Qnil,
+ count != 0 ? Qt : Qnil,
Qt, Qnil);
}
@@ -763,11 +768,14 @@ This function does not move point. */)
ptrdiff_t orig = PT;
if (NILP (n))
- XSETFASTINT (n, 1);
+ clipped_n = 1;
+ else if (FIXNUMP (n))
+ clipped_n = clip_to_bounds (-BUF_BYTES_MAX, XFIXNUM (n), BUF_BYTES_MAX);
else
- CHECK_FIXNUM (n);
-
- clipped_n = clip_to_bounds (PTRDIFF_MIN + 1, XFIXNUM (n), PTRDIFF_MAX);
+ {
+ CHECK_INTEGER (n);
+ clipped_n = NILP (Fnatnump (n)) ? -BUF_BYTES_MAX : BUF_BYTES_MAX;
+ }
end_pos = find_before_next_newline (orig, 0, clipped_n - (clipped_n <= 0),
NULL);
@@ -940,10 +948,10 @@ DEFUN ("position-bytes", Fposition_bytes, Sposition_bytes, 1, 1, 0,
If POSITION is out of range, the value is nil. */)
(Lisp_Object position)
{
- CHECK_FIXNUM_COERCE_MARKER (position);
- if (XFIXNUM (position) < BEG || XFIXNUM (position) > Z)
+ EMACS_INT pos = fix_position (position);
+ if (! (BEG <= pos && pos <= Z))
return Qnil;
- return make_fixnum (CHAR_TO_BYTE (XFIXNUM (position)));
+ return make_fixnum (CHAR_TO_BYTE (pos));
}
DEFUN ("byte-to-position", Fbyte_to_position, Sbyte_to_position, 1, 1, 0,
@@ -1060,11 +1068,11 @@ If POS is out of range, the value is nil. */)
}
else
{
- CHECK_FIXNUM_COERCE_MARKER (pos);
- if (XFIXNUM (pos) < BEGV || XFIXNUM (pos) >= ZV)
+ EMACS_INT p = fix_position (pos);
+ if (! (BEGV <= p && p < ZV))
return Qnil;
- pos_byte = CHAR_TO_BYTE (XFIXNUM (pos));
+ pos_byte = CHAR_TO_BYTE (p);
}
return make_fixnum (FETCH_CHAR (pos_byte));
@@ -1094,12 +1102,12 @@ If POS is out of range, the value is nil. */)
}
else
{
- CHECK_FIXNUM_COERCE_MARKER (pos);
+ EMACS_INT p = fix_position (pos);
- if (XFIXNUM (pos) <= BEGV || XFIXNUM (pos) > ZV)
+ if (! (BEGV < p && p <= ZV))
return Qnil;
- pos_byte = CHAR_TO_BYTE (XFIXNUM (pos));
+ pos_byte = CHAR_TO_BYTE (p);
}
if (!NILP (BVAR (current_buffer, enable_multibyte_characters)))
@@ -1718,21 +1726,8 @@ using `string-make-multibyte' or `string-make-unibyte', which see. */)
if (!BUFFER_LIVE_P (bp))
error ("Selecting deleted buffer");
- if (NILP (start))
- b = BUF_BEGV (bp);
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (start);
- b = XFIXNUM (start);
- }
- if (NILP (end))
- e = BUF_ZV (bp);
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (end);
- e = XFIXNUM (end);
- }
-
+ b = !NILP (start) ? fix_position (start) : BUF_BEGV (bp);
+ e = !NILP (end) ? fix_position (end) : BUF_ZV (bp);
if (b > e)
temp = b, b = e, e = temp;
@@ -1786,21 +1781,8 @@ determines whether case is significant or ignored. */)
error ("Selecting deleted buffer");
}
- if (NILP (start1))
- begp1 = BUF_BEGV (bp1);
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (start1);
- begp1 = XFIXNUM (start1);
- }
- if (NILP (end1))
- endp1 = BUF_ZV (bp1);
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (end1);
- endp1 = XFIXNUM (end1);
- }
-
+ begp1 = !NILP (start1) ? fix_position (start1) : BUF_BEGV (bp1);
+ endp1 = !NILP (end1) ? fix_position (end1) : BUF_ZV (bp1);
if (begp1 > endp1)
temp = begp1, begp1 = endp1, endp1 = temp;
@@ -1824,21 +1806,8 @@ determines whether case is significant or ignored. */)
error ("Selecting deleted buffer");
}
- if (NILP (start2))
- begp2 = BUF_BEGV (bp2);
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (start2);
- begp2 = XFIXNUM (start2);
- }
- if (NILP (end2))
- endp2 = BUF_ZV (bp2);
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (end2);
- endp2 = XFIXNUM (end2);
- }
-
+ begp2 = !NILP (start2) ? fix_position (start2) : BUF_BEGV (bp2);
+ endp2 = !NILP (end2) ? fix_position (end2) : BUF_ZV (bp2);
if (begp2 > endp2)
temp = begp2, begp2 = endp2, endp2 = temp;
@@ -2692,29 +2661,27 @@ See also `save-restriction'.
When calling from Lisp, pass two arguments START and END:
positions (integers or markers) bounding the text that should
remain visible. */)
- (register Lisp_Object start, Lisp_Object end)
+ (Lisp_Object start, Lisp_Object end)
{
- CHECK_FIXNUM_COERCE_MARKER (start);
- CHECK_FIXNUM_COERCE_MARKER (end);
+ EMACS_INT s = fix_position (start), e = fix_position (end);
- if (XFIXNUM (start) > XFIXNUM (end))
+ if (e < s)
{
- Lisp_Object tem;
- tem = start; start = end; end = tem;
+ EMACS_INT tem = s; s = e; e = tem;
}
- if (!(BEG <= XFIXNUM (start) && XFIXNUM (start) <= XFIXNUM (end) && XFIXNUM (end) <= Z))
+ if (!(BEG <= s && s <= e && e <= Z))
args_out_of_range (start, end);
- if (BEGV != XFIXNAT (start) || ZV != XFIXNAT (end))
+ if (BEGV != s || ZV != e)
current_buffer->clip_changed = 1;
- SET_BUF_BEGV (current_buffer, XFIXNAT (start));
- SET_BUF_ZV (current_buffer, XFIXNAT (end));
- if (PT < XFIXNAT (start))
- SET_PT (XFIXNAT (start));
- if (PT > XFIXNAT (end))
- SET_PT (XFIXNAT (end));
+ SET_BUF_BEGV (current_buffer, s);
+ SET_BUF_ZV (current_buffer, e);
+ if (PT < s)
+ SET_PT (s);
+ if (e < PT)
+ SET_PT (e);
/* Changing the buffer bounds invalidates any recorded current column. */
invalidate_current_column ();
return Qnil;
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 60f16418efa..cdcbe061b53 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -88,6 +88,7 @@ To add a new module function, proceed as follows:
#include "dynlib.h"
#include "coding.h"
#include "keyboard.h"
+#include "process.h"
#include "syssignal.h"
#include "sysstdio.h"
#include "thread.h"
@@ -977,6 +978,13 @@ module_make_big_integer (emacs_env *env, int sign,
return lisp_to_value (env, make_integer_mpz ());
}
+static int
+module_open_channel (emacs_env *env, emacs_value pipe_process)
+{
+ MODULE_FUNCTION_BEGIN (-1);
+ return open_channel_for_module (value_to_lisp (pipe_process));
+}
+
/* Subroutines. */
@@ -1391,6 +1399,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
env->make_big_integer = module_make_big_integer;
env->get_function_finalizer = module_get_function_finalizer;
env->set_function_finalizer = module_set_function_finalizer;
+ env->open_channel = module_open_channel;
Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
return env;
}
diff --git a/src/fileio.c b/src/fileio.c
index ffe79559a3f..978a373d39b 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -96,7 +96,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <acl.h>
#include <allocator.h>
#include <careadlinkat.h>
-#include <dosname.h>
+#include <filename.h>
#include <fsusage.h>
#include <stat-time.h>
#include <tempname.h>
diff --git a/src/filelock.c b/src/filelock.c
index 2b734ee00d5..ee46e0e3e00 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -661,7 +661,7 @@ void
lock_file (Lisp_Object fn)
{
Lisp_Object orig_fn, encoded_fn;
- char *lfname;
+ char *lfname = NULL;
lock_info_type lock_info;
USE_SAFE_ALLOCA;
@@ -686,21 +686,15 @@ lock_file (Lisp_Object fn)
/* See if this file is visited and has changed on disk since it was
visited. */
- {
- register Lisp_Object subject_buf;
-
- subject_buf = get_truename_buffer (orig_fn);
-
- if (!NILP (subject_buf)
- && NILP (Fverify_visited_file_modtime (subject_buf))
- && !NILP (Ffile_exists_p (fn))
- && (!create_lockfiles || current_lock_owner (NULL, lfname) != -2))
- call1 (intern ("userlock--ask-user-about-supersession-threat"), fn);
-
- }
+ Lisp_Object subject_buf = get_truename_buffer (orig_fn);
+ if (!NILP (subject_buf)
+ && NILP (Fverify_visited_file_modtime (subject_buf))
+ && !NILP (Ffile_exists_p (fn))
+ && !(lfname && current_lock_owner (NULL, lfname) == -2))
+ call1 (intern ("userlock--ask-user-about-supersession-threat"), fn);
/* Don't do locking if the user has opted out. */
- if (create_lockfiles)
+ if (lfname)
{
/* Try to lock the lock. FIXME: This ignores errors when
lock_if_free returns a positive errno value. */
@@ -860,7 +854,7 @@ syms_of_filelock (void)
The name of the (per-buffer) lockfile is constructed by prepending a
'.#' to the name of the file being locked. See also `lock-buffer' and
Info node `(emacs)Interlocking'. */);
- create_lockfiles = 1;
+ create_lockfiles = true;
defsubr (&Sunlock_buffer);
defsubr (&Slock_buffer);
diff --git a/src/fns.c b/src/fns.c
index 80012fa9d28..138082e07c8 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -5187,22 +5187,8 @@ extract_data_from_object (Lisp_Object spec,
struct buffer *bp = XBUFFER (object);
set_buffer_internal (bp);
- if (NILP (start))
- b = BEGV;
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (start);
- b = XFIXNUM (start);
- }
-
- if (NILP (end))
- e = ZV;
- else
- {
- CHECK_FIXNUM_COERCE_MARKER (end);
- e = XFIXNUM (end);
- }
-
+ b = !NILP (start) ? fix_position (start) : BEGV;
+ e = !NILP (end) ? fix_position (end) : ZV;
if (b > e)
{
EMACS_INT temp = b;
diff --git a/src/font.c b/src/font.c
index 2a456300619..0c9e752e089 100644
--- a/src/font.c
+++ b/src/font.c
@@ -4606,10 +4606,10 @@ DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
Lisp_Object window;
struct window *w;
- CHECK_FIXNUM_COERCE_MARKER (position);
- if (! (BEGV <= XFIXNUM (position) && XFIXNUM (position) < ZV))
+ EMACS_INT fixed_pos = fix_position (position);
+ if (! (BEGV <= fixed_pos && fixed_pos < ZV))
args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
- pos = XFIXNUM (position);
+ pos = fixed_pos;
pos_byte = CHAR_TO_BYTE (pos);
if (NILP (ch))
c = FETCH_CHAR (pos_byte);
@@ -5013,24 +5013,26 @@ character at index specified by POSITION. */)
(Lisp_Object position, Lisp_Object window, Lisp_Object string)
{
struct window *w = decode_live_window (window);
+ EMACS_INT pos;
if (NILP (string))
{
if (XBUFFER (w->contents) != current_buffer)
error ("Specified window is not displaying the current buffer");
- CHECK_FIXNUM_COERCE_MARKER (position);
- if (! (BEGV <= XFIXNUM (position) && XFIXNUM (position) < ZV))
+ pos = fix_position (position);
+ if (! (BEGV <= pos && pos < ZV))
args_out_of_range_3 (position, make_fixnum (BEGV), make_fixnum (ZV));
}
else
{
CHECK_FIXNUM (position);
CHECK_STRING (string);
- if (! (0 <= XFIXNUM (position) && XFIXNUM (position) < SCHARS (string)))
+ pos = XFIXNUM (position);
+ if (! (0 <= pos && pos < SCHARS (string)))
args_out_of_range (string, position);
}
- return font_at (-1, XFIXNUM (position), NULL, w, string);
+ return font_at (-1, pos, NULL, w, string);
}
#if 0
diff --git a/src/fringe.c b/src/fringe.c
index 2a46e3c34f2..d8d80bb3fe9 100644
--- a/src/fringe.c
+++ b/src/fringe.c
@@ -1675,10 +1675,10 @@ Return nil if POS is not visible in WINDOW. */)
if (!NILP (pos))
{
- CHECK_FIXNUM_COERCE_MARKER (pos);
- if (! (BEGV <= XFIXNUM (pos) && XFIXNUM (pos) <= ZV))
+ EMACS_INT p = fix_position (pos);
+ if (! (BEGV <= p && p <= ZV))
args_out_of_range (window, pos);
- textpos = XFIXNUM (pos);
+ textpos = p;
}
else if (w == XWINDOW (selected_window))
textpos = PT;
diff --git a/src/lisp.h b/src/lisp.h
index f86b4880f35..2f719b1f03e 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -585,7 +585,7 @@ INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
Lisp_Object);
/* Defined in bignum.c. */
-extern double bignum_to_double (Lisp_Object);
+extern double bignum_to_double (Lisp_Object) ATTRIBUTE_CONST;
extern Lisp_Object make_bigint (intmax_t);
extern Lisp_Object make_biguint (uintmax_t);
@@ -3023,14 +3023,6 @@ CHECK_FIXNAT (Lisp_Object x)
CHECK_RANGED_INTEGER (x, 0, TYPE_MAXIMUM (type)); \
} while (false)
-#define CHECK_FIXNUM_COERCE_MARKER(x) \
- do { \
- if (MARKERP ((x))) \
- XSETFASTINT (x, marker_position (x)); \
- else \
- CHECK_TYPE (FIXNUMP (x), Qinteger_or_marker_p, x); \
- } while (false)
-
INLINE double
XFLOATINT (Lisp_Object n)
{
@@ -3050,22 +3042,6 @@ CHECK_INTEGER (Lisp_Object x)
{
CHECK_TYPE (INTEGERP (x), Qnumberp, x);
}
-
-#define CHECK_NUMBER_COERCE_MARKER(x) \
- do { \
- if (MARKERP (x)) \
- XSETFASTINT (x, marker_position (x)); \
- else \
- CHECK_TYPE (NUMBERP (x), Qnumber_or_marker_p, x); \
- } while (false)
-
-#define CHECK_INTEGER_COERCE_MARKER(x) \
- do { \
- if (MARKERP (x)) \
- XSETFASTINT (x, marker_position (x)); \
- else \
- CHECK_TYPE (INTEGERP (x), Qnumber_or_marker_p, x); \
- } while (false)
/* If we're not dumping using the legacy dumper and we might be using
@@ -3519,9 +3495,9 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
/* Defined in bignum.c. This part of bignum.c's API does not require
the caller to access bignum internals; see bignum.h for that. */
-extern intmax_t bignum_to_intmax (Lisp_Object);
-extern uintmax_t bignum_to_uintmax (Lisp_Object);
-extern ptrdiff_t bignum_bufsize (Lisp_Object, int);
+extern intmax_t bignum_to_intmax (Lisp_Object) ATTRIBUTE_CONST;
+extern uintmax_t bignum_to_uintmax (Lisp_Object) ATTRIBUTE_CONST;
+extern ptrdiff_t bignum_bufsize (Lisp_Object, int) ATTRIBUTE_CONST;
extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int);
extern Lisp_Object bignum_to_string (Lisp_Object, int);
extern Lisp_Object make_bignum_str (char const *, int);
diff --git a/src/module-env-28.h b/src/module-env-28.h
index a2479a8f744..5d884c148c4 100644
--- a/src/module-env-28.h
+++ b/src/module-env-28.h
@@ -9,3 +9,6 @@
void (*set_function_finalizer) (emacs_env *env, emacs_value arg,
void (*fin) (void *) EMACS_NOEXCEPT)
EMACS_ATTRIBUTE_NONNULL (1);
+
+ int (*open_channel) (emacs_env *env, emacs_value pipe_process)
+ EMACS_ATTRIBUTE_NONNULL (1);
diff --git a/src/process.c b/src/process.c
index e4e5e57aeee..07881d6c5d3 100644
--- a/src/process.c
+++ b/src/process.c
@@ -8200,6 +8200,17 @@ restore_nofile_limit (void)
#endif
}
+int
+open_channel_for_module (Lisp_Object process)
+{
+ CHECK_PROCESS (process);
+ CHECK_TYPE (PIPECONN_P (process), Qpipe_process_p, process);
+ int fd = dup (XPROCESS (process)->open_fd[SUBPROCESS_STDOUT]);
+ if (fd == -1)
+ report_file_error ("Cannot duplicate file descriptor", Qnil);
+ return fd;
+}
+
/* This is not called "init_process" because that is the name of a
Mach system call, so it would cause problems on Darwin systems. */
@@ -8446,6 +8457,7 @@ amounts of data in one go. */);
DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions");
DEFSYM (Qnull, "null");
+ DEFSYM (Qpipe_process_p, "pipe-process-p");
defsubr (&Sprocessp);
defsubr (&Sget_process);
diff --git a/src/process.h b/src/process.h
index 7884efc5494..a783a31cb86 100644
--- a/src/process.h
+++ b/src/process.h
@@ -300,6 +300,8 @@ extern Lisp_Object remove_slash_colon (Lisp_Object);
extern void update_processes_for_thread_death (Lisp_Object);
extern void dissociate_controlling_tty (void);
+extern int open_channel_for_module (Lisp_Object);
+
INLINE_HEADER_END
#endif /* EMACS_PROCESS_H */
diff --git a/src/search.c b/src/search.c
index 818bb4af246..7389fbef0ee 100644
--- a/src/search.c
+++ b/src/search.c
@@ -1028,8 +1028,7 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror,
}
else
{
- CHECK_FIXNUM_COERCE_MARKER (bound);
- lim = XFIXNUM (bound);
+ lim = fix_position (bound);
if (n > 0 ? lim < PT : lim > PT)
error ("Invalid search bound (wrong side of point)");
if (lim > ZV)
diff --git a/src/textprop.c b/src/textprop.c
index ee048336ac0..960dba3f8dc 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -131,6 +131,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin,
{
INTERVAL i;
ptrdiff_t searchpos;
+ Lisp_Object begin0 = *begin, end0 = *end;
CHECK_STRING_OR_BUFFER (object);
CHECK_FIXNUM_COERCE_MARKER (*begin);
@@ -155,7 +156,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin,
if (!(BUF_BEGV (b) <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end)
&& XFIXNUM (*end) <= BUF_ZV (b)))
- args_out_of_range (*begin, *end);
+ args_out_of_range (begin0, end0);
i = buffer_intervals (b);
/* If there's no text, there are no properties. */
@@ -170,7 +171,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin,
if (! (0 <= XFIXNUM (*begin) && XFIXNUM (*begin) <= XFIXNUM (*end)
&& XFIXNUM (*end) <= len))
- args_out_of_range (*begin, *end);
+ args_out_of_range (begin0, end0);
i = string_intervals (object);
if (len == 0)
@@ -611,7 +612,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop,
{
struct window *w = 0;
- CHECK_FIXNUM_COERCE_MARKER (position);
+ EMACS_INT pos = fix_position (position);
if (NILP (object))
XSETBUFFER (object, current_buffer);
@@ -628,14 +629,14 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop,
Lisp_Object *overlay_vec;
struct buffer *obuf = current_buffer;
- if (XFIXNUM (position) < BUF_BEGV (XBUFFER (object))
- || XFIXNUM (position) > BUF_ZV (XBUFFER (object)))
+ if (! (BUF_BEGV (XBUFFER (object)) <= pos
+ && pos <= BUF_ZV (XBUFFER (object))))
xsignal1 (Qargs_out_of_range, position);
set_buffer_temp (XBUFFER (object));
USE_SAFE_ALLOCA;
- GET_OVERLAYS_AT (XFIXNUM (position), overlay_vec, noverlays, NULL, false);
+ GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, false);
noverlays = sort_overlays (overlay_vec, noverlays, w);
set_buffer_temp (obuf);
@@ -662,7 +663,7 @@ get_char_property_and_overlay (Lisp_Object position, register Lisp_Object prop,
/* Not a buffer, or no appropriate overlay, so fall through to the
simpler case. */
- return Fget_text_property (position, prop, object);
+ return Fget_text_property (make_fixnum (pos), prop, object);
}
DEFUN ("get-char-property", Fget_char_property, Sget_char_property, 2, 3, 0,
diff --git a/src/window.c b/src/window.c
index 8cdad27b664..075fd4e550c 100644
--- a/src/window.c
+++ b/src/window.c
@@ -1895,10 +1895,7 @@ POS, ROWH is the visible height of that row, and VPOS is the row number
if (EQ (pos, Qt))
posint = -1;
else if (!NILP (pos))
- {
- CHECK_FIXNUM_COERCE_MARKER (pos);
- posint = XFIXNUM (pos);
- }
+ posint = fix_position (pos);
else if (w == XWINDOW (selected_window))
posint = PT;
else
diff --git a/src/xdisp.c b/src/xdisp.c
index 04fc8aa3c45..61c798c59e8 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -815,11 +815,6 @@ static struct props it_props[] =
{0, 0, NULL}
};
-/* Value is the position described by X. If X is a marker, value is
- the marker_position of X. Otherwise, value is X. */
-
-#define COERCE_MARKER(X) (MARKERP ((X)) ? Fmarker_position (X) : (X))
-
/* Enumeration returned by some move_it_.* functions internally. */
enum move_it_result
@@ -10418,10 +10413,7 @@ include the height of both, if present, in the return value. */)
start = pos;
}
else
- {
- CHECK_FIXNUM_COERCE_MARKER (from);
- start = min (max (XFIXNUM (from), BEGV), ZV);
- }
+ start = clip_to_bounds (BEGV, fix_position (from), ZV);
if (NILP (to))
end = ZV;
@@ -10435,10 +10427,7 @@ include the height of both, if present, in the return value. */)
end = pos;
}
else
- {
- CHECK_FIXNUM_COERCE_MARKER (to);
- end = max (start, min (XFIXNUM (to), ZV));
- }
+ end = clip_to_bounds (start, fix_position (to), ZV);
if (!NILP (x_limit) && RANGED_FIXNUMP (0, x_limit, INT_MAX))
max_x = XFIXNUM (x_limit);
@@ -14944,7 +14933,7 @@ overlay_arrows_changed_p (bool set_redisplay)
val = find_symbol_value (var);
if (!MARKERP (val))
continue;
- if (! EQ (COERCE_MARKER (val),
+ if (! EQ (Fmarker_position (val),
/* FIXME: Don't we have a problem, using such a global
* "last-position" if the variable is buffer-local? */
Fget (var, Qlast_arrow_position))
@@ -14987,8 +14976,7 @@ update_overlay_arrows (int up_to_date)
Lisp_Object val = find_symbol_value (var);
if (!MARKERP (val))
continue;
- Fput (var, Qlast_arrow_position,
- COERCE_MARKER (val));
+ Fput (var, Qlast_arrow_position, Fmarker_position (val));
Fput (var, Qlast_arrow_string,
overlay_arrow_string_or_property (var));
}