From a9cee9c6675a7002441bdd186402f45eb5379172 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sun, 14 Jan 2024 11:58:33 +0100 Subject: [PATCH] Retype traverse_interval arg type from Lisp_Object to void * This is a refactoring. It eliminates a few unnecessary conses and allows for further improvements. * src/intervals.c (traverse_intervals): Change argument type. All callers adapted. * src/fns.c (collect_interval, Fsxhash_equal_including_properties) (Fobject_intervals): * src/print.c (print_check_string_charset_prop) (print_prune_string_charset, print_object, print_interval): Pass a pointer to a Lisp_Object instead of a Lisp_Object. --- src/fns.c | 24 +++++++++++++----------- src/intervals.c | 2 +- src/intervals.h | 4 ++-- src/print.c | 15 ++++++++------- 4 files changed, 24 insertions(+), 21 deletions(-) diff --git a/src/fns.c b/src/fns.c index 2905c3f1b86..f7c36aacea6 100644 --- a/src/fns.c +++ b/src/fns.c @@ -5241,12 +5241,14 @@ sxhash_obj (Lisp_Object obj, int depth) } static void -collect_interval (INTERVAL interval, Lisp_Object collector) +collect_interval (INTERVAL interval, void *arg) { - nconc2 (collector, - list1(list3 (make_fixnum (interval->position), - make_fixnum (interval->position + LENGTH (interval)), - interval->plist))); + Lisp_Object *collector = arg; + *collector = + nconc2 (*collector, + list1(list3 (make_fixnum (interval->position), + make_fixnum (interval->position + LENGTH (interval)), + interval->plist))); } @@ -5309,13 +5311,13 @@ Hash codes are not guaranteed to be preserved across Emacs sessions. */) if (STRINGP (obj)) { /* FIXME: This is very wasteful. We needn't cons at all. */ - Lisp_Object collector = Fcons (Qnil, Qnil); + Lisp_Object collector = Qnil; traverse_intervals (string_intervals (obj), 0, collect_interval, - collector); + &collector); return make_ufixnum ( SXHASH_REDUCE (sxhash_combine (sxhash (obj), - sxhash (CDR (collector))))); + sxhash (collector)))); } return hash_hash_to_fixnum (hashfn_equal (obj, NULL)); @@ -6304,7 +6306,7 @@ Altering this copy does not change the layout of the text properties in OBJECT. */) (register Lisp_Object object) { - Lisp_Object collector = Fcons (Qnil, Qnil); + Lisp_Object collector = Qnil; INTERVAL intervals; if (STRINGP (object)) @@ -6317,8 +6319,8 @@ in OBJECT. */) if (! intervals) return Qnil; - traverse_intervals (intervals, 0, collect_interval, collector); - return CDR (collector); + traverse_intervals (intervals, 0, collect_interval, &collector); + return collector; } DEFUN ("line-number-at-pos", Fline_number_at_pos, diff --git a/src/intervals.c b/src/intervals.c index 1b1fb3b8181..2ab19c2cc56 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -256,7 +256,7 @@ traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, void *), void traverse_intervals (INTERVAL tree, ptrdiff_t position, - void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg) + void (*function) (INTERVAL, void *), void *arg) { while (tree) { diff --git a/src/intervals.h b/src/intervals.h index aa7502b4f68..610c803cc77 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -245,8 +245,8 @@ extern INTERVAL create_root_interval (Lisp_Object); extern void copy_properties (INTERVAL, INTERVAL); extern bool intervals_equal (INTERVAL, INTERVAL); extern void traverse_intervals (INTERVAL, ptrdiff_t, - void (*) (INTERVAL, Lisp_Object), - Lisp_Object); + void (*) (INTERVAL, void *), + void *); extern void traverse_intervals_noorder (INTERVAL, void (*) (INTERVAL, void *), void *); extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t) diff --git a/src/print.c b/src/print.c index 58a23b79d5d..0899dcdeb03 100644 --- a/src/print.c +++ b/src/print.c @@ -87,7 +87,7 @@ static struct print_buffer print_buffer; print_number_index holds the largest N already used. N has to be strictly larger than 0 since we need to distinguish -N. */ static ptrdiff_t print_number_index; -static void print_interval (INTERVAL interval, Lisp_Object printcharfun); +static void print_interval (INTERVAL interval, void *pprintcharfun); /* GDB resets this to zero on W32 to disable OutputDebugString calls. */ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1; @@ -1493,8 +1493,6 @@ print_preprocess_string (INTERVAL interval, void *arg) print_preprocess (interval->plist); } -static void print_check_string_charset_prop (INTERVAL interval, Lisp_Object string); - #define PRINT_STRING_NON_CHARSET_FOUND 1 #define PRINT_STRING_UNSAFE_CHARSET_FOUND 2 @@ -1502,7 +1500,7 @@ static void print_check_string_charset_prop (INTERVAL interval, Lisp_Object stri static int print_check_string_result; static void -print_check_string_charset_prop (INTERVAL interval, Lisp_Object string) +print_check_string_charset_prop (INTERVAL interval, void *pstring) { Lisp_Object val; @@ -1526,6 +1524,7 @@ print_check_string_charset_prop (INTERVAL interval, Lisp_Object string) if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) { ptrdiff_t charpos = interval->position; + Lisp_Object string = *(Lisp_Object *)pstring; ptrdiff_t bytepos = string_char_to_byte (string, charpos); Lisp_Object charset = XCAR (XCDR (val)); @@ -1550,7 +1549,7 @@ print_prune_string_charset (Lisp_Object string) { print_check_string_result = 0; traverse_intervals (string_intervals (string), 0, - print_check_string_charset_prop, string); + print_check_string_charset_prop, &string); if (NILP (Vprint_charset_text_property) || ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) { @@ -2401,8 +2400,9 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) if (string_intervals (obj)) { + Lisp_Object pcf = printcharfun; traverse_intervals (string_intervals (obj), - 0, print_interval, printcharfun); + 0, print_interval, &pcf); printchar (')', printcharfun); } } @@ -2792,10 +2792,11 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) This is part of printing a string that has text properties. */ static void -print_interval (INTERVAL interval, Lisp_Object printcharfun) +print_interval (INTERVAL interval, void *pprintcharfun) { if (NILP (interval->plist)) return; + Lisp_Object printcharfun = *(Lisp_Object *)pprintcharfun; printchar (' ', printcharfun); print_object (make_fixnum (interval->position), printcharfun, 1); printchar (' ', printcharfun); -- 2.39.2