This is a live mirror of the Perl 5 development currently hosted at
Programmatically generate the compatibility macros for "misnamed functions".
authorNicholas Clark <>
Wed, 22 Sep 2010 09:03:13 +0000 (10:03 +0100)
committerNicholas Clark <>
Wed, 22 Sep 2010 11:10:15 +0000 (12:10 +0100)
Add a new flag 'O' in embed.fnc to generate a macro mapping perl_$func() to
$func(). The macro for call_atexit() is far too special to do this way.


index 71e6e1c..ebe3d7c 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
 :             "#define foo Perl_foo",      rather than
 :             "#define foo(a,b,c) Perl_foo(aTHX_ a,b,c)
+:   O  Has a perl_ compatibility macro.
+:      The really OLD name for API funcs
 :   o  Has no Perl_foo compatibility macro:
 :         embed.h: suppress "#define foo Perl_foo"
@@ -907,29 +911,31 @@ Ap        |void   |reentrant_init
 Ap     |void   |reentrant_free
 Anp    |void*  |reentrant_retry|NN const char *f|...
+: "Very" special - can't use the O flag for this one:
+: (The rename from perl_atexit to Perl_call_atexit was in 864dbfa3ca8032ef)
 Ap     |void   |call_atexit    |ATEXIT_t fn|NULLOK void *ptr
-Apd    |I32    |call_argv      |NN const char* sub_name|I32 flags|NN char** argv
-Apd    |I32    |call_method    |NN const char* methname|I32 flags
-Apd    |I32    |call_pv        |NN const char* sub_name|I32 flags
-Apd    |I32    |call_sv        |NN SV* sv|VOL I32 flags
+ApdO   |I32    |call_argv      |NN const char* sub_name|I32 flags|NN char** argv
+ApdO   |I32    |call_method    |NN const char* methname|I32 flags
+ApdO   |I32    |call_pv        |NN const char* sub_name|I32 flags
+ApdO   |I32    |call_sv        |NN SV* sv|VOL I32 flags
 Ap     |void   |despatch_signals
 Ap     |OP *   |doref          |NN OP *o|I32 type|bool set_op_ref
-Apd    |SV*    |eval_pv        |NN const char* p|I32 croak_on_error
-Apd    |I32    |eval_sv        |NN SV* sv|I32 flags
-Apd    |SV*    |get_sv         |NN const char *name|I32 flags
-Apd    |AV*    |get_av         |NN const char *name|I32 flags
-Apd    |HV*    |get_hv         |NN const char *name|I32 flags
-Apd    |CV*    |get_cv         |NN const char* name|I32 flags
+ApdO   |SV*    |eval_pv        |NN const char* p|I32 croak_on_error
+ApdO   |I32    |eval_sv        |NN SV* sv|I32 flags
+ApdO   |SV*    |get_sv         |NN const char *name|I32 flags
+ApdO   |AV*    |get_av         |NN const char *name|I32 flags
+ApdO   |HV*    |get_hv         |NN const char *name|I32 flags
+ApdO   |CV*    |get_cv         |NN const char* name|I32 flags
 Apd    |CV*    |get_cvn_flags  |NN const char* name|STRLEN len|I32 flags
-Ap     |int    |init_i18nl10n  |int printwarn
-Ap     |int    |init_i18nl14n  |int printwarn
-Ap     |void   |new_collate    |NULLOK const char* newcoll
-Ap     |void   |new_ctype      |NN const char* newctype
-Ap     |void   |new_numeric    |NULLOK const char* newcoll
+ApO    |int    |init_i18nl10n  |int printwarn
+ApO    |int    |init_i18nl14n  |int printwarn
+ApO    |void   |new_collate    |NULLOK const char* newcoll
+ApO    |void   |new_ctype      |NN const char* newctype
+ApO    |void   |new_numeric    |NULLOK const char* newcoll
 Ap     |void   |set_numeric_local
 Ap     |void   |set_numeric_radix
 Ap     |void   |set_numeric_standard
-Apd    |void   |require_pv     |NN const char* pv
+ApdO   |void   |require_pv     |NN const char* pv
 Apd    |void   |pack_cat       |NN SV *cat|NN const char *pat|NN const char *patend \
                                |NN SV **beglist|NN SV **endlist|NN SV ***next_in_list|U32 flags
 Apd    |void   |packlist       |NN SV *cat|NN const char *pat|NN const char *patend|NN SV **beglist|NN SV **endlist
diff --git a/embed.h b/embed.h
index 345c949..8e1ca4e 100644 (file)
--- a/embed.h
+++ b/embed.h
 #  define perl_atexit(a,b)             call_atexit(a,b)
 #  define perl_call_argv(a,b,c)                call_argv(a,b,c)
-#  define perl_call_pv(a,b)            call_pv(a,b)
 #  define perl_call_method(a,b)                call_method(a,b)
+#  define perl_call_pv(a,b)            call_pv(a,b)
 #  define perl_call_sv(a,b)            call_sv(a,b)
-#  define perl_eval_sv(a,b)            eval_sv(a,b)
 #  define perl_eval_pv(a,b)            eval_pv(a,b)
-#  define perl_require_pv(a)           require_pv(a)
+#  define perl_eval_sv(a,b)            eval_sv(a,b)
 #  define perl_get_sv(a,b)             get_sv(a,b)
 #  define perl_get_av(a,b)             get_av(a,b)
 #  define perl_get_hv(a,b)             get_hv(a,b)
 #  define perl_get_cv(a,b)             get_cv(a,b)
 #  define perl_init_i18nl10n(a)                init_i18nl10n(a)
 #  define perl_init_i18nl14n(a)                init_i18nl14n(a)
-#  define perl_new_ctype(a)            new_ctype(a)
 #  define perl_new_collate(a)          new_collate(a)
+#  define perl_new_ctype(a)            new_ctype(a)
 #  define perl_new_numeric(a)          new_numeric(a)
+#  define perl_require_pv(a)           require_pv(a)
 /* varargs functions can't be handled with CPP macros. :-(
    This provides a set of compatibility functions that don't take
index 6df7cb3..1a005c2 100755 (executable)
--- a/
+++ b/
@@ -617,22 +617,21 @@ print $em <<'END';
    prefix in previous versions, we provide compatibility macros.
 #  define perl_atexit(a,b)             call_atexit(a,b)
-#  define perl_call_argv(a,b,c)                call_argv(a,b,c)
-#  define perl_call_pv(a,b)            call_pv(a,b)
-#  define perl_call_method(a,b)                call_method(a,b)
-#  define perl_call_sv(a,b)            call_sv(a,b)
-#  define perl_eval_sv(a,b)            eval_sv(a,b)
-#  define perl_eval_pv(a,b)            eval_pv(a,b)
-#  define perl_require_pv(a)           require_pv(a)
-#  define perl_get_sv(a,b)             get_sv(a,b)
-#  define perl_get_av(a,b)             get_av(a,b)
-#  define perl_get_hv(a,b)             get_hv(a,b)
-#  define perl_get_cv(a,b)             get_cv(a,b)
-#  define perl_init_i18nl10n(a)                init_i18nl10n(a)
-#  define perl_init_i18nl14n(a)                init_i18nl14n(a)
-#  define perl_new_ctype(a)            new_ctype(a)
-#  define perl_new_collate(a)          new_collate(a)
-#  define perl_new_numeric(a)          new_numeric(a)
+walk_table {
+    my ($flags,$retval,$func,@args) = @_;
+    return unless $func;
+    return unless $flags =~ /O/;
+    my $alist = join ",", @az[0..$#args];
+    my $ret = "#  define perl_$func($alist)";
+    my $t = (length $ret) >> 3;
+    $ret .=  "\t" x ($t < 5 ? 5 - $t : 1);
+    "$ret$func($alist)\n";
+} $em, "";
+print $em <<'END';
 /* varargs functions can't be handled with CPP macros. :-(
    This provides a set of compatibility functions that don't take