diff --git a/autodoc.pl b/autodoc.pl index 6589619aa55a..0853d2aa5349 100644 --- a/autodoc.pl +++ b/autodoc.pl @@ -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' @@ -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 @@ -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 @@ -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:]]/) @@ -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 unless C has + been C<#defined>, in which case it expands to + C. When called from the perl core, + it assumes C is available, so expands to + C + EOT + } + if (grep { /\S/ } @usage) { print $fh "\n=over $usage_indent\n\n"; print $fh join "", @usage; diff --git a/embed.fnc b/embed.fnc index 600ad924a6fb..32cf046308d7 100644 --- a/embed.fnc +++ b/embed.fnc @@ -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 @@ -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 \ |... @@ -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 @@ -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 @@ -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 @@ -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 \ |... @@ -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 @@ -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 @@ -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 \ @@ -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 \ @@ -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 @@ -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) diff --git a/embed.h b/embed.h index bef2e7b7fa04..72aef7aa81c3 100644 --- a/embed.h +++ b/embed.h @@ -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 @@ -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 @@ -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__) diff --git a/regen/embed.pl b/regen/embed.pl index 5a9ea2fa58c1..5fbce071148c 100755 --- a/regen/embed.pl +++ b/regen/embed.pl @@ -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'); @@ -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)"; } @@ -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. @@ -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 @@ -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", " "); } @@ -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_$_", " "); } diff --git a/util.c b/util.c index 6712433f35cf..982a318011a4 100644 --- a/util.c +++ b/util.c @@ -1912,10 +1912,9 @@ error message from arguments. If you want to throw a non-string object, or build an error message in an SV yourself, it is preferable to use the C> function, which does not involve clobbering C. -The two forms differ only in that C does not take a thread -context (C) parameter. It is usually preferred as it takes up fewer -bytes of code than plain C, and time is rarely a critical resource -when you are about to throw an exception. +The reasons for the existence of C are no longer applicable. +croak() can now be used in all circumstances. C might be +useful when compiling with C. =cut */ diff --git a/util.h b/util.h index 4be411fbe33b..c935d967e856 100644 --- a/util.h +++ b/util.h @@ -11,6 +11,15 @@ #ifndef PERL_UTIL_H_ #define PERL_UTIL_H_ +/* Calling Perl_croak_nocontext instead of plain Perl_croak is one less + * argument to pass under threads, so each instance takes up fewer bytes (but + * the nocontext function has to derive the thread context itself, taking more + * time). We trade time for less space here, because time is rarely a + * critical resource when you are about to throw an exception. */ +#define croak(...) Perl_croak_nocontext(__VA_ARGS__) +#ifndef MULTIPLICITY +# define Perl_croak_nocontext Perl_croak +#endif #ifdef VMS # define PERL_FILE_IS_ABSOLUTE(f) \