This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
"func not implemented" croaks optimizations in /win32/*
authorDaniel Dragan <bulk88@hotmail.com>
Sun, 28 Oct 2012 02:25:47 +0000 (22:25 -0400)
committerJan Dubois <jand@activestate.com>
Fri, 9 Nov 2012 00:54:55 +0000 (16:54 -0800)
This commit removes a number of "* not implemented" strings from the image.
A win32_croak_not_implemented wrapper is created to reduce machine code
by not putting the format string on the C stack many times. embed.fnc was
used to declare win32_croak_not_implemented for proper cross compiler
support of noreturn (noreturn on GCC and VC ok). Tailcalling and noreturn
optimizations of the C compiler are heavily used in this commit.

embed.fnc
proto.h
win32/perlhost.h
win32/win32.c
win32/win32sck.c

index 3068905..806711a 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -249,7 +249,9 @@ Aprd        |void   |vcroak         |NULLOK const char* pat|NULLOK va_list* args
 Aprd   |void   |croak_no_modify
 Aprd   |void   |croak_xs_usage |NN const CV *const cv \
                                |NN const char *const params
-
+#if defined(WIN32)
+norx   |void   |win32_croak_not_implemented|NN const char * fname
+#endif
 #if defined(PERL_IMPLICIT_CONTEXT)
 Afnrp  |void   |croak_nocontext|NULLOK const char* pat|...
 Afnp   |OP*    |die_nocontext  |NULLOK const char* pat|...
diff --git a/proto.h b/proto.h
index 4bfa724..e42d6bc 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -7728,6 +7728,14 @@ PERL_CALLCONV SSize_t    Perl_PerlIO_write(pTHX_ PerlIO *f, const void *vbuf, Size_
        assert(vbuf)
 
 #endif
+#if defined(WIN32)
+PERL_CALLCONV_NO_RET void      win32_croak_not_implemented(const char * fname)
+                       __attribute__noreturn__
+                       __attribute__nonnull__(1);
+#define PERL_ARGS_ASSERT_WIN32_CROAK_NOT_IMPLEMENTED   \
+       assert(fname)
+
+#endif
 #if defined(WIN32) || defined(__SYMBIAN32__) || defined(VMS)
 PERL_CALLCONV int      Perl_do_aspawn(pTHX_ SV* really, SV** mark, SV** sp)
                        __attribute__nonnull__(pTHX_2)
index 3f18126..7b3f037 100644 (file)
@@ -1278,8 +1278,7 @@ PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name)
 struct hostent*
 PerlSockGethostent(struct IPerlSock* piPerl)
 {
-    dTHX;
-    Perl_croak(aTHX_ "gethostent not implemented!\n");
+    win32_croak_not_implemented("gethostent");
     return NULL;
 }
 
@@ -1861,7 +1860,7 @@ PerlProcFork(struct IPerlProc* piPerl)
 #  endif
     return -(int)id;
 #else
-    Perl_croak(aTHX_ "fork() not implemented!\n");
+    win32_croak_not_implemented("fork()");
     return -1;
 #endif /* USE_ITHREADS */
 }
index 5a932ca..1686594 100644 (file)
@@ -1676,6 +1676,14 @@ out_of_memory(void)
     exit(1);
 }
 
+void
+win32_croak_not_implemented(const char * fname)
+{
+    PERL_ARGS_ASSERT_WIN32_CROAK_NOT_IMPLEMENTED;
+
+    Perl_croak_nocontext("%s not implemented!\n", fname);
+}
+
 /* Converts a wide character (UTF-16) string to the Windows ANSI code page,
  * potentially using the system's default replacement character for any
  * unrepresentable characters. The caller must free() the returned string. */
@@ -2901,8 +2909,7 @@ win32_pipe(int *pfd, unsigned int size, int mode)
 DllExport PerlIO*
 win32_popenlist(const char *mode, IV narg, SV **args)
 {
- dTHX;
- Perl_croak(aTHX_ "List form of pipe open not implemented");
+ Perl_croak_nocontext("List form of pipe open not implemented");
  return NULL;
 }
 
index 9032a6d..4285b29 100644 (file)
@@ -596,101 +596,88 @@ win32_inet_addr(const char FAR *cp)
 void
 win32_endhostent() 
 {
-    dTHX;
-    Perl_croak_nocontext("endhostent not implemented!\n");
+    win32_croak_not_implemented("endhostent");
 }
 
 void
 win32_endnetent()
 {
-    dTHX;
-    Perl_croak_nocontext("endnetent not implemented!\n");
+    win32_croak_not_implemented("endnetent");
 }
 
 void
 win32_endprotoent()
 {
-    dTHX;
-    Perl_croak_nocontext("endprotoent not implemented!\n");
+    win32_croak_not_implemented("endprotoent");
 }
 
 void
 win32_endservent()
 {
-    dTHX;
-    Perl_croak_nocontext("endservent not implemented!\n");
+    win32_croak_not_implemented("endservent");
 }
 
 
 struct netent *
 win32_getnetent(void) 
 {
-    dTHX;
-    Perl_croak_nocontext("getnetent not implemented!\n");
+    win32_croak_not_implemented("getnetent");
     return (struct netent *) NULL;
 }
 
 struct netent *
 win32_getnetbyname(char *name) 
 {
-    dTHX;
-    Perl_croak_nocontext("getnetbyname not implemented!\n");
+    win32_croak_not_implemented("getnetbyname");
     return (struct netent *)NULL;
 }
 
 struct netent *
 win32_getnetbyaddr(long net, int type) 
 {
-    dTHX;
-    Perl_croak_nocontext("getnetbyaddr not implemented!\n");
+    win32_croak_not_implemented("getnetbyaddr");
     return (struct netent *)NULL;
 }
 
 struct protoent *
 win32_getprotoent(void) 
 {
-    dTHX;
-    Perl_croak_nocontext("getprotoent not implemented!\n");
+    win32_croak_not_implemented("getprotoent");
     return (struct protoent *) NULL;
 }
 
 struct servent *
 win32_getservent(void) 
 {
-    dTHX;
-    Perl_croak_nocontext("getservent not implemented!\n");
+    win32_croak_not_implemented("getservent");
     return (struct servent *) NULL;
 }
 
 void
 win32_sethostent(int stayopen)
 {
-    dTHX;
-    Perl_croak_nocontext("sethostent not implemented!\n");
+    win32_croak_not_implemented("sethostent");
 }
 
 
 void
 win32_setnetent(int stayopen)
 {
-    dTHX;
-    Perl_croak_nocontext("setnetent not implemented!\n");
+    win32_croak_not_implemented("setnetent");
 }
 
 
 void
 win32_setprotoent(int stayopen)
 {
-    dTHX;
-    Perl_croak_nocontext("setprotoent not implemented!\n");
+    win32_croak_not_implemented("setprotoent");
 }
 
 
 void
 win32_setservent(int stayopen)
 {
-    dTHX;
-    Perl_croak_nocontext("setservent not implemented!\n");
+    win32_croak_not_implemented("setservent");
 }
 
 static struct servent*