diff options
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclIOSock.c | 2 | ||||
-rw-r--r-- | generic/tclStubInit.c | 6 | ||||
-rw-r--r-- | generic/tclTest.c | 65 |
3 files changed, 66 insertions, 7 deletions
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 7b7b647..538ca1d 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -87,7 +87,7 @@ TclSockGetPort( *---------------------------------------------------------------------- */ -#ifndef _WIN32 +#if !defined(_WIN32) && !defined(__CYGWIN__) # define SOCKET size_t #endif diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 545ef72..a74101d 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -54,12 +54,6 @@ static int TclSockMinimumBuffersOld(int sock, int size) #endif #ifdef __CYGWIN__ - -/* Trick, so we don't have to include <windows.h> here, which - * - b.t.w. - lacks this function anyway */ -#define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004 -int __stdcall GetModuleHandleExW(unsigned int, const char *, void *); - #define TclWinGetPlatformId winGetPlatformId #define Tcl_WinUtfToTChar winUtfToTChar #define Tcl_WinTCharToUtf winTCharToUtf diff --git a/generic/tclTest.c b/generic/tclTest.c index 7631dee..3f06be0 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -419,6 +419,11 @@ static int TestNRELevels(ClientData clientData, static int TestInterpResolverCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +#if defined(HAVE_CPUID) || defined(__WIN32__) +static int TestcpuidCmd(ClientData dummy, + Tcl_Interp* interp, int objc, + Tcl_Obj *CONST objv[]); +#endif static const Tcl_Filesystem testReportingFilesystem = { "reporting", @@ -676,6 +681,10 @@ Tcltest_Init( NULL, NULL); Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd, NULL, NULL); +#if defined(HAVE_CPUID) || defined(__WIN32__) + Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, + (ClientData) 0, NULL); +#endif t3ArgTypes[0] = TCL_EITHER; t3ArgTypes[1] = TCL_EITHER; Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2, @@ -6648,6 +6657,62 @@ TestNumUtfCharsCmd( } return TCL_OK; } + +#if defined(HAVE_CPUID) || defined(__WIN32__) +/* + *---------------------------------------------------------------------- + * + * TestcpuidCmd -- + * + * 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 +TestcpuidCmd( + ClientData dummy, + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const * objv) /* Parameter vector */ +{ + int status, index, i; + unsigned int regs[4]; + Tcl_Obj *regsObjs[4]; + + 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) 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; +} +#endif /* * Used to do basic checks of the TCL_HASH_KEY_SYSTEM_HASH flag |