Emit $_ to Perl_$_ for "nocontext" functions under multiplicity.

(Strictly for all functions with variable arguments, but *no* explicit
interpreter context arguments. Most of these are *_nocontext.)

We're already emitting macros for the non-multiplicity case, and as these
functions don't need an aTHX_ adding, there's no C portability reason why
we can't generate them here too. So do so, for consistency.

2 files changed, 20 insertions, 4 deletions

diff --git a/embed.h b/embed.h
index 8e1ca4e6b7..89ae16b94b 100644
--- a/embed.h
+++ b/embed.h
@@ -2581,6 +2581,21 @@
 #define croak_no_modify()	Perl_croak_no_modify(aTHX)
 #define croak_xs_usage(a,b)	Perl_croak_xs_usage(aTHX_ a,b)
 #if defined(PERL_IMPLICIT_CONTEXT)
+#define croak_nocontext		Perl_croak_nocontext
+#define die_nocontext		Perl_die_nocontext
+#define deb_nocontext		Perl_deb_nocontext
+#define form_nocontext		Perl_form_nocontext
+#define load_module_nocontext	Perl_load_module_nocontext
+#define mess_nocontext		Perl_mess_nocontext
+#define warn_nocontext		Perl_warn_nocontext
+#define warner_nocontext	Perl_warner_nocontext
+#define newSVpvf_nocontext	Perl_newSVpvf_nocontext
+#define sv_catpvf_nocontext	Perl_sv_catpvf_nocontext
+#define sv_setpvf_nocontext	Perl_sv_setpvf_nocontext
+#define sv_catpvf_mg_nocontext	Perl_sv_catpvf_mg_nocontext
+#define sv_setpvf_mg_nocontext	Perl_sv_setpvf_mg_nocontext
+#define fprintf_nocontext	Perl_fprintf_nocontext
+#define printf_nocontext	Perl_printf_nocontext
 #endif
 #ifdef PERL_CORE
 #define cv_ckproto_len(a,b,c,d)	Perl_cv_ckproto_len(aTHX_ a,b,c,d)
@@ -3172,6 +3187,7 @@
 #define reentrant_size()	Perl_reentrant_size(aTHX)
 #define reentrant_init()	Perl_reentrant_init(aTHX)
 #define reentrant_free()	Perl_reentrant_free(aTHX)
+#define reentrant_retry		Perl_reentrant_retry
 #endif
 #define call_atexit(a,b)	Perl_call_atexit(aTHX_ a,b)
 #define call_argv(a,b,c)	Perl_call_argv(aTHX_ a,b,c)
diff --git a/embed.pl b/embed.pl
index ccc6f3aa78..0f3b8071dd 100755
--- a/embed.pl
+++ b/embed.pl
@@ -517,10 +517,7 @@ walk_table {
 	my ($flags,$retval,$func,@args) = @_;
 	unless ($flags =~ /[om]/) {
 	    my $args = scalar @args;
-	    if ($args and $args[$args-1] =~ /\.\.\./) {
-	        # we're out of luck for varargs functions under CPP
-	    }
-	    elsif ($flags =~ /n/) {
+	    if ($flags =~ /n/) {
 		if ($flags =~ /s/) {
 		    $ret .= hide($func,"S_$func");
 		}
@@ -528,6 +525,9 @@ walk_table {
 		    $ret .= hide($func,"Perl_$func");
 		}
 	    }
+	    elsif ($args and $args[$args-1] =~ /\.\.\./) {
+	        # we're out of luck for varargs functions under CPP
+	    }
 	    else {
 		my $alist = join(",", @az[0..$args-1]);
 		$ret = "#define $func($alist)";