summaryrefslogtreecommitdiffstats
path: root/win/tclWinTest.c
diff options
context:
space:
mode:
authorKevin B Kenny <kennykb@acm.org>2004-06-05 17:31:08 (GMT)
committerKevin B Kenny <kennykb@acm.org>2004-06-05 17:31:08 (GMT)
commiteab8709992e59240799ae71ebdd5b6e48bc9d5c0 (patch)
tree41f21e9ad830c0964087f8b4d6b564c1f631d6ca /win/tclWinTest.c
parent9baeae995f31e23bd116f478c93131015e25e069 (diff)
downloadtcl-eab8709992e59240799ae71ebdd5b6e48bc9d5c0.zip
tcl-eab8709992e59240799ae71ebdd5b6e48bc9d5c0.tar.gz
tcl-eab8709992e59240799ae71ebdd5b6e48bc9d5c0.tar.bz2
* generic/tcl.h: Corrected Tcl_WideInt declarations so that the mingw
build works again. * generic/tclDecls.h: Changes to the tests for * generic/tclInt.decls: clock frequency in * generic/tclIntDecls.h: Tcl_WinTime * generic/tclIntPlatDecls.h: so that any clock frequency * generic/tclPlatDecls.h: is accepted provided that * generic/tclStubInit.c: all CPU's in the system share * tests/platform.test (platform-1.3): a common chip, and hence, * win/tclWin32Dll.c (TclWinCPUID): presumably, a common clock. * win/tclWinTest.c (TestwincpuidCmd) This change necessitated a * win/tclWinTime.c (Tcl_GetTime): 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]
Diffstat (limited to 'win/tclWinTest.c')
-rw-r--r--win/tclWinTest.c66
1 files changed, 64 insertions, 2 deletions
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index ede007d..a5af926 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.10 2004/04/06 22:25:58 dgp Exp $
+ * RCS: @(#) $Id: tclWinTest.c,v 1.11 2004/06/05 17:31:08 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.