Skip to content

Allow automatic long name macro generation #23434

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 5 commits into
base: blead
Choose a base branch
from
Open

Allow automatic long name macro generation #23434

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
4d463e3
regen/embed.pl: Expand tabs to blanks
khwilliamson Jul 12, 2025
ef6d695
regen/embed.pl: Separate conditional into its own clause
khwilliamson Jul 12, 2025
9344ebb
Change #define Perl_foo Perl_bar" to plain "foo bar"
khwilliamson Jul 12, 2025
4189498
Allow automatic long name macro generation
khwilliamson Jul 12, 2025
f408e64
Convert uv_to_utf8_msgs() to a macro
khwilliamson Jul 12, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 2 additions & 3 deletions embed.fnc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -447,8 +447,7 @@
: created that #defines 'foo' as 'Perl_foo'. This can be used to make
: any macro have a long name, perhaps to avoid name collisions. If
: instead you define the macro as 'PERL_FOO' (all uppercase), the
: embed.h entry will use all uppercase. Without the T flag the behavior
: is subject to change when both 'm' and 'p are specified.
: embed.h entry will use all uppercase.
:
: suppress proto.h entry (actually, not suppressed, but commented out)
: suppress entry in the list of exported symbols available on all
Expand Down Expand Up @@ -3841,7 +3840,7 @@ Adip |U8 * |uv_to_utf8_flags \
|NN U8 *d \
|UV uv \
|UV flags
Adip |U8 * |uv_to_utf8_msgs|NN U8 *d \
Admp |U8 * |uv_to_utf8_msgs|NN U8 *d \
|UV uv \
|UV flags \
|NULLOK HV **msgs
Expand Down
30 changes: 16 additions & 14 deletions embed.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -160,7 +160,7 @@
# define bytes_to_utf8(a,b) Perl_bytes_to_utf8(aTHX_ a,b)
# define bytes_to_utf8_free_me(a,b,c) Perl_bytes_to_utf8_free_me(aTHX_ a,b,c)
# define bytes_to_utf8_temp_pv(a,b) Perl_bytes_to_utf8_temp_pv(aTHX_ a,b)
# define c9strict_utf8_to_uv Perl_c9strict_utf8_to_uv
# define Perl_c9strict_utf8_to_uv c9strict_utf8_to_uv
# define call_argv(a,b,c) Perl_call_argv(aTHX_ a,b,c)
# define call_atexit(a,b) Perl_call_atexit(aTHX_ a,b)
# define call_list(a,b) Perl_call_list(aTHX_ a,b)
Expand Down Expand Up @@ -225,7 +225,7 @@
# define dump_vindent(a,b,c,d) Perl_dump_vindent(aTHX_ a,b,c,d)
# define eval_pv(a,b) Perl_eval_pv(aTHX_ a,b)
# define eval_sv(a,b) Perl_eval_sv(aTHX_ a,b)
# define extended_utf8_to_uv Perl_extended_utf8_to_uv
# define Perl_extended_utf8_to_uv extended_utf8_to_uv
# define fbm_compile(a,b) Perl_fbm_compile(aTHX_ a,b)
# define fbm_instr(a,b,c,d) Perl_fbm_instr(aTHX_ a,b,c,d)
# define filter_add(a,b) Perl_filter_add(aTHX_ a,b)
Expand Down Expand Up @@ -312,7 +312,7 @@
# define init_i18nl10n(a) Perl_init_i18nl10n(aTHX_ a)
# define init_stacks() Perl_init_stacks(aTHX)
# define init_tm(a) Perl_init_tm(aTHX_ a)
# define instr Perl_instr
# define Perl_instr instr
# define intro_my() Perl_intro_my(aTHX)
# define isC9_STRICT_UTF8_CHAR Perl_isC9_STRICT_UTF8_CHAR
# define isSTRICT_UTF8_CHAR Perl_isSTRICT_UTF8_CHAR
Expand All @@ -328,7 +328,7 @@
# define is_utf8_fixed_width_buf_loclen_flags Perl_is_utf8_fixed_width_buf_loclen_flags
# define is_utf8_invariant_string_loc Perl_is_utf8_invariant_string_loc
# define is_utf8_string_flags Perl_is_utf8_string_flags
# define is_utf8_string_loc Perl_is_utf8_string_loc
# define Perl_is_utf8_string_loc is_utf8_string_loc
# define is_utf8_string_loclen Perl_is_utf8_string_loclen
# define is_utf8_string_loclen_flags Perl_is_utf8_string_loclen_flags
# define is_utf8_valid_partial_char_flags Perl_is_utf8_valid_partial_char_flags
Expand Down Expand Up @@ -651,7 +651,7 @@
# define stack_grow(a,b,c) Perl_stack_grow(aTHX_ a,b,c)
# define start_subparse(a,b) Perl_start_subparse(aTHX_ a,b)
# define str_to_version(a) Perl_str_to_version(aTHX_ a)
# define strict_utf8_to_uv Perl_strict_utf8_to_uv
# define Perl_strict_utf8_to_uv strict_utf8_to_uv
# define suspend_compcv(a) Perl_suspend_compcv(aTHX_ a)
# define sv_2bool_flags(a,b) Perl_sv_2bool_flags(aTHX_ a,b)
# define sv_2cv(a,b,c,d) Perl_sv_2cv(aTHX_ a,b,c,d)
Expand Down Expand Up @@ -802,30 +802,29 @@
# define upg_version(a,b) Perl_upg_version(aTHX_ a,b)
# define utf8_distance(a,b) Perl_utf8_distance(aTHX_ a,b)
# define utf8_hop Perl_utf8_hop
# define utf8_hop_back Perl_utf8_hop_back
# define Perl_utf8_hop_back utf8_hop_back
# define utf8_hop_back_overshoot Perl_utf8_hop_back_overshoot
# define utf8_hop_forward Perl_utf8_hop_forward
# define Perl_utf8_hop_forward utf8_hop_forward
# define utf8_hop_forward_overshoot Perl_utf8_hop_forward_overshoot
# define utf8_hop_overshoot Perl_utf8_hop_overshoot
# define utf8_hop_safe Perl_utf8_hop_safe
# define Perl_utf8_hop_safe utf8_hop_safe
# define utf8_length(a,b) Perl_utf8_length(aTHX_ a,b)
# define utf8_to_bytes(a,b) Perl_utf8_to_bytes(aTHX_ a,b)
# define utf8_to_bytes_(a,b,c,d) Perl_utf8_to_bytes_(aTHX_ a,b,c,d)
# define utf8_to_bytes_new_pv(a,b,c) Perl_utf8_to_bytes_new_pv(aTHX_ a,b,c)
# define utf8_to_bytes_overwrite(a,b) Perl_utf8_to_bytes_overwrite(aTHX_ a,b)
# define utf8_to_bytes_temp_pv(a,b) Perl_utf8_to_bytes_temp_pv(aTHX_ a,b)
# define utf8_to_uv Perl_utf8_to_uv
# define utf8_to_uv_errors Perl_utf8_to_uv_errors
# define utf8_to_uv_flags Perl_utf8_to_uv_flags
# define Perl_utf8_to_uv utf8_to_uv
# define Perl_utf8_to_uv_errors utf8_to_uv_errors
# define Perl_utf8_to_uv_flags utf8_to_uv_flags
# define utf8_to_uv_msgs Perl_utf8_to_uv_msgs
# define utf8_to_uv_msgs_helper_ Perl_utf8_to_uv_msgs_helper_
# define utf8_to_uv_or_die Perl_utf8_to_uv_or_die
# define utf8n_to_uvchr Perl_utf8n_to_uvchr
# define utf8n_to_uvchr_error Perl_utf8n_to_uvchr_error
# define Perl_utf8n_to_uvchr utf8n_to_uvchr
# define Perl_utf8n_to_uvchr_error utf8n_to_uvchr_error
# define utf8n_to_uvchr_msgs Perl_utf8n_to_uvchr_msgs
# define uv_to_utf8(a,b) Perl_uv_to_utf8(aTHX_ a,b)
# define uv_to_utf8_flags(a,b,c) Perl_uv_to_utf8_flags(aTHX_ a,b,c)
# define uv_to_utf8_msgs(a,b,c,d) Perl_uv_to_utf8_msgs(aTHX_ a,b,c,d)
# define uvoffuni_to_utf8_flags_msgs(a,b,c,d) Perl_uvoffuni_to_utf8_flags_msgs(aTHX_ a,b,c,d)
# define valid_identifier_pve(a,b,c) Perl_valid_identifier_pve(aTHX_ a,b,c)
# define valid_identifier_pvn(a,b,c) Perl_valid_identifier_pvn(aTHX_ a,b,c)
Expand Down Expand Up @@ -2259,8 +2258,11 @@
# define PerlIO_write(a,b,c) Perl_PerlIO_write(aTHX_ a,b,c)
# endif /* defined(USE_PERLIO) */
# if defined(USE_THREADS)
# define Perl_uv_to_utf8_msgs(mTHX,a,b,c,d) uv_to_utf8_msgs(a,b,c,d)
# define thread_locale_init() Perl_thread_locale_init(aTHX)
# define thread_locale_term() Perl_thread_locale_term(aTHX)
# else
# define Perl_uv_to_utf8_msgs uv_to_utf8_msgs
# endif
# if defined(VMS) || defined(WIN32)
# define do_aspawn(a,b,c) Perl_do_aspawn(aTHX_ a,b,c)
Expand Down
20 changes: 7 additions & 13 deletions inline.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2180,8 +2180,8 @@ Perl_is_utf8_string_flags(const U8 *s, STRLEN len, const U32 flags)
return TRUE;
}

#define Perl_is_utf8_string_loc(s, len, ep) \
Perl_is_utf8_string_loclen(s, len, ep, 0)
#define is_utf8_string_loc(s, len, ep) \
is_utf8_string_loclen(s, len, ep, 0)

PERL_STATIC_INLINE bool
Perl_is_utf8_string_loclen(const U8 *s, STRLEN len, const U8 **ep, STRLEN *el)
Expand Down Expand Up @@ -2759,8 +2759,8 @@ unchanged.

=cut
*/
# define Perl_utf8_hop_forward( s, off, end) \
Perl_utf8_hop_forward_overshoot(s, off, end, NULL)
# define utf8_hop_forward( s, off, end) \
utf8_hop_forward_overshoot(s, off, end, NULL)

PERL_STATIC_INLINE U8 *
Perl_utf8_hop_forward_overshoot(const U8 * s, SSize_t off,
Expand Down Expand Up @@ -2845,8 +2845,8 @@ displaced.
=cut
*/

# define Perl_utf8_hop_back( s, off, start) \
Perl_utf8_hop_back_overshoot(s, off, start, NULL)
# define utf8_hop_back( s, off, start) \
utf8_hop_back_overshoot(s, off, start, NULL)

PERL_STATIC_INLINE U8 *
Perl_utf8_hop_back_overshoot(const U8 *s, SSize_t off,
Expand Down Expand Up @@ -2912,7 +2912,7 @@ the excess count is the absolute value of C<remaining>.
=cut
*/

#define Perl_utf8_hop_safe(s, o, b, e) Perl_utf8_hop_overshoot(s, o, b, e, 0)
#define utf8_hop_safe(s, o, b, e) utf8_hop_overshoot(s, o, b, e, 0)

PERL_STATIC_INLINE U8 *
Perl_utf8_hop_overshoot(const U8 *s, SSize_t off,
Expand Down Expand Up @@ -3284,12 +3284,6 @@ Perl_uv_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
return uv_to_utf8_msgs(d, uv, flags, 0);
}

PERL_STATIC_INLINE U8 *
Perl_uv_to_utf8_msgs(pTHX_ U8 *d, UV uv, UV flags , HV **msgs)
{
return uvoffuni_to_utf8_flags_msgs(d, NATIVE_TO_UNI(uv), flags, msgs);
}

/* ------------------------------- perl.h ----------------------------- */

/*
Expand Down
8 changes: 3 additions & 5 deletions proto.h
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

71 changes: 55 additions & 16 deletions regen/embed.pl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -51,10 +51,10 @@ ($$)

if ($flags =~ /[ps]/) {

# An all uppercase macro name gets an uppercase prefix.
return ($flags =~ /m/ && $flags =~ /p/ && $func !~ /[[:lower:]]/)
? "PERL_$func"
: "Perl_$func";
# An all uppercase macro name gets an uppercase prefix.
return ($flags =~ /m/ && $flags =~ /p/ && $func !~ /[[:lower:]]/)
? "PERL_$func"
: "Perl_$func";
}
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is this a white space only chunk? or a code change?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The first commit in this p.r. separates out all the white space changes from code changes.


return "S_$func" if $flags =~ /[SIi]/;
Expand Down Expand Up @@ -144,14 +144,14 @@ sub generate_proto_h {

die_at_end "$plain_func: S and p flags are mutually exclusive"
if $flags =~ /S/ && $flags =~ /p/;
if ($has_mflag) {
if ($flags =~ /S/) {
die_at_end "$plain_func: m and S flags are mutually exclusive";
}
}
else {
die_at_end "$plain_func: u flag only usable with m" if $flags =~ /u/;
}
if ($has_mflag) {
if ($flags =~ /S/) {
die_at_end "$plain_func: m and S flags are mutually exclusive";
}
}
else {
die_at_end "$plain_func: u flag only usable with m" if $flags =~ /u/;
}

my ($static_flag, @extra_static_flags)= $flags =~/([SsIi])/g;

Expand Down Expand Up @@ -244,7 +244,7 @@ sub generate_proto_h {

$arg = "const char * const $name";
die_at_end 'm flag required for "literal" argument'
unless $has_mflag;
unless $has_mflag;
}
elsif ( $args_assert_line
&& $arg =~ /\*/
Expand Down Expand Up @@ -510,7 +510,46 @@ sub embed_h {
my $ind= $level ? " " : "";
$ind .= " " x ($level-1) if $level>1;
my $inner_ind= $ind ? " " : " ";
if ($flags !~ /[omM]/ or ($flags =~ /m/ && $flags =~ /p/)) {

if ($flags =~ /m/ && $flags =~ /p/) {
my $full_name = full_name($func, $flags);
next if $full_name eq $func; # Don't output a no-op.

# Yields
# #define Perl_func func
# which works when there is no thread context.
$ret = indent_define($full_name, $func, $ind);

if ($flags !~ /[T]/) {

# But when there is the possibility of a thread context
# parameter, $ret works only on non-threaded builds
my $no_thread_full_define = $ret;

# And we have to do more when there are threads. First,
# convert the input argument list to 'a', 'b' .... This keeps
# us from having to worry about all the extra stuff in the
# input list; stuff like the type declarations, things like
# NULLOK, and pointers '*'.
my $argname = 'a';
my @stripped_args;
push @stripped_args, $argname++ for $args->@*;
my $arglist = join ",", @stripped_args;

# In the threaded case, the Perl_ form is expecting an aTHX
# first argument. Use mTHX to match that, which isn't passed
# on to the short form name, as that is expecting an implicit
# aTHX. The non-threaded case just uses what we generated
# above for the /T/ flag case.
$ret = "#${ind}ifdef USE_THREADS\n"
. "#${ind} define $full_name(mTHX,$arglist)"
. " $func($arglist)\n"
. "#${ind}else\n"
. "$ind $no_thread_full_define" # No \n because no chomp
. "#${ind}endif\n";
}
}
elsif ($flags !~ /[omM]/) {
my $argc = scalar @$args;
if ($flags =~ /[T]/) {
my $full_name = full_name($func, $flags);
Expand All @@ -535,7 +574,7 @@ sub embed_h {
$use_va_list ? ("__VA_ARGS__") : ());
$ret = "#${ind}define $func($paramlist) ";
add_indent($ret,full_name($func, $flags) . "(aTHX");
if ($replacelist) {
if ($replacelist) {
$ret .= ($flags =~ /m/) ? "," : "_ ";
$ret .= $replacelist;
}
Expand Down Expand Up @@ -720,4 +759,4 @@ sub update_headers {

update_headers() unless caller;

# ex: set ts=8 sts=4 sw=4 noet:
# ex: set ts=8 sts=4 sw=4 et:
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Umm ... ??? Why was this sent thru astyle or clangformat?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't understand this comment. It was not sent through those things. The commit message for the commit that changes it explains why it was done

49 changes: 26 additions & 23 deletions utf8.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -145,34 +145,37 @@ typedef enum {
#define uvchr_to_utf8 uv_to_utf8
#define uvchr_to_utf8_flags uv_to_utf8_flags
#define uvchr_to_utf8_flags_msgs uv_to_utf8_msgs
#define Perl_uvchr_to_utf8 Perl_uv_to_utf8
#define Perl_uvchr_to_utf8_flags Perl_uv_to_utf8_flags
#define Perl_uvchr_to_utf8_flags_msgs Perl_uv_to_utf8_msgs
#define uvchr_to_utf8 uv_to_utf8
#define uvchr_to_utf8_flags uv_to_utf8_flags
#define uvchr_to_utf8_flags_msgs uv_to_utf8_msgs

#define uv_to_utf8_msgs(d, uv, flags, msgs) \
uvoffuni_to_utf8_flags_msgs(d, NATIVE_TO_UNI(uv), flags, msgs)

/* This is needed to cast the parameters for all those calls that had them
* improperly as chars */
#define utf8_to_uvchr_buf(s, e, lenp) \
#define utf8_to_uvchr_buf(s, e, lenp) \
Perl_utf8_to_uvchr_buf(aTHX_ (const U8 *) (s), (const U8 *) e, lenp)

#define Perl_utf8n_to_uvchr(s, len, lenp, flags) \
Perl_utf8n_to_uvchr_error(s, len, lenp, flags, 0)
#define Perl_utf8n_to_uvchr_error(s, len, lenp, flags, errors) \
Perl_utf8n_to_uvchr_msgs(s, len, lenp, flags, errors, 0)

#define Perl_utf8_to_uv( s, e, cp_p, advance_p) \
Perl_utf8_to_uv_flags( s, e, cp_p, advance_p, 0)
#define Perl_utf8_to_uv_flags( s, e, cp_p, advance_p, flags) \
Perl_utf8_to_uv_errors( s, e, cp_p, advance_p, flags, 0)
#define Perl_utf8_to_uv_errors( s, e, cp_p, advance_p, flags, errors) \
Perl_utf8_to_uv_msgs( s, e, cp_p, advance_p, flags, errors, 0)
#define Perl_extended_utf8_to_uv(s, e, cp_p, advance_p) \
Perl_utf8_to_uv(s, e, cp_p, advance_p)
#define Perl_strict_utf8_to_uv( s, e, cp_p, advance_p) \
Perl_utf8_to_uv_flags( s, e, cp_p, advance_p, \
UTF8_DISALLOW_ILLEGAL_INTERCHANGE)
#define Perl_c9strict_utf8_to_uv(s, e, cp_p, advance_p) \
Perl_utf8_to_uv_flags( s, e, cp_p, advance_p, \
UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE)
#define utf8n_to_uvchr(s, len, lenp, flags) \
utf8n_to_uvchr_error(s, len, lenp, flags, 0)
#define utf8n_to_uvchr_error(s, len, lenp, flags, errors) \
utf8n_to_uvchr_msgs(s, len, lenp, flags, errors, 0)

#define utf8_to_uv( s, e, cp_p, advance_p) \
utf8_to_uv_flags( s, e, cp_p, advance_p, 0)
#define utf8_to_uv_flags( s, e, cp_p, advance_p, flags) \
utf8_to_uv_errors( s, e, cp_p, advance_p, flags, 0)
#define utf8_to_uv_errors( s, e, cp_p, advance_p, flags, errors) \
utf8_to_uv_msgs( s, e, cp_p, advance_p, flags, errors, 0)
#define extended_utf8_to_uv(s, e, cp_p, advance_p) \
utf8_to_uv(s, e, cp_p, advance_p)
#define strict_utf8_to_uv( s, e, cp_p, advance_p) \
utf8_to_uv_flags( s, e, cp_p, advance_p, \
UTF8_DISALLOW_ILLEGAL_INTERCHANGE)
#define c9strict_utf8_to_uv(s, e, cp_p, advance_p) \
utf8_to_uv_flags( s, e, cp_p, advance_p, \
UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE)

#define utf16_to_utf8(p, d, bytelen, newlen) \
utf16_to_utf8_base(p, d, bytelen, newlen, 0, 1)
Expand Down
2 changes: 1 addition & 1 deletion util.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -241,7 +241,7 @@ returning NULL if not found. The terminating NUL bytes are not compared.
*/


#define Perl_instr(haystack, needle) strstr(haystack, needle)
#define instr(haystack, needle) strstr(haystack, needle)

#ifdef HAS_MEMMEM
# define ninstr(big, bigend, little, lend) \
Expand Down
Loading