From cdef49c25f503790241b62e5e73ccfd280844eee Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Sun, 18 Jan 2015 01:31:24 -0500
Subject: [PATCH] introduce PL_w32_osver

Calling GetVersionEx in an XS module is a common activity according to CPAN
grep. The only RW static global var in Win32:: is an OSVERSIONINFO struct.
Win32:: is often loaded by Win32 Perl users for various reasons. So to
decrease its load time, and remove all perl caused (non-CC caused) RW
static data from Win32::, export core's OSVERSIONINFO struct as a data
export. For XS modules in general, the DLL overhead of the perl core data
export and overhead of using GetVersionEx are the same. 2 ptr sized values
and 1 null terminated string (symbol name). So if a XS module stops
importing GetVersionEx and instead imports PL_w32_osver, the space usage
in the DLL is basically identical. If for that XS module, OSVERSIONINFO was
the only RW global data, then it is a win in memory. Obviously it is a win
in execution time to not call GetVersionEx and do pointer derefs instead.
The DLL loader will have the same work to do resolving GetVersionEx and
PL_w32_osver symbols, but GetVersionEx has to execute later but
PL_w32_osver doesn't. Since this data can never change between reboots,
it is process global and not interp global for ithreads/psuedofork
purposes. An unimplemented idea would be to prefill the OSVERSIONINFOEX
struct with the data from PC that the perl core was built on, and use
.data section symbol ordering (a "map" file) to stick PL_check, PL_ppaddr
and PL_w32_osver in 1 DLL/OS page and have Windows do interprocess COW
on that page. VC doesn't treat the imported data * in the IAT as const
and will reread the IAT entry of the DLL between function calls. To avoid
double indirection over and over (something like
"eax = *(U32*)(eip+__imp__PL_w32_osver);
if(*(U32*)(eax+dwMajorVersion) >= 6) {")
create dW32OSVER and w32_osver as C auto caches of PL_w32_osver.

It has not been decided what to do with Windows 8.1's freezing of the data
GetVersionEx reports. This API is designed to be possibly included in
ppport.h. See how Win32:: chooses to use its per module GetVersionEx or
the global one.
---
 cpan/Win32/Win32.xs         |   56 ++++++++++++++++++++++++++++++-------------
 cpan/Win32/t/GetOSVersion.t |    2 +-
 embedvar.h                  |    2 +
 perlapi.h                   |    2 +
 perlvars.h                  |   22 +++++++++++++++++
 win32/win32.c               |   24 ++++++++++--------
 win32/win32.h               |   43 +++++++++++++++++++++++++++++++++
 7 files changed, 122 insertions(+), 29 deletions(-)

diff --git a/cpan/Win32/Win32.xs b/cpan/Win32/Win32.xs
index a5d6c6a..8de7c65 100644
--- a/cpan/Win32/Win32.xs
+++ b/cpan/Win32/Win32.xs
@@ -109,6 +109,7 @@ typedef void (WINAPI *PFNGetNativeSystemInfo)(LPSYSTEM_INFO lpSystemInfo);
 #   define CSIDL_FLAG_CREATE          0x8000
 #endif
 
+#if !((PERL_VERSION >= 5) && (PERL_VERSION >= 21) && (PERL_SUBVERSION >= 8))
 /* Use explicit struct definition because wSuiteMask and
  * wProductType are not defined in the VC++ 6.0 headers.
  * WORD type has been replaced by unsigned short because
@@ -127,25 +128,37 @@ struct {
     BYTE  wProductType;
     BYTE  wReserved;
 }   g_osver = {0, 0, 0, 0, 0, "", 0, 0, 0, 0, 0};
-BOOL g_osver_ex = TRUE;
+/* by the default being null bytes instead of sizeof(g_osver), this var doesn't
+   require on disk storage in the DLL */
+#  define dW32MOD_OSVER dNOOP
+#else
+/* this stops multiple reads of IAT entry for PL_w32_osver */
+#  define dW32MOD_OSVER dW32OSVER
+#  define g_osver w32_osver
+#endif
+
+#define OSVER_HAVE_EX (g_osver.dwOSVersionInfoSize == sizeof(g_osver))
 
 #define ONE_K_BUFSIZE	1024
 
 int
 IsWin95(void)
 {
+    dW32MOD_OSVER;
     return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS);
 }
 
 int
 IsWinNT(void)
 {
+    dW32MOD_OSVER;
     return (g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT);
 }
 
 int
 IsWin2000(void)
 {
+    dW32MOD_OSVER;
     return (g_osver.dwMajorVersion > 4);
 }
 
@@ -1296,20 +1309,27 @@ XS(w32_GetOSVersion)
 {
     dXSARGS;
 
-    if (GIMME_V == G_SCALAR) {
-        XSRETURN_IV(g_osver.dwPlatformId);
-    }
-    XPUSHs(sv_2mortal(newSVpvn(g_osver.szCSDVersion, strlen(g_osver.szCSDVersion))));
-
-    XPUSHs(sv_2mortal(newSViv(g_osver.dwMajorVersion)));
-    XPUSHs(sv_2mortal(newSViv(g_osver.dwMinorVersion)));
-    XPUSHs(sv_2mortal(newSViv(g_osver.dwBuildNumber)));
-    XPUSHs(sv_2mortal(newSViv(g_osver.dwPlatformId)));
-    if (g_osver_ex) {
-        XPUSHs(sv_2mortal(newSViv(g_osver.wServicePackMajor)));
-        XPUSHs(sv_2mortal(newSViv(g_osver.wServicePackMinor)));
-        XPUSHs(sv_2mortal(newSViv(g_osver.wSuiteMask)));
-        XPUSHs(sv_2mortal(newSViv(g_osver.wProductType)));
+    XSprePUSH;
+    EXTEND(SP, 9);
+    {
+	const I32 gimme = GIMME_V;
+	dW32MOD_OSVER;
+	if (gimme == G_SCALAR) {
+	    PUSHs(sv_2mortal(newSViv(g_osver.dwPlatformId)));
+	}
+	else {
+	    PUSHs(sv_2mortal(newSVpvn(g_osver.szCSDVersion, strlen(g_osver.szCSDVersion))));
+	    PUSHs(sv_2mortal(newSViv(g_osver.dwMajorVersion)));
+	    PUSHs(sv_2mortal(newSViv(g_osver.dwMinorVersion)));
+	    PUSHs(sv_2mortal(newSViv(g_osver.dwBuildNumber)));
+	    PUSHs(sv_2mortal(newSViv(g_osver.dwPlatformId)));
+	    if (OSVER_HAVE_EX) {
+		PUSHs(sv_2mortal(newSViv(g_osver.wServicePackMajor)));
+		PUSHs(sv_2mortal(newSViv(g_osver.wServicePackMinor)));
+		PUSHs(sv_2mortal(newSViv(g_osver.wSuiteMask)));
+		PUSHs(sv_2mortal(newSViv(g_osver.wProductType)));
+	    }
+	}
     }
     PUTBACK;
 }
@@ -1451,6 +1471,7 @@ XS(w32_GetFullPathName)
     dXSARGS;
     char *fullname;
     char *ansi = NULL;
+    dW32MOD_OSVER;
 
 /* The code below relies on the fact that PerlDir_mapX() returns an
  * absolute path, which is only true under PERL_IMPLICIT_SYS when
@@ -1800,15 +1821,16 @@ PROTOTYPES: DISABLE
 BOOT:
 {
     char *file = __FILE__;
-
+#if !((PERL_VERSION >= 5) && (PERL_VERSION >= 21) && (PERL_SUBVERSION >= 8))
     if (g_osver.dwOSVersionInfoSize == 0) {
         g_osver.dwOSVersionInfoSize = sizeof(g_osver);
         if (!GetVersionExA((OSVERSIONINFOA*)&g_osver)) {
-            g_osver_ex = FALSE;
+/* OSVERSIONINFOEXA only works on NT SP6 or newer NT, no Dos Windows and no CE */
             g_osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA);
             GetVersionExA((OSVERSIONINFOA*)&g_osver);
         }
     }
+#endif
 
     newXS("Win32::LookupAccountName", w32_LookupAccountName, file);
     newXS("Win32::LookupAccountSID", w32_LookupAccountSID, file);
diff --git a/cpan/Win32/t/GetOSVersion.t b/cpan/Win32/t/GetOSVersion.t
index cb3f364..3e8d1e5 100644
--- a/cpan/Win32/t/GetOSVersion.t
+++ b/cpan/Win32/t/GetOSVersion.t
@@ -5,7 +5,7 @@ use Win32;
 plan tests => 1;
 
 my $scalar = Win32::GetOSVersion();
-my @array  = Win32::GetOSVersion();
+my @array  = Win32::GetOSVersion("bad arg1", "bad arg2");
 
 print "not " unless $scalar == $array[4];
 print "ok 1\n";
diff --git a/embedvar.h b/embedvar.h
index da3c331..cabf666 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -434,6 +434,8 @@
 #define PL_Guse_safe_putenv	(my_vars->Guse_safe_putenv)
 #define PL_veto_cleanup		(my_vars->Gveto_cleanup)
 #define PL_Gveto_cleanup	(my_vars->Gveto_cleanup)
+#define PL_w32_osver		(my_vars->Gw32_osver)
+#define PL_Gw32_osver		(my_vars->Gw32_osver)
 #define PL_watch_pvx		(my_vars->Gwatch_pvx)
 #define PL_Gwatch_pvx		(my_vars->Gwatch_pvx)
 
diff --git a/perlapi.h b/perlapi.h
index 910f789..5268c2c 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -169,6 +169,8 @@ END_EXTERN_C
 #define PL_use_safe_putenv	(*Perl_Guse_safe_putenv_ptr(NULL))
 #undef  PL_veto_cleanup
 #define PL_veto_cleanup		(*Perl_Gveto_cleanup_ptr(NULL))
+#undef  PL_w32_osver
+#define PL_w32_osver		(*Perl_Gw32_osver_ptr(NULL))
 #undef  PL_watch_pvx
 #define PL_watch_pvx		(*Perl_Gwatch_pvx_ptr(NULL))
 
diff --git a/perlvars.h b/perlvars.h
index 7bafa40..1d94c43 100644
--- a/perlvars.h
+++ b/perlvars.h
@@ -237,3 +237,25 @@ PERLVAR(G, malloc_mutex, perl_mutex)	/* Mutex for malloc */
 
 PERLVARI(G, hash_seed_set, bool, FALSE)	/* perl.c */
 PERLVARA(G, hash_seed, PERL_HASH_SEED_BYTES, unsigned char) /* perl.c and hv.h */
+
+/*
+=for apidoc AM|osver|PL_w32_osver
+
+This is a global that contains an Win32 C<OSVERSIONINFOEX> struct that contains
+the OS version.  Type C<osver> is identical to C<OSVERSIONINFOEX>.  This global
+is a struct, not a struct pointer, use C<.> not C<-&gt;>.  C<osver> exists
+because older Win32 compilers might not have C<OSVERSIONINFOEX> in their
+headers.  If C<PL_w32_osver.dwOSVersionInfoSize != sizeof(osver)>, then the
+later elements of C<OSVERSIONINFOEX> are uninitialized, and only the subset
+of C<OSVERSIONINFO> members are valid.  It has not been decided what version
+number this will contain for Windows 8.1 and up due to recent changes by
+Microsoft to the Windows API.  For efficiency, if you will use C<PL_w32_osver>
+more than once in a function, use L</dW32OSVER> and L</w32_osver> instead of
+multiple references to C<PL_w32_osver>.
+
+=cut
+*/
+
+#ifdef WIN32
+PERLVARI(G, w32_osver, osver, {sizeof(osver)})
+#endif
diff --git a/win32/win32.c b/win32/win32.c
index d4c98e4..55a09e2 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -188,8 +188,6 @@ Size_t	w32_ioinfo_size;/* avoid 0 extend op b4 mul, otherwise could be a U8 */
 #endif
 END_EXTERN_C
 
-static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""};
-
 #ifdef SET_INVALID_PARAMETER_HANDLER
 static BOOL silent_invalid_parameter_handler = FALSE;
 
@@ -523,7 +521,7 @@ Perl_my_pclose(pTHX_ PerlIO *fp)
 DllExport unsigned long
 win32_os_id(void)
 {
-    return (unsigned long)g_osver.dwPlatformId;
+    return (unsigned long)PL_w32_osver.dwPlatformId;
 }
 
 DllExport int
@@ -2049,7 +2047,7 @@ win32_uname(struct utsname *name)
     STRLEN nodemax = sizeof(name->nodename)-1;
 
     /* sysname */
-    switch (g_osver.dwPlatformId) {
+    switch (PL_w32_osver.dwPlatformId) {
     case VER_PLATFORM_WIN32_WINDOWS:
         strcpy(name->sysname, "Windows");
         break;
@@ -2066,15 +2064,15 @@ win32_uname(struct utsname *name)
 
     /* release */
     sprintf(name->release, "%d.%d",
-            g_osver.dwMajorVersion, g_osver.dwMinorVersion);
+            PL_w32_osver.dwMajorVersion, PL_w32_osver.dwMinorVersion);
 
     /* version */
     sprintf(name->version, "Build %d",
-            g_osver.dwPlatformId == VER_PLATFORM_WIN32_NT
-            ? g_osver.dwBuildNumber : (g_osver.dwBuildNumber & 0xffff));
-    if (g_osver.szCSDVersion[0]) {
+            PL_w32_osver.dwPlatformId == VER_PLATFORM_WIN32_NT
+            ? PL_w32_osver.dwBuildNumber : (PL_w32_osver.dwBuildNumber & 0xffff));
+    if (PL_w32_osver.szCSDVersion[0]) {
         char *buf = name->version + strlen(name->version);
-        sprintf(buf, " (%s)", g_osver.szCSDVersion);
+        sprintf(buf, " (%s)", PL_w32_osver.szCSDVersion);
     }
 
     /* nodename */
@@ -4469,8 +4467,12 @@ Perl_win32_init(int *argcp, char ***argvp)
      */
     //InitCommonControls();
 
-    g_osver.dwOSVersionInfoSize = sizeof(g_osver);
-    GetVersionEx(&g_osver);
+    if (PL_w32_osver.dwOSVersionInfoSize == 0) {
+/* no CE or DOS Windows, so no need to try again with the smaller
+  OSVERSIONINFOA struct */
+        PL_w32_osver.dwOSVersionInfoSize = sizeof(osver);
+        GetVersionExA((OSVERSIONINFOA*)&PL_w32_osver);
+    }
 
 #ifdef WIN32_DYN_IOINFO_SIZE
     {
diff --git a/win32/win32.h b/win32/win32.h
index f49a4b0..502649b 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -538,6 +538,49 @@ void win32_wait_for_children(pTHX);
 #  define PERL_WAIT_FOR_CHILDREN win32_wait_for_children(aTHX)
 #endif
 
+/* Use explicit struct definition because wSuiteMask and
+ * wProductType are not defined in the VC++ 6.0 headers.
+ * WORD type has been replaced by unsigned short because
+ * WORD is already used by Perl itself.
+ */
+typedef struct {
+    DWORD dwOSVersionInfoSize;
+    DWORD dwMajorVersion;
+    DWORD dwMinorVersion;
+    DWORD dwBuildNumber;
+    DWORD dwPlatformId;
+    CHAR  szCSDVersion[128];
+    unsigned short wServicePackMajor;
+    unsigned short wServicePackMinor;
+    unsigned short wSuiteMask;
+    BYTE  wProductType;
+    BYTE  wReserved;
+} osver;
+
+/*
+=for apidoc AM|void|dW32OSVER
+
+Declares a local copy of L</PL_w32_osver>.  This is more efficienct than multiple
+references to L</PL_w32_osver>.  The local copy should be accessed through
+L</w32_osver>.
+
+=cut
+*/
+#define dW32OSVER const osver * const w32_osver_p = &PL_w32_osver
+
+/*
+=for apidoc AM||w32_osver
+
+A macro to access a local copy of L</PL_w32_osver> declared with L</dW32OSVER>.
+This is more efficient than multiple references to L</PL_w32_osver>. This macro
+is a struct, not a struct pointer, use C<.> not C<-&gt;>.
+
+=cut
+*/
+
+#define w32_osver (*w32_osver_p)
+
+
 #ifdef PERL_CORE
 /* C doesn't like repeat struct definitions */
 #if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION>=3)
-- 
1.7.9.msysgit.0