* generic/tcl.h: Corrected Tcl_WideInt declarations so that the mingw

build works again.
* generic/tclInt.decls:			Changes to the tests for
* generic/tclIntPlatDecls.h:		clock frequency in Tcl_WinTime
* generic/tclStubInit.c:		so that any clock frequency
* tests/platform.test (platform-1.3):	is accepted provided that
* win/tclWin32Dll.c (TclWinCPUID):	all CPU's in the system share
* win/tclWinTest.c (TestwincpuidCmd):	a common chip, and hence,
* win/tclWinTime.c (Tcl_GetTime):	presumably, a common clock.  This
change necessitated a small burst of assembly code to read CPU ID
information, which was added as TclWinCPUID in the internal Stubs.  To
test this code in the common case of a single-processor machine, a
'testwincpuid' command was added to tclWinTest.c, and a test case in
platform.test.  Thanks to Jeff Godfrey and Richard Suchenwirth for
reporting this bug. [Bug #976722]


FossilOrigin-Name: a45bf99c8eb11742f802731d5583009c4b6f5e28

3 files changed, 245 insertions, 4 deletions

diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index 2e3368c..4cfd944 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWin32Dll.c,v 1.24.2.2 2004/05/06 01:04:32 davygrvy Exp $
+ * RCS: @(#) $Id: tclWin32Dll.c,v 1.24.2.3 2004/06/05 17:25:40 kennykb Exp $
  */
 
 #include "tclWinInt.h"
@@ -946,3 +946,152 @@ Tcl_WinTCharToUtf(string, len, dsPtr)
     return Tcl_ExternalToUtfDString(tclWinTCharEncoding, 
 	    (CONST char *) string, len, dsPtr);
 }
+
+/*
+ *------------------------------------------------------------------------
+ *
+ * TclWinCPUID --
+ *
+ *	Get CPU ID information on an Intel box under Windows
+ *
+ * Results:
+ *	Returns TCL_OK if successful, TCL_ERROR if CPUID is not
+ *	supported or fails.
+ *
+ * Side effects:
+ *	If successful, stores EAX, EBX, ECX and EDX registers after 
+ *      the CPUID instruction in the four integers designated by 'regsPtr'
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclWinCPUID( unsigned int index, /* Which CPUID value to retrieve */
+	     register unsigned int * regsPtr ) /* Registers after the CPUID */
+{
+
+    int status = TCL_ERROR;
+
+#if defined(__GNUC__)
+
+    /* Establish structured exception handling */
+
+# ifdef HAVE_NO_SEH
+    __asm__ __volatile__ (
+	"pushl %ebp" "\n\t"
+	"pushl $__except_TclWinCPUID_detach_handler" "\n\t"
+	"pushl %fs:0" "\n\t"
+	"movl %esp, %fs:0" );
+#  else
+    __try {
+#  endif
+
+	/* 
+	 * Execute the CPUID instruction with the given index, and
+	 * store results off 'regPtr'.
+	 */
+
+	__asm__ __volatile__ (
+	    "movl %4, %%eax" "\n\t"
+            "cpuid" "\n\t"
+	    "movl %%eax, %0" "\n\t"
+	    "movl %%ebx, %1" "\n\t"
+	    "movl %%ecx, %2" "\n\t"
+	    "movl %%edx, %3"
+	    : 
+	    "=m"(regsPtr[0]),
+	    "=m"(regsPtr[1]),
+	    "=m"(regsPtr[2]),
+	    "=m"(regsPtr[3])
+	    : "m"(index)
+	    : "%eax", "%ebx", "%ecx", "%edx" );
+	status = TCL_OK;
+
+	/* End the structured exception handler */
+
+#  ifndef HAVE_NO_SEH
+    } __except( EXCEPTION_EXECUTE_HANDLER ) {
+	/* do nothing */
+    }
+#  else
+    __asm __volatile__ (
+	    "jmp  TclWinCPUID_detach_pop" "\n"
+        "TclWinCPUID_detach_reentry:" "\n\t"
+	    "movl %%fs:0, %%eax" "\n\t"
+	    "movl 0x8(%%eax), %%esp" "\n\t"
+	    "movl 0x8(%%esp), %%ebp" "\n"
+	"TclWinCPUID_detach_pop:" "\n\t"
+	    "movl (%%esp), %%eax" "\n\t"
+	    "movl %%eax, %%fs:0" "\n\t"
+	    "add  $12, %%esp" "\n\t"
+	:
+	:
+	: "%eax");
+#  endif
+
+
+#elif defined(_MSC_VER)
+
+    /* Define a structure in the stack frame to hold the registers */
+
+    struct {
+	DWORD dw0;
+	DWORD dw1;
+	DWORD dw2;
+	DWORD dw3;
+    } regs;
+    regs.dw0 = index;
+    
+    /* Execute the CPUID instruction and save regs in the stack frame */
+
+    _try {
+	_asm {
+	    push    ebx
+	    push    ecx
+	    push    edx
+	    mov     eax, regs.dw0
+            cpuid
+	    mov     regs.dw0, eax
+	    mov     regs.dw1, ebx
+	    mov     regs.dw2, ecx
+	    mov     regs.dw3, edx
+            pop     edx
+            pop     ecx
+            pop     ebx
+	}
+	
+	/* Copy regs back out to the caller */
+
+	regsPtr[0]=regs.dw0;
+	regsPtr[1]=regs.dw1;
+	regsPtr[2]=regs.dw2;
+	regsPtr[3]=regs.dw3;
+
+	status = TCL_OK;
+    } __except( EXCEPTION_EXECUTE_HANDLER ) {
+    }
+
+#else
+				/* Don't know how to do assembly code for
+				 * this compiler */
+#endif
+    return status;
+}
+
+#if defined( __GNUC__ ) && defined( HAVE_NO_SEH )
+static __attribute__((cdecl)) EXCEPTION_DISPOSITION
+_except_TclWinCPUID_detach_handler(
+    struct _EXCEPTION_RECORD *ExceptionRecord,
+    void *EstablisherFrame,
+    struct _CONTEXT *ContextRecord,
+    void *DispatcherContext)
+{
+    __asm__ __volatile__ (
+	"jmp TclWinCPUID_detach_reentry" );
+    /* Nuke compiler warning about unused static function */
+    _except_TclWinCPUID_detach_handler(NULL, NULL, NULL, NULL);
+    return 0; /* Function does not return */
+}
+#endif
+
+
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index 96b1a28..f4e701e 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinTest.c,v 1.8.2.1 2003/04/12 20:11:34 kennykb Exp $
+ * RCS: @(#) $Id: tclWinTest.c,v 1.8.2.2 2004/06/05 17:25:40 kennykb Exp $
  */
 
 #define USE_COMPAT_CONST
@@ -32,6 +32,10 @@ static int      TestwinsleepCmd _ANSI_ARGS_(( ClientData dummy,
 					      int objc,
 					      Tcl_Obj *CONST objv[] ));
 static Tcl_ObjCmdProc TestExceptionCmd;
+static int	TestwincpuidCmd _ANSI_ARGS_(( ClientData dummy,
+					      Tcl_Interp* interp,
+					      int objc,
+					      Tcl_Obj *CONST objv[] ));
 
 
 /*
@@ -65,6 +69,8 @@ TclplatformtestInit(interp)
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd,
             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+    Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd,
+			 (ClientData) 0, (Tcl_CmdDeleteProc*) NULL );
     Tcl_CreateObjCommand( interp,
 			  "testwinsleep",
 			  TestwinsleepCmd,
@@ -290,7 +296,63 @@ TestwinclockCmd( ClientData dummy,
 /*
  *----------------------------------------------------------------------
  *
- * Testwinsleepcmd --
+ * TestwincpuidCmd --
+ *
+ *	Retrieves CPU ID information.
+ *
+ * Usage:
+ *	testwincpuid <eax>
+ *
+ * Parameters:
+ *	eax - The value to pass in the EAX register to a CPUID instruction.
+ *
+ * Results:
+ *	Returns a four-element list containing the values from the
+ *	EAX, EBX, ECX and EDX registers returned from the CPUID instruction.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestwincpuidCmd( ClientData dummy,
+		 Tcl_Interp* interp, /* Tcl interpreter */
+		 int objc,	/* Parameter count */
+		 Tcl_Obj *CONST * objv ) /* Parameter vector */
+{
+    int status;
+    int index;
+    unsigned int regs[4];
+    Tcl_Obj * regsObjs[4];
+    int i;
+
+    if ( objc != 2 ) {
+	Tcl_WrongNumArgs( interp, 1, objv, "eax" );
+	return TCL_ERROR;
+    }
+    if ( Tcl_GetIntFromObj( interp, objv[1], &index ) != TCL_OK ) {
+	return TCL_ERROR;
+    }
+    status = TclWinCPUID( (unsigned int) index, regs );
+    if ( status != TCL_OK ) {
+	Tcl_SetObjResult( interp, Tcl_NewStringObj( "operation not available", 
+						    -1 ) );
+	return status;
+    }
+    for ( i = 0; i < 4; ++i ) {
+	regsObjs[i] = Tcl_NewIntObj( (int) regs[i] );
+    }
+    Tcl_SetObjResult( interp, Tcl_NewListObj( 4, regsObjs ) );
+    return TCL_OK;
+       
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestwinsleepCmd --
  *
  *	Causes this process to wait for the given number of milliseconds
  *	by means of a direct call to Sleep.
diff --git a/win/tclWinTime.c b/win/tclWinTime.c
index faa7a3c..f428d52 100644
--- a/win/tclWinTime.c
+++ b/win/tclWinTime.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinTime.c,v 1.14.2.4 2004/05/17 14:26:50 kennykb Exp $
+ * RCS: @(#) $Id: tclWinTime.c,v 1.14.2.5 2004/06/05 17:25:40 kennykb Exp $
  */
 
 #include "tclWinInt.h"
@@ -311,9 +311,39 @@ Tcl_GetTime(timePtr)
 		  * && timeInfo.nominalFreq.QuadPart != (Tcl_WideInt) 3579545
 		  */
 		 && timeInfo.nominalFreq.QuadPart > (Tcl_WideInt) 15000000 ) {
+
+		/*
+		 * As an exception, if every logical processor on the system
+		 * is on the same chip, we use the performance counter anyway,
+		 * presuming that everyone's TSC is locked to the same
+		 * oscillator.
+		 */
+
+		SYSTEM_INFO systemInfo;
+		unsigned int regs[4];
+		GetSystemInfo( &systemInfo );
+		if ( TclWinCPUID( 0, regs ) == TCL_OK
+
+		     && regs[1] == 0x756e6547 /* "Genu" */
+		     && regs[3] == 0x49656e69 /* "ineI" */
+		     && regs[2] == 0x6c65746e /* "ntel" */
+
+		     && TclWinCPUID( 1, regs ) == TCL_OK 
+
+		     && ( (regs[0] & 0x00000F00) == 0x00000F00 /* Pentium 4 */
+			  || ( (regs[0] & 0x00F00000)    /* Extended family */
+			       && (regs[3] & 0x10000000) ) ) /* Hyperthread */
+		     && ( ( ( regs[1] & 0x00FF0000 ) >> 16 ) /* CPU count */
+			  == systemInfo.dwNumberOfProcessors ) 
+
+		    ) {
+		    timeInfo.perfCounterAvailable = TRUE;
+		} else {
 		timeInfo.perfCounterAvailable = FALSE;
 	    }
 
+	    }
+
 	    /*
 	     * If the performance counter is available, start a thread to
 	     * calibrate it.