In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/dbf7dff66e440223aca0cc8...>
- Log -----------------------------------------------------------------
commit dbf7dff66e440223aca0cc87655e65e096264d59
Author: Daniel Dragan <bul...@hotmail.com>
Date: Mon Nov 5 02:19:29 2012 -0500
remove various redundant dTHXes
Remove either unused dTHXes, or remove dTHXes where a nocontext func can
be used instead. Smaller/faster machine code is the result.
M perlio.c
M reentr.c
M regen/reentr.pl
M time64.c
M util.c
M win32/perlhost.h
M win32/win32.c
commit 94f1727772e0683d79e2101f4dc93ac2ef282c4c
Author: Daniel Dragan <bul...@hotmail.com>
Date: Sat Nov 3 14:53:55 2012 -0400
remove unused dTHXes in /win32/*
Remove dTHXes in win32 perl funcs where they were not used, or could be
replaced with nocontext croaks/warns. Since Perl_get_context is a function
it is not optimized away by the compiler.
M win32/perlhost.h
M win32/vmem.h
M win32/win32.c
M win32/win32sck.c
commit 9399a70c62d6e4622406f3db44ff4235a362d1a0
Author: Daniel Dragan <bul...@hotmail.com>
Date: Wed Oct 31 02:13:42 2012 -0400
create aTHXa, some unused dTHXs removed in /win32/*
dTHXes that were unused, or because Newx/Safefree were the only things
called were removed. In some places the dTHX turned into dTHXa and aTHXa
so the context is not fetched until it is actually used
(locality/frees a C stack slot or frees a non-volatile register). Also see
http://www.nntp.perl.org/group/perl.perl5.porters/2012/10/msg194414.html
and http://www.nntp.perl.org/group/perl.perl5.porters/2012/10/msg194861.html
M perl.h
M win32/perlhost.h
M win32/win32.c
M win32/win32sck.c
commit 073dd0357a846739ff3ae9a14379de2302d5e877
Author: Daniel Dragan <bul...@hotmail.com>
Date: Sat Oct 27 22:25:47 2012 -0400
"func not implemented" croaks optimizations in /win32/*
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.
M embed.fnc
M proto.h
M win32/perlhost.h
M win32/win32.c
M win32/win32sck.c
-----------------------------------------------------------------------
Summary of changes:
embed.fnc | 4 +++-
perl.h | 2 ++
perlio.c | 6 ++++--
proto.h | 8 ++++++++
reentr.c | 2 +-
regen/reentr.pl | 2 +-
time64.c | 2 ++
util.c | 6 ++----
win32/perlhost.h | 19 +++++--------------
win32/vmem.h | 3 +--
win32/win32.c | 34 +++++++++++++++-------------------
win32/win32sck.c | 41 +++++++++++++----------------------------
12 files changed, 57 insertions(+), 72 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index 3068905..806711a 100644
--- 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/perl.h b/perl.h
index be07993..8b33633 100644
--- a/perl.h
+++ b/perl.h
@@ -172,6 +172,7 @@
# define tTHX PerlInterpreter*
# define pTHX register tTHX my_perl PERL_UNUSED_DECL
# define aTHX my_perl
+# define aTHXa(a) aTHX = (tTHX)a
# ifdef PERL_GLOBAL_STRUCT
# define dTHXa(a) dVAR; pTHX = (tTHX)a
# else
@@ -364,6 +365,7 @@
# define pTHX_
# define aTHX
# define aTHX_
+# define aTHXa(a) NOOP
# define dTHXa(a) dNOOP
# define dTHX dNOOP
# define pTHX_1 1
diff --git a/perlio.c b/perlio.c
index 0b5b411..54ca051 100644
--- a/perlio.c
+++ b/perlio.c
@@ -4847,8 +4847,8 @@ Perl_PerlIO_stderr(pTHX)
char *
PerlIO_getname(PerlIO *f, char *buf)
{
- dTHX;
#ifdef VMS
+ dTHX;
char *name = NULL;
bool exported = FALSE;
FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
@@ -4864,7 +4864,7 @@ PerlIO_getname(PerlIO *f, char *buf)
#else
PERL_UNUSED_ARG(f);
PERL_UNUSED_ARG(buf);
- Perl_croak(aTHX_ "Don't know how to get file name");
+ Perl_croak_nocontext("Don't know how to get file name");
return NULL;
#endif
}
@@ -5004,7 +5004,9 @@ PerlIO_stdoutf(const char *fmt, ...)
PerlIO *
PerlIO_tmpfile(void)
{
+#ifndef WIN32
dTHX;
+#endif
PerlIO *f = NULL;
#ifdef WIN32
const int fd = win32_tmpfd();
diff --git a/proto.h b/proto.h
index 4bfa724..e42d6bc 100644
--- 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)
diff --git a/reentr.c b/reentr.c
index e7e2b24..31b933c 100644
--- a/reentr.c
+++ b/reentr.c
@@ -300,10 +300,10 @@ Perl_reentrant_free(pTHX) {
void*
Perl_reentrant_retry(const char *f, ...)
{
- dTHX;
void *retptr = NULL;
va_list ap;
#ifdef USE_REENTRANT_API
+ dTHX;
/* Easier to special case this here than in embed.pl. (Look at what it
generates for proto.h) */
PERL_ARGS_ASSERT_REENTRANT_RETRY;
diff --git a/regen/reentr.pl b/regen/reentr.pl
index 49d7efa..899e83b 100644
--- a/regen/reentr.pl
+++ b/regen/reentr.pl
@@ -835,10 +835,10 @@ Perl_reentrant_free(pTHX) {
void*
Perl_reentrant_retry(const char *f, ...)
{
- dTHX;
void *retptr = NULL;
va_list ap;
#ifdef USE_REENTRANT_API
+ dTHX;
/* Easier to special case this here than in embed.pl. (Look at what it
generates for proto.h) */
PERL_ARGS_ASSERT_REENTRANT_RETRY;
diff --git a/time64.c b/time64.c
index 9faab10..7b08d41 100644
--- a/time64.c
+++ b/time64.c
@@ -303,7 +303,9 @@ static void S_copy_little_tm_to_big_TM(const struct tm *src, struct TM *dest) {
#ifndef HAS_LOCALTIME_R
/* Simulate localtime_r() to the best of our ability */
static struct tm * S_localtime_r(const time_t *clock, struct tm *result) {
+#ifdef VMS
dTHX; /* in case the following is defined as Perl_my_localtime(aTHX_ ...) */
+#endif
const struct tm *static_result = localtime(clock);
assert(result != NULL);
diff --git a/util.c b/util.c
index e684075..bbb3b0f 100644
--- a/util.c
+++ b/util.c
@@ -5989,7 +5989,6 @@ getting C<vsnprintf>.
int
Perl_my_snprintf(char *buffer, const Size_t len, const char *format, ...)
{
- dTHX;
int retval;
va_list ap;
PERL_ARGS_ASSERT_MY_SNPRINTF;
@@ -6008,7 +6007,7 @@ Perl_my_snprintf(char *buffer, const Size_t len, const char *format, ...)
(len > 0 && (Size_t)retval >= len)
#endif
)
- Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
+ Perl_croak_nocontext("panic: my_snprintf buffer overflow");
return retval;
}
@@ -6026,7 +6025,6 @@ C<sv_vcatpvf> instead, or getting C<vsnprintf>.
int
Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap)
{
- dTHX;
int retval;
#ifdef NEED_VA_COPY
va_list apc;
@@ -6054,7 +6052,7 @@ Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap
(len > 0 && (Size_t)retval >= len)
#endif
)
- Perl_croak(aTHX_ "panic: my_vsnprintf buffer overflow");
+ Perl_croak_nocontext("panic: my_vsnprintf buffer overflow");
return retval;
}
diff --git a/win32/perlhost.h b/win32/perlhost.h
index 3f18126..265328b 100644
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -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;
}
@@ -1808,8 +1807,8 @@ restart:
int
PerlProcFork(struct IPerlProc* piPerl)
{
- dTHX;
#ifdef USE_ITHREADS
+ dTHX;
DWORD id;
HANDLE handle;
CPerlHost *h;
@@ -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 */
}
@@ -1893,6 +1892,8 @@ PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const c
int
PerlProcLastHost(struct IPerlProc* piPerl)
{
+ /* this dTHX is unused in an optimized build since CPerlHost::num_hosts
+ is a static */
dTHX;
CPerlHost *h = (CPerlHost*)w32_internal_host;
return h->LastHost();
@@ -2177,7 +2178,6 @@ compare(const void *arg1, const void *arg2)
void
CPerlHost::Add(LPCSTR lpStr)
{
- dTHX;
char szBuffer[1024];
LPSTR *lpPtr;
int index, length = strlen(lpStr)+1;
@@ -2224,14 +2224,12 @@ CPerlHost::CalculateEnvironmentSpace(void)
void
CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr)
{
- dTHX;
Safefree(lpStr);
}
char*
CPerlHost::GetChildDir(void)
{
- dTHX;
char* ptr;
size_t length;
@@ -2248,14 +2246,12 @@ CPerlHost::GetChildDir(void)
void
CPerlHost::FreeChildDir(char* pStr)
{
- dTHX;
Safefree(pStr);
}
LPSTR
CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
{
- dTHX;
LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr;
DWORD dwSize, dwEnvIndex;
int nLength, compVal;
@@ -2345,7 +2341,6 @@ CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir)
void
CPerlHost::Reset(void)
{
- dTHX;
if(m_lppEnvList != NULL) {
for(DWORD index = 0; index < m_dwEnvCount; ++index) {
Free(m_lppEnvList[index]);
@@ -2360,7 +2355,6 @@ CPerlHost::Reset(void)
void
CPerlHost::Clearenv(void)
{
- dTHX;
char ch;
LPSTR lpPtr, lpStr, lpEnvPtr;
if (m_lppEnvList != NULL) {
@@ -2400,7 +2394,6 @@ CPerlHost::Clearenv(void)
char*
CPerlHost::Getenv(const char *varname)
{
- dTHX;
if (!m_bTopLevel) {
char *pEnv = Find(varname);
if (pEnv && *pEnv)
@@ -2412,7 +2405,6 @@ CPerlHost::Getenv(const char *varname)
int
CPerlHost::Putenv(const char *envstring)
{
- dTHX;
Add(envstring);
if (m_bTopLevel)
return win32_putenv(envstring);
@@ -2423,7 +2415,6 @@ CPerlHost::Putenv(const char *envstring)
int
CPerlHost::Chdir(const char *dirname)
{
- dTHX;
int ret;
if (!dirname) {
errno = ENOENT;
diff --git a/win32/vmem.h b/win32/vmem.h
index 4289cee..d691635 100644
--- a/win32/vmem.h
+++ b/win32/vmem.h
@@ -197,9 +197,8 @@ void VMem::Free(void* pMem)
if (ptr->owner != this) {
if (ptr->owner) {
#if 1
- dTHX;
int *nowhere = NULL;
- Perl_warn(aTHX_ "Free to wrong pool %p not %p",this,ptr->owner);
+ Perl_warn_nocontext("Free to wrong pool %p not %p",this,ptr->owner);
*nowhere = 0; /* this segfault is deliberate,
so you can see the stack trace */
#else
diff --git a/win32/win32.c b/win32/win32.c
index 5a932ca..f9e8d97 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -384,7 +384,6 @@ get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...)
EXTERN_C char *
win32_get_privlib(const char *pl, STRLEN *const len)
{
- dTHX;
char *stdlib = "lib";
char buffer[MAX_PATH+1];
SV *sv = NULL;
@@ -544,7 +543,6 @@ tokenize(const char *str, char **dest, char ***destv)
char **retvstart = 0;
int items = -1;
if (str) {
- dTHX;
int slen = strlen(str);
char *ret;
char **retv;
@@ -924,7 +922,6 @@ win32_readdir(DIR *dirp)
/* Now set up for the next call to readdir */
dirp->curr += len + 1;
if (dirp->curr >= dirp->end) {
- dTHX;
BOOL res;
char buffer[MAX_PATH*2];
@@ -1006,7 +1003,6 @@ win32_rewinddir(DIR *dirp)
DllExport int
win32_closedir(DIR *dirp)
{
- dTHX;
if (dirp->handle != INVALID_HANDLE_VALUE)
FindClose(dirp->handle);
Safefree(dirp->start);
@@ -1676,6 +1672,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. */
@@ -1839,13 +1843,12 @@ win32_getenv(const char *name)
DllExport int
win32_putenv(const char *name)
{
- dTHX;
char* curitem;
char* val;
int relval = -1;
if (name) {
- Newx(curitem,strlen(name)+1,char);
+ curitem = (char *) win32_malloc(strlen(name)+1);
strcpy(curitem, name);
val = strchr(curitem, '=');
if (val) {
@@ -1869,7 +1872,7 @@ win32_putenv(const char *name)
if (SetEnvironmentVariableA(curitem, *val ? val : NULL))
relval = 0;
}
- Safefree(curitem);
+ win32_free(curitem);
}
return relval;
}
@@ -2588,10 +2591,11 @@ win32_strerror(int e)
#endif
if (e < 0 || e > sys_nerr) {
- dTHX;
+ dTHXa(NULL);
if (e < 0)
e = GetLastError();
+ aTHXa(PERL_GET_THX);
if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
|FORMAT_MESSAGE_IGNORE_INSERTS, NULL, e, 0,
w32_strerror_buffer, sizeof(w32_strerror_buffer),
@@ -2704,7 +2708,6 @@ win32_fopen(const char *filename, const char *mode)
DllExport FILE *
win32_fdopen(int handle, const char *mode)
{
- dTHX;
FILE *f;
f = fdopen(handle, (char *) mode);
/* avoid buffering headaches for child processes */
@@ -2839,7 +2842,6 @@ win32_rewind(FILE *pf)
DllExport int
win32_tmpfd(void)
{
- dTHX;
char prefix[MAX_PATH+1];
char filename[MAX_PATH+1];
DWORD len = GetTempPath(MAX_PATH, prefix);
@@ -2901,8 +2903,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;
}
@@ -2918,7 +2919,6 @@ win32_popen(const char *command, const char *mode)
#ifdef USE_RTL_POPEN
return _popen(command, mode);
#else
- dTHX;
int p[2];
int parent, child;
int stdfd, oldfd;
@@ -3324,7 +3324,6 @@ win32_rmdir(const char *dir)
DllExport int
win32_chdir(const char *dir)
{
- dTHX;
if (!dir) {
errno = ENOENT;
return -1;
@@ -3350,7 +3349,6 @@ win32_chmod(const char *path, int mode)
static char *
create_command_line(char *cname, STRLEN clen, const char * const *args)
{
- dTHX;
int index, argc;
char *cmd, *ptr;
const char *arg;
@@ -3629,7 +3627,6 @@ win32_clearenv(void)
DllExport char*
win32_get_childdir(void)
{
- dTHX;
char* ptr;
char szfilename[MAX_PATH+1];
@@ -3642,7 +3639,6 @@ win32_get_childdir(void)
DllExport void
win32_free_childdir(char* d)
{
- dTHX;
Safefree(d);
}
@@ -3664,7 +3660,7 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
#ifdef USE_RTL_SPAWNVP
return spawnvp(mode, cmdname, (char * const *)argv);
#else
- dTHX;
+ dTHXa(NULL);
int ret;
void* env;
char* dir;
@@ -3697,6 +3693,7 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
cmd = create_command_line(cname, clen, argv);
+ aTHXa(PERL_GET_THX);
env = PerlEnv_get_childenv();
dir = PerlEnv_get_childdir();
@@ -4368,7 +4365,6 @@ Perl_win32_init(int *argcp, char ***argvp)
void
Perl_win32_term(void)
{
- dTHX;
HINTS_REFCNT_TERM;
OP_REFCNT_TERM;
PERLIO_TERM;
diff --git a/win32/win32sck.c b/win32/win32sck.c
index 9032a6d..38f66cf 100644
--- a/win32/win32sck.c
+++ b/win32/win32sck.c
@@ -63,7 +63,6 @@ EndSockets(void)
void
start_sockets(void)
{
- dTHX;
unsigned short version;
WSADATA retdata;
int ret;
@@ -551,7 +550,6 @@ win32_getservbyport(int port, const char *proto)
int
win32_ioctl(int i, unsigned int u, char *data)
{
- dTHX;
u_long u_long_arg;
int retval;
@@ -596,101 +594,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*
--
Perl5 Master Repository
