From 8602b8b483fd858e83bb5405e8ab2a7dad3b273b Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Fri, 14 Nov 2014 22:35:02 -0500
Subject: [PATCH] remove PERL_IMPLICIT_SYS stubs

Use an ABI trick to remove the indirection of the method functions calls
to the functions that implement these calls. Linkers normally can't see
inside the body a function to realize that the reference to a stub
function can be replaced with a reference to what the stub calls. Inlining
is impossible for a vtable call. Also the perlProc struct/vtable was RW
instead of being RO/const. Make it const so it can be shared by the OS
between perl processes. VC2003 32bit perl521.dll image section sizes
before .text 0xc64f3 .rdata 0x464c5 .data 0x30b8
after  .text 0xc6423 .rdata 0x46545 .data 0x3038
---
 iperlsys.h       |   81 ++++++++++++++++-----------------
 win32/perlhost.h |  132 ++++++++++++++++++++++++++++++++++++++----------------
 2 files changed, 133 insertions(+), 80 deletions(-)

diff --git a/iperlsys.h b/iperlsys.h
index 9604ad4..5edce51 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -920,52 +920,51 @@ struct IPerlMemInfo
 struct IPerlProc;
 struct IPerlProcInfo;
 typedef void		(*LPProcAbort)(struct IPerlProc*);
-typedef char*		(*LPProcCrypt)(struct IPerlProc*, const char*,
-			    const char*);
-typedef void		(*LPProcExit)(struct IPerlProc*, int)
+typedef char*		(*LPProcCrypt)(const char*,
+			    const char*, struct IPerlProc*);
+typedef void		(*LPProcExit)(int, struct IPerlProc*)
 			    __attribute__noreturn__;
-typedef void		(*LPProc_Exit)(struct IPerlProc*, int)
+typedef void		(*LPProc_Exit)(int, struct IPerlProc*)
 			    __attribute__noreturn__;
-typedef int		(*LPProcExecl)(struct IPerlProc*, const char*,
+typedef int		(*LPProcExecl)(const char*,
 			    const char*, const char*, const char*,
-			    const char*);
-typedef int		(*LPProcExecv)(struct IPerlProc*, const char*,
-			    const char*const*);
-typedef int		(*LPProcExecvp)(struct IPerlProc*, const char*,
-			    const char*const*);
+			    const char*, struct IPerlProc*);
+typedef int		(*LPProcExecv)(const char*,
+			    const char*const*, struct IPerlProc*);
+typedef int		(*LPProcExecvp)(const char*,
+			    const char*const*, struct IPerlProc*);
 typedef Uid_t		(*LPProcGetuid)(struct IPerlProc*);
 typedef Uid_t		(*LPProcGeteuid)(struct IPerlProc*);
 typedef Gid_t		(*LPProcGetgid)(struct IPerlProc*);
 typedef Gid_t		(*LPProcGetegid)(struct IPerlProc*);
 typedef char*		(*LPProcGetlogin)(struct IPerlProc*);
-typedef int		(*LPProcKill)(struct IPerlProc*, int, int);
+typedef int		(*LPProcKill)(int, int, struct IPerlProc*);
 typedef int		(*LPProcKillpg)(struct IPerlProc*, int, int);
 typedef int		(*LPProcPauseProc)(struct IPerlProc*);
 typedef PerlIO*		(*LPProcPopen)(struct IPerlProc*, const char*,
 			    const char*);
 typedef PerlIO*		(*LPProcPopenList)(struct IPerlProc*, const char*,
 			    IV narg, SV **args);
-typedef int		(*LPProcPclose)(struct IPerlProc*, PerlIO*);
+typedef int		(*LPProcPclose)(PerlIO*, struct IPerlProc*);
 typedef int		(*LPProcPipe)(struct IPerlProc*, int*);
 typedef int		(*LPProcSetuid)(struct IPerlProc*, uid_t);
 typedef int		(*LPProcSetgid)(struct IPerlProc*, gid_t);
-typedef int		(*LPProcSleep)(struct IPerlProc*, unsigned int);
-typedef int		(*LPProcTimes)(struct IPerlProc*, struct tms*);
-typedef int		(*LPProcWait)(struct IPerlProc*, int*);
-typedef int		(*LPProcWaitpid)(struct IPerlProc*, int, int*, int);
-typedef Sighandler_t	(*LPProcSignal)(struct IPerlProc*, int, Sighandler_t);
+typedef int		(*LPProcSleep)(unsigned int, struct IPerlProc*);
+typedef int		(*LPProcTimes)(struct tms*, struct IPerlProc*);
+typedef int		(*LPProcWait)(int*, struct IPerlProc*);
+typedef int		(*LPProcWaitpid)(int, int*, int, struct IPerlProc*);
+typedef Sighandler_t	(*LPProcSignal)(int, Sighandler_t, struct IPerlProc*);
 typedef int		(*LPProcFork)(struct IPerlProc*);
 typedef int		(*LPProcGetpid)(struct IPerlProc*);
 #ifdef WIN32
-typedef void*		(*LPProcDynaLoader)(struct IPerlProc*, const char*);
-typedef void		(*LPProcGetOSError)(struct IPerlProc*,
-			    SV* sv, DWORD dwErr);
-typedef int		(*LPProcSpawnvp)(struct IPerlProc*, int, const char*,
-			    const char*const*);
+typedef void*		(*LPProcDynaLoader)(const char*, struct IPerlProc*);
+typedef void		(*LPProcGetOSError)(SV* sv, DWORD dwErr, struct IPerlProc*);
+typedef int		(*LPProcSpawnvp)(int, const char*,
+			    const char*const*, struct IPerlProc*);
 #endif
 typedef int		(*LPProcLastHost)(struct IPerlProc*);
-typedef int		(*LPProcGetTimeOfDay)(struct IPerlProc*,
-					      struct timeval*, void*);
+typedef int		(*LPProcGetTimeOfDay)(struct timeval*, void*,
+					      struct IPerlProc*);
 
 struct IPerlProc
 {
@@ -1015,17 +1014,17 @@ struct IPerlProcInfo
 #define PerlProc_abort()						\
 	(*PL_Proc->pAbort)(PL_Proc)
 #define PerlProc_crypt(c,s)						\
-	(*PL_Proc->pCrypt)(PL_Proc, (c), (s))
+	(*PL_Proc->pCrypt)((c), (s), PL_Proc)
 #define PerlProc_exit(s)						\
-	(*PL_Proc->pExit)(PL_Proc, (s))
+	(*PL_Proc->pExit)((s), PL_Proc)
 #define PerlProc__exit(s)						\
-	(*PL_Proc->p_Exit)(PL_Proc, (s))
+	(*PL_Proc->p_Exit)((s), PL_Proc)
 #define PerlProc_execl(c, w, x, y, z)					\
-	(*PL_Proc->pExecl)(PL_Proc, (c), (w), (x), (y), (z))
+	(*PL_Proc->pExecl)((c), (w), (x), (y), (z), PL_Proc)
 #define PerlProc_execv(c, a)						\
-	(*PL_Proc->pExecv)(PL_Proc, (c), (a))
+	(*PL_Proc->pExecv)((c), (a), PL_Proc)
 #define PerlProc_execvp(c, a)						\
-	(*PL_Proc->pExecvp)(PL_Proc, (c), (a))
+	(*PL_Proc->pExecvp)((c), (a), PL_Proc)
 #define PerlProc_getuid()						\
 	(*PL_Proc->pGetuid)(PL_Proc)
 #define PerlProc_geteuid()						\
@@ -1037,7 +1036,7 @@ struct IPerlProcInfo
 #define PerlProc_getlogin()						\
 	(*PL_Proc->pGetlogin)(PL_Proc)
 #define PerlProc_kill(i, a)						\
-	(*PL_Proc->pKill)(PL_Proc, (i), (a))
+	(*PL_Proc->pKill)((i), (a), PL_Proc)
 #define PerlProc_killpg(i, a)						\
 	(*PL_Proc->pKillpg)(PL_Proc, (i), (a))
 #define PerlProc_pause()						\
@@ -1047,7 +1046,7 @@ struct IPerlProcInfo
 #define PerlProc_popen_list(m, n, a)					\
 	(*PL_Proc->pPopenList)(PL_Proc, (m), (n), (a))
 #define PerlProc_pclose(f)						\
-	(*PL_Proc->pPclose)(PL_Proc, (f))
+	(*PL_Proc->pPclose)((f), PL_Proc)
 #define PerlProc_pipe(fd)						\
 	(*PL_Proc->pPipe)(PL_Proc, (fd))
 #define PerlProc_setuid(u)						\
@@ -1055,15 +1054,15 @@ struct IPerlProcInfo
 #define PerlProc_setgid(g)						\
 	(*PL_Proc->pSetgid)(PL_Proc, (g))
 #define PerlProc_sleep(t)						\
-	(*PL_Proc->pSleep)(PL_Proc, (t))
+	(*PL_Proc->pSleep)((t), PL_Proc)
 #define PerlProc_times(t)						\
-	(*PL_Proc->pTimes)(PL_Proc, (t))
+	(*PL_Proc->pTimes)((t), PL_Proc)
 #define PerlProc_wait(t)						\
-	(*PL_Proc->pWait)(PL_Proc, (t))
+	(*PL_Proc->pWait)((t), PL_Proc)
 #define PerlProc_waitpid(p,s,f)						\
-	(*PL_Proc->pWaitpid)(PL_Proc, (p), (s), (f))
+	(*PL_Proc->pWaitpid)((p), (s), (f), PL_Proc)
 #define PerlProc_signal(n, h)						\
-	(*PL_Proc->pSignal)(PL_Proc, (n), (h))
+	(*PL_Proc->pSignal)((n), (h), PL_Proc)
 #define PerlProc_fork()							\
 	(*PL_Proc->pFork)(PL_Proc)
 #define PerlProc_getpid()						\
@@ -1073,16 +1072,16 @@ struct IPerlProcInfo
 
 #ifdef WIN32
 #define PerlProc_DynaLoad(f)						\
-	(*PL_Proc->pDynaLoader)(PL_Proc, (f))
+	(*PL_Proc->pDynaLoader)((f),PL_Proc)
 #define PerlProc_GetOSError(s,e)					\
-	(*PL_Proc->pGetOSError)(PL_Proc, (s), (e))
+	(*PL_Proc->pGetOSError)((s), (e), PL_Proc)
 #define PerlProc_spawnvp(m, c, a)					\
-	(*PL_Proc->pSpawnvp)(PL_Proc, (m), (c), (a))
+	(*PL_Proc->pSpawnvp)((m), (c), (a), PL_Proc)
 #endif
 #define PerlProc_lasthost()						\
 	(*PL_Proc->pLastHost)(PL_Proc)
 #define PerlProc_gettimeofday(t,z)					\
-	(*PL_Proc->pGetTimeOfDay)(PL_Proc,(t),(z))
+	(*PL_Proc->pGetTimeOfDay)((t),(z), PL_Proc)
 
 #else	/* PERL_IMPLICIT_SYS */
 
diff --git a/win32/perlhost.h b/win32/perlhost.h
index b1c6c80..0637f8e 100644
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -1521,6 +1521,7 @@ struct IPerlSock perlSock =
 #define EXECF_EXEC 1
 #define EXECF_SPAWN 2
 
+/*
 void
 PerlProcAbort(struct IPerlProc* piPerl)
 {
@@ -1528,40 +1529,65 @@ PerlProcAbort(struct IPerlProc* piPerl)
 }
 
 char *
-PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt)
+PerlProcCrypt(const char* clear, const char* salt, struct IPerlProc* piPerl)
 {
     return win32_crypt(clear, salt);
 }
+*/
+
+void
+win32_exit(int status)
+{
+    exit(status);
+}
+
+void
+win32__exit(int status)
+{
+    _exit(status);
+}
+
+int
+win32_execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
+{
+    return execl(cmdname, arg0, arg1, arg2, arg3);
+}
+
 
+/* the struct IPerlProc* piPerl param may discourage a less than perfect
+   C optimizer from optimizing the function to a single "jmp" instruction */
+/*
 PERL_CALLCONV_NO_RET void
-PerlProcExit(struct IPerlProc* piPerl, int status)
+PerlProcExit(int status, struct IPerlProc* piPerl)
 {
     exit(status);
 }
 
 PERL_CALLCONV_NO_RET void
-PerlProc_Exit(struct IPerlProc* piPerl, int status)
+PerlProc_Exit(int status, struct IPerlProc* piPerl)
 {
     _exit(status);
 }
 
+
 int
-PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3)
+PerlProcExecl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3, struct IPerlProc* piPerl)
 {
     return execl(cmdname, arg0, arg1, arg2, arg3);
 }
 
 int
-PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
+PerlProcExecv(const char *cmdname, const char *const *argv, struct IPerlProc* piPerl)
 {
     return win32_execvp(cmdname, argv);
 }
 
 int
-PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv)
+PerlProcExecvp(const char *cmdname, const char *const *argv, struct IPerlProc* piPerl)
 {
     return win32_execvp(cmdname, argv);
 }
+*/
 
 uid_t
 PerlProcGetuid(struct IPerlProc* piPerl)
@@ -1587,6 +1613,7 @@ PerlProcGetegid(struct IPerlProc* piPerl)
     return getegid();
 }
 
+/*
 char *
 PerlProcGetlogin(struct IPerlProc* piPerl)
 {
@@ -1594,10 +1621,11 @@ PerlProcGetlogin(struct IPerlProc* piPerl)
 }
 
 int
-PerlProcKill(struct IPerlProc* piPerl, int pid, int sig)
+PerlProcKill(int pid, int sig, struct IPerlProc* piPerl)
 {
     return win32_kill(pid, sig);
 }
+*/
 
 int
 PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
@@ -1627,11 +1655,13 @@ PerlProcPopenList(struct IPerlProc* piPerl, const char *mode, IV narg, SV **args
     return win32_popenlist(mode, narg, args);
 }
 
+/*
 int
-PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream)
+PerlProcPclose(PerlIO *stream, struct IPerlProc* piPerl)
 {
     return win32_pclose(stream);
 }
+*/
 
 int
 PerlProcPipe(struct IPerlProc* piPerl, int *phandles)
@@ -1651,41 +1681,43 @@ PerlProcSetgid(struct IPerlProc* piPerl, gid_t g)
     return setgid(g);
 }
 
+/*
 int
-PerlProcSleep(struct IPerlProc* piPerl, unsigned int s)
+PerlProcSleep(unsigned int s, struct IPerlProc* piPerl)
 {
     return win32_sleep(s);
 }
 
 int
-PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf)
+PerlProcTimes(struct tms *timebuf, struct IPerlProc* piPerl)
 {
     return win32_times(timebuf);
 }
 
 int
-PerlProcWait(struct IPerlProc* piPerl, int *status)
+PerlProcWait(int *status, struct IPerlProc* piPerl)
 {
     return win32_wait(status);
 }
 
 int
-PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags)
+PerlProcWaitpid(int pid, int *status, int flags, struct IPerlProc* piPerl)
 {
     return win32_waitpid(pid, status, flags);
 }
 
 Sighandler_t
-PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode)
+PerlProcSignal(int sig, Sighandler_t subcode, struct IPerlProc* piPerl)
 {
     return win32_signal(sig, subcode);
 }
 
 int
-PerlProcGetTimeOfDay(struct IPerlProc* piPerl, struct timeval *t, void *z)
+PerlProcGetTimeOfDay(struct timeval *t, void *z, struct IPerlProc* piPerl)
 {
     return win32_gettimeofday(t, z);
 }
+*/
 
 #ifdef USE_ITHREADS
 static THREAD_RET_TYPE
@@ -1873,23 +1905,25 @@ PerlProcGetpid(struct IPerlProc* piPerl)
     return win32_getpid();
 }
 
+/*
 void*
-PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename)
+PerlProcDynaLoader(const char* filename, struct IPerlProc* piPerl)
 {
     return win32_dynaload(filename);
 }
 
 void
-PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr)
+PerlProcGetOSError(SV* sv, DWORD dwErr, struct IPerlProc* piPerl)
 {
     win32_str_os_error(sv, dwErr);
 }
 
 int
-PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv)
+PerlProcSpawnvp(int mode, const char *cmdname, const char *const *argv, struct IPerlProc* piPerl)
 {
     return win32_spawnvp(mode, cmdname, argv);
 }
+*/
 
 int
 PerlProcLastHost(struct IPerlProc* piPerl)
@@ -1901,41 +1935,61 @@ PerlProcLastHost(struct IPerlProc* piPerl)
  return h->LastHost();
 }
 
-struct IPerlProc perlProc =
-{
-    PerlProcAbort,
-    PerlProcCrypt,
-    PerlProcExit,
-    PerlProc_Exit,
-    PerlProcExecl,
-    PerlProcExecv,
-    PerlProcExecvp,
+/* The function pointer type puning works since these are __cdecl i386,
+   the register+__cdecl-ish calling convenstion on Win64 and WinCE on ARM
+   (but PERL_IMPLICIT_SYS isn't available on WinCE perl). So these casts are
+   like a variodic function ignoring its "..." args and never derefing them.
+   The "..." arg being ignored is "struct IPerlProc* piPerl".
+   If __stdcall or __fastcall on i386 was used here, this would crash */
+const static struct IPerlProc perlProc =
+{
+    (LPProcAbort)win32_abort,
+    (LPProcCrypt)win32_crypt,
+/* GCC 4.6.3 cant/wont tailcall PerlProc*() to a "jmp" so use the non-dllimport
+   style import stubs instead of reling on GCC to optimize PerlProc*() to
+   a import stub */
+#ifndef _MSC_VER
+    (LPProcExit)exit,
+    (LPProc_Exit)_exit,
+    (LPProcExecl)execl,
+#else /* since VC 2003 uses dllimport, a C++ style static initializer function
+         will fill these 3 struct members at startup, also it means "const" is
+         ignored and struct perlProc is placed in unshared RW memory, the
+         PerlProc*() functions may or may not optimize to just "jmp" but it is
+         better than a RW struct */
+    (LPProcExit)win32_exit,
+    (LPProc_Exit)win32__exit,
+    (LPProcExecl)win32_execl,
+#endif
+
+    (LPProcExecv)win32_execvp,
+    (LPProcExecvp)win32_execvp,
     PerlProcGetuid,
     PerlProcGeteuid,
     PerlProcGetgid,
     PerlProcGetegid,
-    PerlProcGetlogin,
-    PerlProcKill,
+    (LPProcGetlogin)g_getlogin, /* in win32.c, not in CRT */
+    (LPProcKill)win32_kill,
     PerlProcKillpg,
     PerlProcPauseProc,
     PerlProcPopen,
-    PerlProcPclose,
+    (LPProcPclose)win32_pclose,
     PerlProcPipe,
     PerlProcSetuid,
     PerlProcSetgid,
-    PerlProcSleep,
-    PerlProcTimes,
-    PerlProcWait,
-    PerlProcWaitpid,
-    PerlProcSignal,
+    (LPProcSleep)win32_sleep,
+    (LPProcTimes)win32_times,
+    (LPProcWait)win32_wait,
+    (LPProcWaitpid)win32_waitpid,
+    (LPProcSignal)win32_signal,
     PerlProcFork,
-    PerlProcGetpid,
-    PerlProcDynaLoader,
-    PerlProcGetOSError,
-    PerlProcSpawnvp,
+    (LPProcGetpid)win32_getpid,
+    (LPProcDynaLoader)win32_dynaload,
+    (LPProcGetOSError)win32_str_os_error,
+    (LPProcSpawnvp)win32_spawnvp,
     PerlProcLastHost,
     PerlProcPopenList,
-    PerlProcGetTimeOfDay
+    (LPProcGetTimeOfDay)win32_gettimeofday
 };
 
 
-- 
1.7.9.msysgit.0