regen/embed.pl: Extract out duplicate code into a fcn
authorKarl Williamson <public@khwilliamson.com>
Thu, 7 Feb 2013 17:45:14 +0000 (10:45 -0700)
committerKarl Williamson <public@khwilliamson.com>
Fri, 8 Feb 2013 21:44:23 +0000 (14:44 -0700)
regen/embed.pl

index 629bb84..521217d 100755 (executable)
@@ -40,6 +40,15 @@ my $unflagged_pointers;
 # implicit interpreter context argument.
 #
 
+sub full_name ($$) { # Returns the function name with potentially the
+                    # prefixes 'S_' or 'Perl_'
+    my ($func, $flags) = @_;
+
+    return "S_$func" if $flags =~ /[si]/;
+    return "Perl_$func" if $flags =~ /[bp]/;
+    return $func;
+}
+
 sub open_print_header {
     my ($file, $quote) = @_;
 
@@ -103,7 +112,6 @@ my ($embed, $core, $ext, $api) = setup_embed();
                $type = $1 eq 's' ? "STATIC" : "PERL_STATIC_INLINE";
            }
            $retval = "$type $splint_flags$retval";
-           $func = "S_$plain_func";
        }
        else {
            if ($never_returns) {
@@ -112,13 +120,8 @@ my ($embed, $core, $ext, $api) = setup_embed();
            else {
                $retval = "PERL_CALLCONV $splint_flags$retval";
            }
-           if ($flags =~ /[bp]/) {
-               $func = "Perl_$plain_func";
-           }
-           else {
-               $func = $plain_func;
-           }
        }
+       $func = full_name($plain_func, $flags);
        $ret = "$retval\t$func(";
        if ( $has_context ) {
            $ret .= @args ? "pTHX_ " : "pTHX";
@@ -282,19 +285,14 @@ sub embed_h {
        unless ($flags =~ /[om]/) {
            my $args = scalar @args;
            if ($flags =~ /n/) {
-               if ($flags =~ /[si]/) {
-                   $ret = hide($func,"S_$func");
-               }
-               elsif ($flags =~ /p/) {
-                   $ret = hide($func,"Perl_$func");
-               }
+               $ret = hide($func, full_name($func, $flags));
            }
            elsif ($args and $args[$args-1] =~ /\.\.\./) {
                if ($flags =~ /p/) {
                    # we're out of luck for varargs functions under CPP
                    # So we can only do these macros for no implicit context:
                    $ret = "#ifndef PERL_IMPLICIT_CONTEXT\n"
-                       . hide($func,"Perl_$func") . "#endif\n";
+                       . hide($func, full_name($func, $flags)) . "#endif\n";
                }
            }
            else {
@@ -302,12 +300,7 @@ sub embed_h {
                $ret = "#define $func($alist)";
                my $t = int(length($ret) / 8);
                $ret .=  "\t" x ($t < 4 ? 4 - $t : 1);
-               if ($flags =~ /[si]/) {
-                   $ret .= "S_$func(aTHX";
-               }
-               elsif ($flags =~ /p/) {
-                   $ret .= "Perl_$func(aTHX";
-               }
+               $ret .= full_name($func, $flags) . "(aTHX";
                $ret .= "_ " if $alist;
                $ret .= $alist . ")\n";
            }