Adding support for Visual C's __declspec(noreturn) function declarations to perl
authorDaniel Dragan <bulk88@hotmail.com>
Mon, 16 Jul 2012 20:02:45 +0000 (16:02 -0400)
committerJan Dubois <jand@activestate.com>
Wed, 18 Jul 2012 22:30:30 +0000 (15:30 -0700)
This will reduce the machine code size on Visual C Perl, by removing C stack
clean up opcodes and possible jmp opcodes after croak() and similar
functions.  Perl's existing __attribute__noreturn__ macro (and therefore
GCC's __attribute__((noreturn)) ) is fundamentally incompatible with MS's
implementation for noreturn functions. win32.h already has _MSC_VER
aware code blocks, so adding more isn't a problem.

perl.h
proto.h
regen/embed.pl
win32/win32.h

diff --git a/perl.h b/perl.h
index fe65904..a7cd37a 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -5024,6 +5024,10 @@ struct tempsym; /* defined in pp_pack.c */
 #    define PERL_CALLCONV
 #  endif
 #endif
+#ifndef PERL_CALLCONV_NO_RET
+#    define PERL_CALLCONV_NO_RET PERL_CALLCONV
+#endif
+
 #undef PERL_CKDEF
 #undef PERL_PPDEF
 #define PERL_CKDEF(s)  PERL_CALLCONV OP *s (pTHX_ OP *o);
diff --git a/proto.h b/proto.h
index db957ac..4da7ab0 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -635,20 +635,20 @@ PERL_CALLCONV OP *        Perl_coresub_op(pTHX_ SV *coreargssv, const int code, const i
        assert(coreargssv)
 
 PERL_CALLCONV PERL_CONTEXT*    Perl_create_eval_scope(pTHX_ U32 flags);
-PERL_CALLCONV void     Perl_croak(pTHX_ const char* pat, ...)
+PERL_CALLCONV_NO_RET void      Perl_croak(pTHX_ const char* pat, ...)
                        __attribute__noreturn__
                        __attribute__format__null_ok__(__printf__,pTHX_1,pTHX_2);
 
-PERL_CALLCONV void     Perl_croak_no_modify(pTHX)
+PERL_CALLCONV_NO_RET void      Perl_croak_no_modify(pTHX)
                        __attribute__noreturn__;
 
-PERL_CALLCONV void     Perl_croak_sv(pTHX_ SV *baseex)
+PERL_CALLCONV_NO_RET void      Perl_croak_sv(pTHX_ SV *baseex)
                        __attribute__noreturn__
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_CROAK_SV      \
        assert(baseex)
 
-PERL_CALLCONV void     Perl_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
+PERL_CALLCONV_NO_RET void      Perl_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
                        __attribute__noreturn__
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
@@ -769,7 +769,7 @@ PERL_CALLCONV OP*   Perl_die_sv(pTHX_ SV *baseex)
 #define PERL_ARGS_ASSERT_DIE_SV        \
        assert(baseex)
 
-PERL_CALLCONV void     Perl_die_unwind(pTHX_ SV* msv)
+PERL_CALLCONV_NO_RET void      Perl_die_unwind(pTHX_ SV* msv)
                        __attribute__noreturn__
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_DIE_UNWIND    \
@@ -2224,7 +2224,7 @@ PERL_CALLCONV int Perl_magic_regdatum_get(pTHX_ SV* sv, MAGIC* mg)
 #define PERL_ARGS_ASSERT_MAGIC_REGDATUM_GET    \
        assert(sv); assert(mg)
 
-PERL_CALLCONV int      Perl_magic_regdatum_set(pTHX_ SV* sv, MAGIC* mg)
+PERL_CALLCONV_NO_RET int       Perl_magic_regdatum_set(pTHX_ SV* sv, MAGIC* mg)
                        __attribute__noreturn__
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
@@ -2527,10 +2527,10 @@ PERL_CALLCONV OP *      Perl_my_attrs(pTHX_ OP *o, OP *attrs)
 
 PERL_CALLCONV void     Perl_my_clearenv(pTHX);
 PERL_CALLCONV int      Perl_my_dirfd(pTHX_ DIR* dir);
-PERL_CALLCONV void     Perl_my_exit(pTHX_ U32 status)
+PERL_CALLCONV_NO_RET void      Perl_my_exit(pTHX_ U32 status)
                        __attribute__noreturn__;
 
-PERL_CALLCONV void     Perl_my_failure_exit(pTHX)
+PERL_CALLCONV_NO_RET void      Perl_my_failure_exit(pTHX)
                        __attribute__noreturn__;
 
 PERL_CALLCONV I32      Perl_my_fflush_all(pTHX);
@@ -4669,7 +4669,7 @@ PERL_CALLCONV int Perl_vcmp(pTHX_ SV *lhv, SV *rhv)
 #define PERL_ARGS_ASSERT_VCMP  \
        assert(lhv); assert(rhv)
 
-PERL_CALLCONV void     Perl_vcroak(pTHX_ const char* pat, va_list* args)
+PERL_CALLCONV_NO_RET void      Perl_vcroak(pTHX_ const char* pat, va_list* args)
                        __attribute__noreturn__;
 
 PERL_CALLCONV void     Perl_vdeb(pTHX_ const char* pat, va_list* args)
@@ -4876,7 +4876,7 @@ PERL_CALLCONV void*       Perl_my_cxt_init(pTHX_ int *index, size_t size)
 #endif
 #if !(defined(PERL_MAD))
 PERL_CALLCONV void     Perl_newFORM(pTHX_ I32 floor, OP* o, OP* block);
-PERL_CALLCONV void     Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
+PERL_CALLCONV_NO_RET void      Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                        __attribute__noreturn__;
 
 PERL_CALLCONV void     Perl_package(pTHX_ OP* o)
@@ -5361,7 +5361,7 @@ PERL_CALLCONV void*       Perl_my_cxt_init(pTHX_ const char *my_cxt_key, size_t size)
 #  endif
 #endif
 #if defined(PERL_IMPLICIT_CONTEXT)
-PERL_CALLCONV void     Perl_croak_nocontext(const char* pat, ...)
+PERL_CALLCONV_NO_RET void      Perl_croak_nocontext(const char* pat, ...)
                        __attribute__noreturn__
                        __attribute__format__null_ok__(__printf__,1,2);
 
@@ -7330,7 +7330,7 @@ PERL_CALLCONV MADPROP*    Perl_newMADsv(pTHX_ char key, SV* sv)
 #define PERL_ARGS_ASSERT_NEWMADSV      \
        assert(sv)
 
-PERL_CALLCONV OP *     Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
+PERL_CALLCONV_NO_RET OP *      Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                        __attribute__noreturn__;
 
 PERL_CALLCONV TOKEN*   Perl_newTOKEN(pTHX_ I32 optype, YYSTYPE lval, MADPROP* madprop);
index d339016..33967c9 100755 (executable)
@@ -92,8 +92,11 @@ my ($embed, $core, $ext, $api) = setup_embed();
            $func = "S_$plain_func";
        }
        else {
-           $retval = "PERL_CALLCONV $splint_flags$retval";
-           if ($flags =~ /[bp]/) {
+        if($never_returns){
+           $retval = "PERL_CALLCONV_NO_RET $splint_flags$retval";
+        }else{
+        $retval = "PERL_CALLCONV $splint_flags$retval";
+        }if ($flags =~ /[bp]/) {
                $func = "Perl_$plain_func";
            } else {
                $func = $plain_func;
index e906266..2c821eb 100644 (file)
 #if !defined(PERLDLL) && !defined(PERL_EXT_RE_BUILD)
 #  ifdef __cplusplus
 #    define PERL_CALLCONV extern "C" __declspec(dllimport)
+#    ifdef _MSC_VER
+#      define PERL_CALLCONV_NO_RET extern "C" __declspec(dllimport, noreturn)
+#    endif
 #  else
 #    define PERL_CALLCONV __declspec(dllimport)
+#    ifdef _MSC_VER
+#      define PERL_CALLCONV_NO_RET __declspec(dllimport, noreturn)
+#    endif
 #  endif
 #endif