new function specifier: PERL_STATIC_FORCE_INLINE

It's the same thing as PERL_STATIC_INLINE but it also adds
__attribute__(always_inline) or __forceinline if the compiler
supports that.

diff --git a/embed.fnc b/embed.fnc
index f1b0458..1a46fa1 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -285,6 +285,13 @@
 :      pod, such as perlguts or warnings.h.  This flag is useful for downstream
 :      programs, such as Devel::PPPort.
 :
+:   I  This flag works exactly the same as 'i' but it also adds
+:      __attribute__((always_inline)) or __forceinline if either of them is
+:      supported by the compiler.
+:
+:         proto.h: function is declared as PERL_STATIC_FORCE_INLINE and
+:                  __attribute__always_inline__ is added
+:
 :   i  inline static.  This is used for functions that the compiler is being
 :      requested to inline.  If the function is in a header file its
 :      definition will be visible (unless guarded by #if..#endif) to all

diff --git a/perl.h b/perl.h
index 85c8741..b8f6972 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -340,6 +340,9 @@
 #  if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */
 #    define HASATTRIBUTE_WARN_UNUSED_RESULT
 #  endif
+#  if __GNUC__ == 3 && __GNUC_MINOR__ >= 1 || __GNUC__ > 3 /* 3.1 -> */
+#    define HASATTRIBUTE_ALWAYS_INLINE
+#  endif
 #endif
 #endif /* #ifndef PERL_MICRO */
 
@@ -367,6 +370,9 @@
 #ifdef HASATTRIBUTE_WARN_UNUSED_RESULT
 #  define __attribute__warn_unused_result__ __attribute__((warn_unused_result))
 #endif
+#ifdef HASATTRIBUTE_ALWAYS_INLINE
+#  define __attribute__always_inline__      __attribute__((always_inline))
+#endif
 
 /* If we haven't defined the attributes yet, define them to blank. */
 #ifndef __attribute__deprecated__
@@ -393,6 +399,9 @@
 #ifndef __attribute__warn_unused_result__
 #  define __attribute__warn_unused_result__
 #endif
+#ifndef __attribute__always_inline__
+#  define __attribute__always_inline__
+#endif
 
 /* Some OS warn on NULL format to printf */
 #ifdef PRINTF_FORMAT_NULL_OK
@@ -3816,6 +3825,14 @@ typedef        struct crypt_data {     /* straight from /usr/include/crypt.h */
 #  define PERL_STATIC_INLINE_NO_RET PERL_STATIC_INLINE
 #endif
 
+#ifndef PERL_STATIC_FORCE_INLINE
+#  define PERL_STATIC_FORCE_INLINE PERL_STATIC_INLINE
+#endif
+
+#ifndef PERL_STATIC_FORCE_INLINE_NO_RET
+#  define PERL_STATIC_FORCE_INLINE_NO_RET PERL_STATIC_INLINE
+#endif
+
 #if !defined(OS2)
 #  include "iperlsys.h"
 #endif

diff --git a/regen/embed.pl b/regen/embed.pl
index e9e2707..5c33127 100755 (executable)
--- a/regen/embed.pl
+++ b/regen/embed.pl
@@ -1,5 +1,5 @@
 #!/usr/bin/perl -w
-# 
+#
 # Regenerate (overwriting only if changed):
 #
 #    embed.h
@@ -51,7 +51,7 @@ sub full_name ($$) { # Returns the function name with potentially the
     my ($func, $flags) = @_;
 
     return "Perl_$func" if $flags =~ /p/;
-    return "S_$func" if $flags =~ /[Si]/;
+    return "S_$func" if $flags =~ /[SIi]/;
     return $func;
 }
 
@@ -81,7 +81,7 @@ my ($embed, $core, $ext, $api) = setup_embed();
        }
 
        my ($flags,$retval,$plain_func,@args) = @$_;
-        if ($flags =~ / ( [^AabCDdEefFGhiMmNnOoPpRrSsTUuWXx] ) /x) {
+        if ($flags =~ / ( [^AabCDdEefFGhIiMmNnOoPpRrSsTUuWXx] ) /x) {
            die_at_end "flag $1 is not legal (for function $plain_func)";
        }
        my @nonnull;
@@ -109,17 +109,25 @@ my ($embed, $core, $ext, $api) = setup_embed();
                                                            && $flags !~ /m/;
 
        my $static_inline = 0;
-       if ($flags =~ /([Si])/) {
+       if ($flags =~ /([SIi])/) {
            my $type;
            if ($never_returns) {
-               $type = $1 eq 'S' ? "PERL_STATIC_NO_RET" : "PERL_STATIC_INLINE_NO_RET";
+               $type = {
+                   'S' => 'PERL_STATIC_NO_RET',
+                   'i' => 'PERL_STATIC_INLINE_NO_RET',
+                   'I' => 'PERL_STATIC_FORCE_INLINE_NO_RET'
+               }->{$1};
            }
            else {
-               $type = $1 eq 'S' ? "STATIC" : "PERL_STATIC_INLINE";
+               $type = {
+                   'S' => 'STATIC',
+                   'i' => 'PERL_STATIC_INLINE',
+                   'I' => 'PERL_STATIC_FORCE_INLINE'
+               }->{$1};
            }
            $retval = "$type $retval";
            die_at_end "Don't declare static function '$plain_func' pure" if $flags =~ /P/;
-           $static_inline = $type =~ /^PERL_STATIC_INLINE/;
+           $static_inline = $type =~ /^PERL_STATIC(?:_FORCE)?_INLINE/;
        }
        else {
            if ($never_returns) {
@@ -132,18 +140,20 @@ my ($embed, $core, $ext, $api) = setup_embed();
 
        die_at_end "For '$plain_func', M flag requires p flag"
                                            if $flags =~ /M/ && $flags !~ /p/;
-       die_at_end "For '$plain_func', C flag requires one of [pimb] flags"
-                                           if $flags =~ /C/ && $flags !~ /[ibmp]/;
-       die_at_end "For '$plain_func', X flag requires p or i flag"
-                                           if $flags =~ /X/ && $flags !~ /[ip]/;
+       die_at_end "For '$plain_func', C flag requires one of [pIimb] flags"
+                                           if $flags =~ /C/ && $flags !~ /[Iibmp]/;
+       die_at_end "For '$plain_func', X flag requires one of [Iip] flags"
+                                           if $flags =~ /X/ && $flags !~ /[Iip]/;
        die_at_end "For '$plain_func', X and m flags are mutually exclusive"
                                            if $flags =~ /X/ && $flags =~ /m/;
-       die_at_end "For '$plain_func', i with [ACX] requires p flag"
-                       if $flags =~ /i/ && $flags =~ /[ACX]/ && $flags !~ /p/;
+       die_at_end "For '$plain_func', [Ii] with [ACX] requires p flag"
+                       if $flags =~ /[Ii]/ && $flags =~ /[ACX]/ && $flags !~ /p/;
        die_at_end "For '$plain_func', b and m flags are mutually exclusive"
                 . " (try M flag)" if $flags =~ /b/ && $flags =~ /m/;
        die_at_end "For '$plain_func', b flag without M flag requires D flag"
                            if $flags =~ /b/ && $flags !~ /M/ && $flags !~ /D/;
+       die_at_end "For '$plain_func', I and i flags are mutually exclusive"
+                                           if $flags =~ /I/ && $flags =~ /i/;
 
        $func = full_name($plain_func, $flags);
        $ret = "";
@@ -202,6 +212,9 @@ my ($embed, $core, $ext, $api) = setup_embed();
        if ( $flags =~ /P/ ) {
            push @attrs, "__attribute__pure__";
        }
+       if ( $flags =~ /I/ ) {
+           push @attrs, "__attribute__always_inline__";
+       }
        if( $flags =~ /f/ ) {
            my $prefix  = $has_context ? 'pTHX_' : '';
            my ($args, $pat);

diff --git a/win32/win32.h b/win32/win32.h
index 1133c60..c0ee5a6 100644 (file)
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -139,6 +139,8 @@
 #ifdef _MSC_VER
 #  define PERL_STATIC_NO_RET __declspec(noreturn) static
 #  define PERL_STATIC_INLINE_NO_RET __declspec(noreturn) PERL_STATIC_INLINE
+#  define PERL_STATIC_FORCE_INLINE __forceinline static
+#  define PERL_STATIC_FORCE_INLINE_NO_RET __declspec(noreturn) __forceinline static
 #endif
 
 #define  WIN32_LEAN_AND_MEAN