1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 14:50:19 +02:00

Add 'scm_c_make_char' and use it where appropriate.

This reverts the change to SCM_MAKE_CHAR made in the previous commit
63818453ad, which used an arithmetic trick
to avoid evaluating its argument more than once.

Here, we restore the previous implementation of SCM_MAKE_CHAR, which
evaluates its argument twice.  Instead, we introduce a new inlinable
function 'scm_c_make_char' and replace uses of SCM_MAKE_CHAR with calls
to 'scm_c_make_char' where appropriate.

* libguile/chars.h (scm_c_make_char): New inline function.
* libguile/inline.c: Include chars.h.
* libguile/srfi-13.c (REF_IN_CHARSET, scm_string_any, scm_string_every)
(scm_string_trim, scm_string_trim_right, scm_string_trim_both)
(scm_string_index, scm_string_index_right, scm_string_skip)
(scm_string_skip_right, scm_string_count, string_titlecase_x)
(string_reverse_x, scm_string_fold, scm_string_fold_right)
(scm_string_for_each, scm_string_filter, scm_string_delete):
Use 'scm_c_make_char' instead of 'SCM_MAKE_CHAR' in cases where the
argument calls a function.
* libguile/chars.c (scm_char_upcase, scm_char_downcase, scm_char_titlecase),
libguile/ports.c (scm_port_decode_char),
libguile/print.c (scm_simple_format),
libguile/read.c (scm_read_character),
libguile/strings.c (scm_string_ref, scm_c_string_ref),
libguile/vm-engine.c ("string-ref"): Ditto.
This commit is contained in:
Mark H Weaver 2019-05-07 02:28:26 -04:00
parent 63818453ad
commit 2a1f22c00a
9 changed files with 59 additions and 47 deletions

View file

@ -1,5 +1,5 @@
/* Copyright (C) 1995,1996,1998, 2000, 2001, 2004, 2006, 2008, 2009, /* Copyright (C) 1995, 1996, 1998, 2000, 2001, 2004, 2006, 2008-2011,
* 2010, 2011, 2014 Free Software Foundation, Inc. * 2014, 2019 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -454,7 +454,7 @@ SCM_DEFINE (scm_char_upcase, "char-upcase", 1, 0, 0,
#define FUNC_NAME s_scm_char_upcase #define FUNC_NAME s_scm_char_upcase
{ {
SCM_VALIDATE_CHAR (1, chr); SCM_VALIDATE_CHAR (1, chr);
return SCM_MAKE_CHAR (scm_c_upcase (SCM_CHAR (chr))); return scm_c_make_char (scm_c_upcase (SCM_CHAR (chr)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -465,7 +465,7 @@ SCM_DEFINE (scm_char_downcase, "char-downcase", 1, 0, 0,
#define FUNC_NAME s_scm_char_downcase #define FUNC_NAME s_scm_char_downcase
{ {
SCM_VALIDATE_CHAR (1, chr); SCM_VALIDATE_CHAR (1, chr);
return SCM_MAKE_CHAR (scm_c_downcase (SCM_CHAR(chr))); return scm_c_make_char (scm_c_downcase (SCM_CHAR(chr)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -475,7 +475,7 @@ SCM_DEFINE (scm_char_titlecase, "char-titlecase", 1, 0, 0,
#define FUNC_NAME s_scm_char_titlecase #define FUNC_NAME s_scm_char_titlecase
{ {
SCM_VALIDATE_CHAR (1, chr); SCM_VALIDATE_CHAR (1, chr);
return SCM_MAKE_CHAR (scm_c_titlecase (SCM_CHAR(chr))); return scm_c_make_char (scm_c_titlecase (SCM_CHAR(chr)));
} }
#undef FUNC_NAME #undef FUNC_NAME

View file

@ -41,14 +41,13 @@ typedef scm_t_int32 scm_t_wchar;
(0 to 255) to Latin-1 codepoints (0 to 255) while allowing higher (0 to 255) to Latin-1 codepoints (0 to 255) while allowing higher
codepoints (256 to 1114111) to pass through unchanged. codepoints (256 to 1114111) to pass through unchanged.
To avoid evaluating X more than once, we use an arithmetic trick: we This macro evaluates X twice, which may lead to side effects if used
compute (X mod 2^N) mod (2^N - 256), which is equal to the required incorrectly. It's also likely to be inefficient if X calls a
mapping in the range -256 .. (2^N - 257). Here, N is the number of procedure. Use 'scm_c_make_char' in those cases. */
bits in scm_t_bits. Note that (scm_t_bits) (x) implicitly computes #define SCM_MAKE_CHAR(x) \
(X mod 2^N), and (scm_t_bits) -256 equals (2^N - 256). GCC is able ((x) <= 1 \
to optimize away these operations in practice. */ ? SCM_MAKE_ITAG8 ((scm_t_bits) (unsigned char) (x), scm_tc8_char) \
#define SCM_MAKE_CHAR(x) \ : SCM_MAKE_ITAG8 ((scm_t_bits) (x), scm_tc8_char))
(SCM_MAKE_ITAG8 ((scm_t_bits) (x) % (scm_t_bits) -256, scm_tc8_char))
#define SCM_CODEPOINT_DOTTED_CIRCLE (0x25cc) #define SCM_CODEPOINT_DOTTED_CIRCLE (0x25cc)
#define SCM_CODEPOINT_SURROGATE_START (0xd800) #define SCM_CODEPOINT_SURROGATE_START (0xd800)
@ -85,14 +84,25 @@ SCM_API SCM scm_char_upcase (SCM chr);
SCM_API SCM scm_char_downcase (SCM chr); SCM_API SCM scm_char_downcase (SCM chr);
SCM_API SCM scm_char_titlecase (SCM chr); SCM_API SCM scm_char_titlecase (SCM chr);
SCM_API SCM scm_char_general_category (SCM chr); SCM_API SCM scm_char_general_category (SCM chr);
SCM_INLINE SCM scm_c_make_char (scm_t_wchar c);
SCM_API scm_t_wchar scm_c_upcase (scm_t_wchar c); SCM_API scm_t_wchar scm_c_upcase (scm_t_wchar c);
SCM_API scm_t_wchar scm_c_downcase (scm_t_wchar c); SCM_API scm_t_wchar scm_c_downcase (scm_t_wchar c);
SCM_API scm_t_wchar scm_c_titlecase (scm_t_wchar c); SCM_API scm_t_wchar scm_c_titlecase (scm_t_wchar c);
SCM_INTERNAL const char *scm_i_charname (SCM chr); SCM_INTERNAL const char *scm_i_charname (SCM chr);
SCM_INTERNAL SCM scm_i_charname_to_char (const char *charname, SCM_INTERNAL SCM scm_i_charname_to_char (const char *charname,
size_t charname_len); size_t charname_len);
SCM_INTERNAL void scm_init_chars (void); SCM_INTERNAL void scm_init_chars (void);
#if SCM_CAN_INLINE || defined SCM_INLINE_C_IMPLEMENTING_INLINES
SCM_INLINE_IMPLEMENTATION SCM
scm_c_make_char (scm_t_wchar c)
{
return SCM_MAKE_CHAR(c);
}
#endif
#endif /* SCM_CHARS_H */ #endif /* SCM_CHARS_H */
/* /*

View file

@ -1,4 +1,5 @@
/* Copyright (C) 2001, 2006, 2008, 2011, 2012, 2013 Free Software Foundation, Inc. /* Copyright (C) 2001, 2006, 2008, 2011-2013, 2019
* Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -24,6 +25,7 @@
#define SCM_INLINE_C_IMPLEMENTING_INLINES 1 #define SCM_INLINE_C_IMPLEMENTING_INLINES 1
#include "libguile/inline.h" #include "libguile/inline.h"
#include "libguile/array-handle.h" #include "libguile/array-handle.h"
#include "libguile/chars.h"
#include "libguile/gc.h" #include "libguile/gc.h"
#include "libguile/smob.h" #include "libguile/smob.h"
#include "libguile/pairs.h" #include "libguile/pairs.h"

View file

@ -1914,7 +1914,7 @@ SCM_DEFINE (scm_port_decode_char, "port-decode-char", 4, 0, 0,
output. */ output. */
return SCM_BOOL_F; return SCM_BOOL_F;
return SCM_MAKE_CHAR (utf8_to_codepoint (utf8_buf, output_size)); return scm_c_make_char (utf8_to_codepoint (utf8_buf, output_size));
} }
} }
#undef FUNC_NAME #undef FUNC_NAME

View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995-2004, 2006, 2008-2018 Free Software Foundation, Inc. /* Copyright (C) 1995-2004, 2006, 2008-2019 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -1160,14 +1160,14 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
continue; continue;
default: default:
SCM_MISC_ERROR ("FORMAT: Unsupported format option ~~~A - use (ice-9 format) instead", SCM_MISC_ERROR ("FORMAT: Unsupported format option ~~~A - use (ice-9 format) instead",
scm_list_1 (SCM_MAKE_CHAR (scm_i_string_ref (message, p)))); scm_list_1 (scm_c_make_char (scm_i_string_ref (message, p))));
} }
if (!scm_is_pair (args)) if (!scm_is_pair (args))
SCM_MISC_ERROR ("FORMAT: Missing argument for ~~~A", SCM_MISC_ERROR ("FORMAT: Missing argument for ~~~A",
scm_list_1 (SCM_MAKE_CHAR (scm_i_string_ref (message, p)))); scm_list_1 (scm_c_make_char (scm_i_string_ref (message, p))));
scm_lfwrite_substr (message, start, p - 1, port); scm_lfwrite_substr (message, start, p - 1, port);
/* we pass destination here */ /* we pass destination here */

View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995-1997, 1999-2001, 2003, 2004, 2006-2012, 2014-2018 /* Copyright (C) 1995-1997, 1999-2001, 2003, 2004, 2006-2012, 2014-2019
* Free Software Foundation, Inc. * Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
@ -1092,7 +1092,7 @@ scm_read_character (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
/* Ignore dotted circles, which may be used to keep combining characters from /* Ignore dotted circles, which may be used to keep combining characters from
combining with the backslash in #\charname. */ combining with the backslash in #\charname. */
if (cp == SCM_CODEPOINT_DOTTED_CIRCLE && charname_len == 2) if (cp == SCM_CODEPOINT_DOTTED_CIRCLE && charname_len == 2)
return SCM_MAKE_CHAR (scm_i_string_ref (charname, 1)); return scm_c_make_char (scm_i_string_ref (charname, 1));
if (cp >= '0' && cp < '8') if (cp >= '0' && cp < '8')
{ {

View file

@ -1,6 +1,6 @@
/* srfi-13.c --- SRFI-13 procedures for Guile /* srfi-13.c --- SRFI-13 procedures for Guile
* *
* Copyright (C) 2001, 2004-2006, 2008-2013, 2017, 2018 * Copyright (C) 2001, 2004-2006, 2008-2013, 2017-2019
* Free Software Foundation, Inc. * Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
@ -53,7 +53,7 @@
} while (0) } while (0)
#define REF_IN_CHARSET(s, i, cs) \ #define REF_IN_CHARSET(s, i, cs) \
(scm_is_true (scm_char_set_contains_p ((cs), SCM_MAKE_CHAR (scm_i_string_ref (s, i))))) (scm_is_true (scm_char_set_contains_p ((cs), scm_c_make_char (scm_i_string_ref (s, i)))))
SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0, SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0,
(SCM str), (SCM str),
@ -133,7 +133,7 @@ SCM_DEFINE (scm_string_any, "string-any-c-code", 2, 2, 0,
while (cstart < cend) while (cstart < cend)
{ {
res = scm_call_1 (char_pred, res = scm_call_1 (char_pred,
SCM_MAKE_CHAR (scm_i_string_ref (s, cstart))); scm_c_make_char (scm_i_string_ref (s, cstart)));
if (scm_is_true (res)) if (scm_is_true (res))
break; break;
cstart++; cstart++;
@ -200,7 +200,7 @@ SCM_DEFINE (scm_string_every, "string-every-c-code", 2, 2, 0,
while (cstart < cend) while (cstart < cend)
{ {
res = scm_call_1 (char_pred, res = scm_call_1 (char_pred,
SCM_MAKE_CHAR (scm_i_string_ref (s, cstart))); scm_c_make_char (scm_i_string_ref (s, cstart)));
if (scm_is_false (res)) if (scm_is_false (res))
break; break;
cstart++; cstart++;
@ -758,7 +758,7 @@ SCM_DEFINE (scm_string_trim, "string-trim", 1, 3, 0,
{ {
SCM res; SCM res;
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart))); res = scm_call_1 (char_pred, scm_c_make_char (scm_i_string_ref (s, cstart)));
if (scm_is_false (res)) if (scm_is_false (res))
break; break;
cstart++; cstart++;
@ -834,7 +834,7 @@ SCM_DEFINE (scm_string_trim_right, "string-trim-right", 1, 3, 0,
{ {
SCM res; SCM res;
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend - 1))); res = scm_call_1 (char_pred, scm_c_make_char (scm_i_string_ref (s, cend - 1)));
if (scm_is_false (res)) if (scm_is_false (res))
break; break;
cend--; cend--;
@ -928,7 +928,7 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 3, 0,
{ {
SCM res; SCM res;
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart))); res = scm_call_1 (char_pred, scm_c_make_char (scm_i_string_ref (s, cstart)));
if (scm_is_false (res)) if (scm_is_false (res))
break; break;
cstart++; cstart++;
@ -937,7 +937,7 @@ SCM_DEFINE (scm_string_trim_both, "string-trim-both", 1, 3, 0,
{ {
SCM res; SCM res;
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend - 1))); res = scm_call_1 (char_pred, scm_c_make_char (scm_i_string_ref (s, cend - 1)));
if (scm_is_false (res)) if (scm_is_false (res))
break; break;
cend--; cend--;
@ -1698,7 +1698,7 @@ SCM_DEFINE (scm_string_index, "string-index", 2, 2, 0,
while (cstart < cend) while (cstart < cend)
{ {
SCM res; SCM res;
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart))); res = scm_call_1 (char_pred, scm_c_make_char (scm_i_string_ref (s, cstart)));
if (scm_is_true (res)) if (scm_is_true (res))
goto found; goto found;
cstart++; cstart++;
@ -1764,7 +1764,7 @@ SCM_DEFINE (scm_string_index_right, "string-index-right", 2, 2, 0,
{ {
SCM res; SCM res;
cend--; cend--;
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend))); res = scm_call_1 (char_pred, scm_c_make_char (scm_i_string_ref (s, cend)));
if (scm_is_true (res)) if (scm_is_true (res))
goto found; goto found;
} }
@ -1850,7 +1850,7 @@ SCM_DEFINE (scm_string_skip, "string-skip", 2, 2, 0,
while (cstart < cend) while (cstart < cend)
{ {
SCM res; SCM res;
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart))); res = scm_call_1 (char_pred, scm_c_make_char (scm_i_string_ref (s, cstart)));
if (scm_is_false (res)) if (scm_is_false (res))
goto found; goto found;
cstart++; cstart++;
@ -1917,7 +1917,7 @@ SCM_DEFINE (scm_string_skip_right, "string-skip-right", 2, 2, 0,
{ {
SCM res; SCM res;
cend--; cend--;
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cend))); res = scm_call_1 (char_pred, scm_c_make_char (scm_i_string_ref (s, cend)));
if (scm_is_false (res)) if (scm_is_false (res))
goto found; goto found;
} }
@ -1983,7 +1983,7 @@ SCM_DEFINE (scm_string_count, "string-count", 2, 2, 0,
while (cstart < cend) while (cstart < cend)
{ {
SCM res; SCM res;
res = scm_call_1 (char_pred, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart))); res = scm_call_1 (char_pred, scm_c_make_char (scm_i_string_ref (s, cstart)));
if (scm_is_true (res)) if (scm_is_true (res))
count++; count++;
cstart++; cstart++;
@ -2240,7 +2240,7 @@ string_titlecase_x (SCM str, size_t start, size_t end)
str = scm_i_string_start_writing (str); str = scm_i_string_start_writing (str);
for(i = start; i < end; i++) for(i = start; i < end; i++)
{ {
ch = SCM_MAKE_CHAR (scm_i_string_ref (str, i)); ch = scm_c_make_char (scm_i_string_ref (str, i));
if (scm_is_true (scm_char_alphabetic_p (ch))) if (scm_is_true (scm_char_alphabetic_p (ch)))
{ {
if (!in_word) if (!in_word)
@ -2338,7 +2338,7 @@ string_reverse_x (SCM str, size_t cstart, size_t cend)
cend--; cend--;
while (cstart < cend) while (cstart < cend)
{ {
tmp = SCM_MAKE_CHAR (scm_i_string_ref (str, cstart)); tmp = scm_c_make_char (scm_i_string_ref (str, cstart));
scm_i_string_set_x (str, cstart, scm_i_string_ref (str, cend)); scm_i_string_set_x (str, cstart, scm_i_string_ref (str, cend));
scm_i_string_set_x (str, cend, SCM_CHAR (tmp)); scm_i_string_set_x (str, cend, SCM_CHAR (tmp));
cstart++; cstart++;
@ -2575,7 +2575,7 @@ SCM_DEFINE (scm_string_fold, "string-fold", 3, 2, 0,
result = knil; result = knil;
while (cstart < cend) while (cstart < cend)
{ {
result = scm_call_2 (kons, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart)), result); result = scm_call_2 (kons, scm_c_make_char (scm_i_string_ref (s, cstart)), result);
cstart++; cstart++;
} }
@ -2603,7 +2603,7 @@ SCM_DEFINE (scm_string_fold_right, "string-fold-right", 3, 2, 0,
result = knil; result = knil;
while (cstart < cend) while (cstart < cend)
{ {
result = scm_call_2 (kons, SCM_MAKE_CHAR (scm_i_string_ref (s, cend-1)), result); result = scm_call_2 (kons, scm_c_make_char (scm_i_string_ref (s, cend-1)), result);
cend--; cend--;
} }
@ -2760,7 +2760,7 @@ SCM_DEFINE (scm_string_for_each, "string-for-each", 2, 2, 0,
4, end, cend); 4, end, cend);
while (cstart < cend) while (cstart < cend)
{ {
scm_call_1 (proc, SCM_MAKE_CHAR (scm_i_string_ref (s, cstart))); scm_call_1 (proc, scm_c_make_char (scm_i_string_ref (s, cstart)));
cstart++; cstart++;
} }
@ -3217,7 +3217,7 @@ SCM_DEFINE (scm_string_filter, "string-filter", 2, 2, 0,
while (idx < cend) while (idx < cend)
{ {
SCM res, ch; SCM res, ch;
ch = SCM_MAKE_CHAR (scm_i_string_ref (s, idx)); ch = scm_c_make_char (scm_i_string_ref (s, idx));
res = scm_call_1 (char_pred, ch); res = scm_call_1 (char_pred, ch);
if (scm_is_true (res)) if (scm_is_true (res))
ls = scm_cons (ch, ls); ls = scm_cons (ch, ls);
@ -3368,7 +3368,7 @@ SCM_DEFINE (scm_string_delete, "string-delete", 2, 2, 0,
idx = cstart; idx = cstart;
while (idx < cend) while (idx < cend)
{ {
SCM res, ch = SCM_MAKE_CHAR (scm_i_string_ref (s, idx)); SCM res, ch = scm_c_make_char (scm_i_string_ref (s, idx));
res = scm_call_1 (char_pred, ch); res = scm_call_1 (char_pred, ch);
if (scm_is_false (res)) if (scm_is_false (res))
ls = scm_cons (ch, ls); ls = scm_cons (ch, ls);

View file

@ -1209,9 +1209,9 @@ SCM_DEFINE (scm_string_ref, "string-ref", 2, 0, 0,
scm_out_of_range (NULL, k); scm_out_of_range (NULL, k);
if (scm_i_is_narrow_string (str)) if (scm_i_is_narrow_string (str))
return SCM_MAKE_CHAR (scm_i_string_chars (str)[idx]); return scm_c_make_char (scm_i_string_chars (str)[idx]);
else else
return SCM_MAKE_CHAR (scm_i_string_wide_chars (str)[idx]); return scm_c_make_char (scm_i_string_wide_chars (str)[idx]);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -1221,9 +1221,9 @@ scm_c_string_ref (SCM str, size_t p)
if (p >= scm_i_string_length (str)) if (p >= scm_i_string_length (str))
scm_out_of_range (NULL, scm_from_size_t (p)); scm_out_of_range (NULL, scm_from_size_t (p));
if (scm_i_is_narrow_string (str)) if (scm_i_is_narrow_string (str))
return SCM_MAKE_CHAR (scm_i_string_chars (str)[p]); return scm_c_make_char (scm_i_string_chars (str)[p]);
else else
return SCM_MAKE_CHAR (scm_i_string_wide_chars (str)[p]); return scm_c_make_char (scm_i_string_wide_chars (str)[p]);
} }

View file

@ -1,5 +1,5 @@
/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, /* Copyright (C) 2001, 2009-2015, 2018, 2019
* 2014, 2015, 2018 Free Software Foundation, Inc. * Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -2269,7 +2269,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
VM_VALIDATE_STRING (str, "string-ref"); VM_VALIDATE_STRING (str, "string-ref");
VM_VALIDATE_INDEX (c_idx, scm_i_string_length (str), "string-ref"); VM_VALIDATE_INDEX (c_idx, scm_i_string_length (str), "string-ref");
RETURN (SCM_MAKE_CHAR (scm_i_string_ref (str, c_idx))); RETURN (scm_c_make_char (scm_i_string_ref (str, c_idx)));
} }
/* string-set! instruction is currently number 192. Probably need to /* string-set! instruction is currently number 192. Probably need to