Skip to content

perlapi: short-form printf-style avail, croak expands to nocontext #23684

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

Merged
merged 4 commits into from
Sep 12, 2025
Merged

perlapi: short-form printf-style avail, croak expands to nocontext #23684

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
306d4be
Remove v flag from embed.fnc
khwilliamson Aug 27, 2025
44adbff
Make autodoc aware of embed.h compatibility macros
khwilliamson Sep 4, 2025
cdb6437
autodoc: Variadic functions are callable with short form
khwilliamson Sep 4, 2025
10fddcf
Make croak() always expand to Perl_croak_nocontext()
khwilliamson Sep 4, 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
53 changes: 37 additions & 16 deletions autodoc.pl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -78,12 +78,30 @@
qr/[ aA bC dD eE fF h iI mM nN oO pP rR sS T uU vW xX y ;@#? ] /xx;

# Flags that don't apply to this program, like implementation details.
my $irrelevant_flags_re = qr/[ab eE iI P rR vX?]/xx;
my $irrelevant_flags_re = qr/[ ab eE iI P rR X? ]/xx;

# Only certain flags dealing with what gets displayed, are acceptable for
# apidoc_item
my $item_flags_re = qr/[dD fF mM nN oO pT uU Wx;]/xx;

# This is a copy of the list in regen/embed.pl.
my @have_compatibility_macros = qw(
deb
die
form
load_module
mess
newSVpvf
sv_catpvf
sv_catpvf_mg
sv_setpvf
sv_setpvf_mg
warn
warner
);
my %has_compat_macro;
$has_compat_macro{$_} = 1 for @have_compatibility_macros;

use constant {
NOT_APIDOC => -1,
ILLEGAL_APIDOC => 0, # Must be 0 so evaluates to 'false'
Expand Down Expand Up @@ -1648,6 +1666,7 @@ ($fh, $section_name, $element_name, $docref)
my @deprecated;
my @experimental;
my @xrefs;
my @compat_macros;

for (my $i = 0; $i < @items; $i++) {
last if $docref->{'xref_only'}; # Place holder
Expand All @@ -1664,6 +1683,7 @@ ($fh, $section_name, $element_name, $docref)

push @deprecated, "C<$name>" if $item->{flags} =~ /D/;
push @experimental, "C<$name>" if $item->{flags} =~ /x/;
push @compat_macros, $name if $has_compat_macro{$name};
}

# While we're going though the items, construct a nice list of where
Expand Down Expand Up @@ -1874,28 +1894,17 @@ ($fh, $section_name, $element_name, $docref)
}

# If only the Perl_foo form is to be displayed, change the
# name of this item to be that. This happens for either of
# two reasons:
# 1) The flags say we want "Perl_", but also to not create
# an entry in embed.h to #define a short name for it.
# name of this item to be that. This happens when the flags
# say we want "Perl_", but also to not create an entry in
# embed.h to #define a short name for it.
my $needs_Perl_entry = ( $flags =~ /p/
&& $flags =~ /o/
&& $flags !~ /M/);

# 2) The function takes a format string and a thread context
# parameter. We can't cope with that because our macros
# expect both the thread context and the format to be the
# first parameter to the function; and only one can be in
# that position.
my $cant_use_short_name = ( $flags =~ /f/
&& $flags !~ /T/
&& $name !~ /strftime/);

# We also create a 'Perl_foo' entry if $additional_long_form
# is set, as that explicitly indicates we want one
if ( $additional_long_form
|| $needs_Perl_entry
|| $cant_use_short_name)
|| $needs_Perl_entry)
{
# An all uppercase macro name gets an uppercase prefix.
my $perl = ($flags =~ /m/ && $name !~ /[[:lower:]]/)
Expand Down Expand Up @@ -2178,6 +2187,18 @@ ($fh, $section_name, $element_name, $docref)
}
}

for my $compat (@compat_macros) {
print $fh <<~"EOT";

Note: When called from XS code, $compat(...) expands to
C<Perl_${compat}_no_context(...)> unless C<PERL_WANT_VARARGS> has
been C<#defined>, in which case it expands to
C<Perl_$compat(aTHX_ ...)>. When called from the perl core,
it assumes C<aTHX> is available, so expands to
C<Perl_$compat(aTHX_ ...)>
EOT
}

if (grep { /\S/ } @usage) {
print $fh "\n=over $usage_indent\n\n";
print $fh join "", @usage;
Expand Down
58 changes: 26 additions & 32 deletions embed.fnc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -639,12 +639,6 @@
:
: 'U' autodoc.pl will not output a usage example
:
: 'v' Guard the macro by !MULTIPLICITY || PERL_CORE if it uses __VA_ARGS__.
: This flag exists for backward-compatibility to ensure that code does
: not break when calling older functions without an aTHX in scope. It
: should not be added to newly-added functions as they will have no such
: compatibility issues.
:
: 'W' Add a comma_pDEPTH argument to function prototypes, and a comma_aDEPTH
: argument to the function calls. This means that under DEBUGGING a
: depth argument is added to the functions, which is used for example by
Expand Down Expand Up @@ -928,7 +922,7 @@ px |void |create_eval_scope \
|NN SV **sp \
|U32 flags
: croak()'s first parm can be NULL. Otherwise, mod_perl breaks.
Adfprv |void |croak |NULLOK const char *pat \
AMdfpr |void |croak |NULLOK const char *pat \
|...
Tfpr |void |croak_caller |NULLOK const char *pat \
|...
Expand Down Expand Up @@ -1007,7 +1001,7 @@ p |void |cv_undef_flags |NN CV *cv \
Cp |void |cx_dump |NN PERL_CONTEXT *cx
: Used by CXINC, which appears to be in widespread use
CRp |I32 |cxinc
Adfpv |void |deb |NN const char *pat \
Adfp |void |deb |NN const char *pat \
|...
Cdp |I32 |debop |NN const OP *o
Cdp |void |debprofdump
Expand Down Expand Up @@ -1035,7 +1029,7 @@ ETXdp |char * |delimcpy_no_escape \
|const int delim \
|NN I32 *retlen
Cp |void |despatch_signals
Adfprv |OP * |die |NULLOK const char *pat \
Adfpr |OP * |die |NULLOK const char *pat \
|...
Adpr |OP * |die_sv |NN SV *baseex
: Used in util.c
Expand Down Expand Up @@ -1276,7 +1270,7 @@ Cp |void |force_out_malformed_utf8_message_ \
|NN const U8 * const e \
|U32 flags \
|const bool die_here
Adfpv |char * |form |NN const char *pat \
Adfp |char * |form |NN const char *pat \
|...
: Only used in perl.c
p |void |free_tied_hv_pool
Expand Down Expand Up @@ -1853,7 +1847,7 @@ ERXp |HV * |load_charnames |NN SV *char_name \
|const STRLEN context_len \
|NN const char **error_msg
MTbp |void |load_mathoms
AFdpv |void |load_module |U32 flags \
AFdp |void |load_module |U32 flags \
|NN SV *name \
|NULLOK SV *ver \
|...
Expand Down Expand Up @@ -2032,7 +2026,7 @@ Cp |Stack_off_t *|markstack_grow
EXp |int |mbtowc_ |NULLOK const wchar_t *pwc \
|NULLOK const char *s \
|const Size_t len
Adfpv |SV * |mess |NN const char *pat \
Adfp |SV * |mess |NN const char *pat \
|...
Adp |SV * |mess_sv |NN SV *basemsg \
|bool consume
Expand Down Expand Up @@ -2343,7 +2337,7 @@ ARdp |OP * |newSVOP |I32 type \
|NN SV *sv
ARdp |SV * |newSVpv |NULLOK const char * const s \
|const STRLEN len
ARdfpv |SV * |newSVpvf |NN const char * const pat \
ARdfp |SV * |newSVpvf |NN const char * const pat \
|...
ARdp |SV * |newSVpvn |NULLOK const char * const s \
|const STRLEN len
Expand Down Expand Up @@ -3156,13 +3150,13 @@ Adp |bool |sv_cat_decode |NN SV *dsv \
|int tlen
Adp |void |sv_catpv |NN SV * const dsv \
|NULLOK const char *sstr
Adfpv |void |sv_catpvf |NN SV * const sv \
Adfp |void |sv_catpvf |NN SV * const sv \
|NN const char * const pat \
|...
Adp |void |sv_catpv_flags |NN SV * const dsv \
|NN const char *sstr \
|const I32 flags
Adfpv |void |sv_catpvf_mg |NN SV * const sv \
Adfp |void |sv_catpvf_mg |NN SV * const sv \
|NN const char * const pat \
|...
Adp |void |sv_catpv_mg |NN SV * const dsv \
Expand Down Expand Up @@ -3465,10 +3459,10 @@ Adp |char *|sv_setpv_bufsize \
|NN SV * const sv \
|const STRLEN cur \
|const STRLEN len
Adfpv |void |sv_setpvf |NN SV * const sv \
Adfp |void |sv_setpvf |NN SV * const sv \
|NN const char * const pat \
|...
Adfpv |void |sv_setpvf_mg |NN SV * const sv \
Adfp |void |sv_setpvf_mg |NN SV * const sv \
|NN const char * const pat \
|...
Cipx |char *|sv_setpv_freshbuf \
Expand Down Expand Up @@ -3961,9 +3955,9 @@ Adp |void |vwarner |U32 err \
p |I32 |wait4pid |Pid_t pid \
|NN int *statusp \
|int flags
Adfpv |void |warn |NN const char *pat \
Adfp |void |warn |NN const char *pat \
|...
Adfpv |void |warner |U32 err \
Adfp |void |warner |U32 err \
|NN const char *pat \
|...
Adp |void |warn_sv |NN SV *baseex
Expand Down Expand Up @@ -4128,47 +4122,47 @@ pr |int |magic_regdatum_set \
|NN MAGIC *mg
#endif
#if defined(MULTIPLICITY)
ATdfprv |void |croak_nocontext|NULLOK const char *pat \
ATdfpr |void |croak_nocontext|NULLOK const char *pat \
|...
ATdfpv |void |deb_nocontext |NN const char *pat \
ATdfp |void |deb_nocontext |NN const char *pat \
|...
ATdfprv |OP * |die_nocontext |NULLOK const char *pat \
ATdfpr |OP * |die_nocontext |NULLOK const char *pat \
|...
ATdfpv |char * |form_nocontext |NN const char *pat \
ATdfp |char * |form_nocontext |NN const char *pat \
|...
AFTdpv |void |load_module_nocontext \
AFTdp |void |load_module_nocontext \
|U32 flags \
|NN SV *name \
|NULLOK SV *ver \
|...
ATdfpv |SV * |mess_nocontext |NN const char *pat \
ATdfp |SV * |mess_nocontext |NN const char *pat \
|...
Cdop |void * |my_cxt_init |NN int *indexp \
|size_t size
ATdfpv |SV * |newSVpvf_nocontext \
ATdfp |SV * |newSVpvf_nocontext \
|NN const char * const pat \
|...
ATdfpv |void |sv_catpvf_mg_nocontext \
ATdfp |void |sv_catpvf_mg_nocontext \
|NN SV * const sv \
|NN const char * const pat \
|...
ATdfpv |void |sv_catpvf_nocontext \
ATdfp |void |sv_catpvf_nocontext \
|NN SV * const sv \
|NN const char * const pat \
|...
ATdfpv |void |sv_setpvf_mg_nocontext \
ATdfp |void |sv_setpvf_mg_nocontext \
|NN SV * const sv \
|NN const char * const pat \
|...
ATdfpv |void |sv_setpvf_nocontext \
ATdfp |void |sv_setpvf_nocontext \
|NN SV * const sv \
|NN const char * const pat \
|...
ATdfpv |void |warner_nocontext \
ATdfp |void |warner_nocontext \
|U32 err \
|NN const char *pat \
|...
ATdfpv |void |warn_nocontext |NN const char *pat \
ATdfp |void |warn_nocontext |NN const char *pat \
|...
#endif /* defined(MULTIPLICITY) */
#if defined(MYMALLOC)
Expand Down
3 changes: 0 additions & 3 deletions embed.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,6 @@

#if !defined(MULTIPLICITY)
/* undefined symbols, point them back at the usual ones */
# define Perl_croak_nocontext Perl_croak
# define Perl_deb_nocontext Perl_deb
# define Perl_die_nocontext Perl_die
# define Perl_form_nocontext Perl_form
Expand Down Expand Up @@ -78,7 +77,6 @@

# if defined(MULTIPLICITY) && !defined(PERL_NO_SHORT_NAMES) && \
!defined(PERL_WANT_VARARGS)
# define croak Perl_croak_nocontext
# define deb Perl_deb_nocontext
# define die Perl_die_nocontext
# define form Perl_form_nocontext
Expand Down Expand Up @@ -914,7 +912,6 @@
# endif /* defined(MULTIPLICITY) */
# if !defined(MULTIPLICITY) || defined(PERL_CORE) || \
defined(PERL_WANT_VARARGS)
# define croak(...) Perl_croak(aTHX_ __VA_ARGS__)
# define deb(...) Perl_deb(aTHX_ __VA_ARGS__)
# define die(...) Perl_die(aTHX_ __VA_ARGS__)
# define form(...) Perl_form(aTHX_ __VA_ARGS__)
Expand Down
53 changes: 33 additions & 20 deletions regen/embed.pl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,35 @@ BEGIN
require './regen/embed_lib.pl';
}

# This program has historically generated compatibility macros for a few
# functions of the form Perl_FOO(pTHX_ ...). Those macros would be named
# FOO(...), and would expand outside the core to Perl_FOO_nocontext(...)
# instead of the expected value. This was done so XS code that didn't do a
# PERL_GET_CONTEXT would continue to work unchanged after threading was
# introduced. Any new API functions that came along would require an aTHX_
# parameter; this was just to avoid breaking existing source. Hence no new
# functions need be added to the list of such macros. This is the list.
# All have varargs.
#
# N.B. If you change this list, update the copy in autodoc.pl. This is likely
# to never happen, so not worth coding automatic synchronization.
my @have_compatibility_macros = qw(
deb
die
form
load_module
mess
newSVpvf
sv_catpvf
sv_catpvf_mg
sv_setpvf
sv_setpvf_mg
warn
warner
);
my %has_compat_macro;
$has_compat_macro{$_} = 1 for @have_compatibility_macros;

my $unflagged_pointers;
my @az = ('a'..'z');

Expand Down Expand Up @@ -123,7 +152,7 @@ sub generate_proto_h {

my ($flags, $retval, $plain_func, $args, $assertions ) =
@{$embed}{qw(flags return_type name args assertions)};
if ($flags =~ / ( [^ AabCDdEefFhIiMmNnOoPpRrSsTUuvWXx;] ) /xx) {
if ($flags =~ / ( [^ AabCDdEefFhIiMmNnOoPpRrSsTUuWXx;] ) /xx) {
die_at_end "flag $1 is not legal (for function $plain_func)";
}

Expand Down Expand Up @@ -637,7 +666,7 @@ sub embed_h {
}
}
$ret .= ")\n";
if($use_va_list and $flags =~ /v/) {
if($has_compat_macro{$func}) {
# Make older ones available only when !MULTIPLICITY or PERL_CORE or PERL_WANT_VARARGS
# These should not be done uncondtionally because existing
# code might call e.g. warn() without aTHX in scope.
Expand Down Expand Up @@ -718,22 +747,6 @@ sub generate_embed_h {
print $em add_indent($ret,"$func($alist)\n");
}

my @nocontext;
{
my (%has_va, %has_nocontext);
foreach (@$all) {
my $embed= $_->{embed}
or next;
++$has_va{$embed->{name}} if @{$embed->{args}} and $embed->{args}[-1] =~ /\.\.\./;
++$has_nocontext{$1} if $embed->{name} =~ /(.*)_nocontext/;
}

@nocontext = sort grep {
$has_nocontext{$_}
&& !/printf/ # Not clear to me why these are skipped but they are.
} keys %has_va;
}

print $em <<~'END';

/* Before C99, macros could not wrap varargs functions. This
Expand All @@ -743,7 +756,7 @@ sub generate_embed_h {
#if defined(MULTIPLICITY) && !defined(PERL_NO_SHORT_NAMES) && !defined(PERL_WANT_VARARGS)
END

foreach (@nocontext) {
foreach (@have_compatibility_macros) {
print $em indent_define($_, "Perl_${_}_nocontext", " ");
}

Expand All @@ -756,7 +769,7 @@ sub generate_embed_h {
/* undefined symbols, point them back at the usual ones */
END

foreach (@nocontext) {
foreach (@have_compatibility_macros) {
print $em indent_define("Perl_${_}_nocontext", "Perl_$_", " ");
}

Expand Down
Loading
Loading