summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog3
-rw-r--r--generic/tcl.decls2
-rw-r--r--generic/tclCkalloc.c9
-rw-r--r--generic/tclDecls.h4
-rw-r--r--generic/tclIOSock.c2
-rw-r--r--generic/tclInt.decls2
-rw-r--r--generic/tclIntDecls.h38
-rw-r--r--generic/tclStubInit.c14
-rw-r--r--generic/tclTest.c59
-rw-r--r--tests/platform.test10
-rwxr-xr-xunix/configure2
-rw-r--r--unix/configure.in2
-rw-r--r--unix/tclUnixCompat.c2
-rw-r--r--unix/tclUnixFile.c8
-rw-r--r--unix/tclUnixPort.h18
-rw-r--r--win/tclWinTest.c80
16 files changed, 92 insertions, 163 deletions
diff --git a/ChangeLog b/ChangeLog
index f516dae..142ad30 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -3,6 +3,9 @@
* generic/configure.in: Better detection and implementation for cpuid
* generic/configure: instruction on Intel-derived processors, both
* generic/tclUnixCompat.c: 32-bit and 64-bit.
+ * generic/tclTest.c: Move cpuid testcase from win-specific to generic
+ * win/tclWinTest.c: tests, as it should work on all Intel-related
+ * tests/platform.test: platforms now
2012-04-27 Jan Nijtmans <nijtmans@users.sf.net>
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 903669d..04ecce6 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -51,7 +51,7 @@ declare 6 {
char *Tcl_DbCkalloc(unsigned int size, const char *file, int line)
}
declare 7 {
- int Tcl_DbCkfree(char *ptr, const char *file, int line)
+ void Tcl_DbCkfree(char *ptr, const char *file, int line)
}
declare 8 {
char *Tcl_DbCkrealloc(char *ptr, unsigned int size,
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index c374ce5..5c0432d 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -583,7 +583,7 @@ Tcl_AttemptDbCkalloc(
*----------------------------------------------------------------------
*/
-int
+void
Tcl_DbCkfree(
char *ptr,
CONST char *file,
@@ -592,7 +592,7 @@ Tcl_DbCkfree(
struct mem_header *memp;
if (ptr == NULL) {
- return 0;
+ return;
}
/*
@@ -646,8 +646,6 @@ Tcl_DbCkfree(
}
TclpFree((char *) memp);
Tcl_MutexUnlock(ckallocMutexPtr);
-
- return 0;
}
/*
@@ -1219,14 +1217,13 @@ Tcl_Free(
TclpFree(ptr);
}
-int
+void
Tcl_DbCkfree(
char *ptr,
CONST char *file,
int line)
{
TclpFree(ptr);
- return 0;
}
/*
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 4517d01..2c5838d 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -78,7 +78,7 @@ EXTERN char * Tcl_DbCkalloc(unsigned int size, CONST char *file,
#ifndef Tcl_DbCkfree_TCL_DECLARED
#define Tcl_DbCkfree_TCL_DECLARED
/* 7 */
-EXTERN int Tcl_DbCkfree(char *ptr, CONST char *file, int line);
+EXTERN void Tcl_DbCkfree(char *ptr, CONST char *file, int line);
#endif
#ifndef Tcl_DbCkrealloc_TCL_DECLARED
#define Tcl_DbCkrealloc_TCL_DECLARED
@@ -3426,7 +3426,7 @@ typedef struct TclStubs {
void (*tcl_Free) (char *ptr); /* 4 */
char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */
char * (*tcl_DbCkalloc) (unsigned int size, CONST char *file, int line); /* 6 */
- int (*tcl_DbCkfree) (char *ptr, CONST char *file, int line); /* 7 */
+ void (*tcl_DbCkfree) (char *ptr, CONST char *file, int line); /* 7 */
char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, CONST char *file, int line); /* 8 */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index e259676..751241b 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -82,7 +82,7 @@ TclSockGetPort(
*/
#undef TclSockMinimumBuffers
-#ifndef _WIN32
+#if !defined(_WIN32) && !defined(__CYGWIN__)
# define SOCKET size_t
#endif
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 0ba4542..6dd7033 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -421,7 +421,7 @@ declare 103 {
declare 104 {
int TclSockMinimumBuffersOld(int sock, int size)
}
-declare 110 {unix win} {
+declare 110 {
int TclSockMinimumBuffers(void *sock, int size)
}
# Replaced by Tcl_FSStat in 8.4:
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 365f529..3ccc50a 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -456,27 +456,11 @@ EXTERN void TclTeardownNamespace(Namespace *nsPtr);
/* 109 */
EXTERN int TclUpdateReturnInfo(Interp *iPtr);
#endif
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#ifndef TclSockMinimumBuffers_TCL_DECLARED
#define TclSockMinimumBuffers_TCL_DECLARED
/* 110 */
EXTERN int TclSockMinimumBuffers(VOID *sock, int size);
#endif
-#endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
-#ifndef TclSockMinimumBuffers_TCL_DECLARED
-#define TclSockMinimumBuffers_TCL_DECLARED
-/* 110 */
-EXTERN int TclSockMinimumBuffers(VOID *sock, int size);
-#endif
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-#ifndef TclSockMinimumBuffers_TCL_DECLARED
-#define TclSockMinimumBuffers_TCL_DECLARED
-/* 110 */
-EXTERN int TclSockMinimumBuffers(VOID *sock, int size);
-#endif
-#endif /* MACOSX */
#ifndef Tcl_AddInterpResolvers_TCL_DECLARED
#define Tcl_AddInterpResolvers_TCL_DECLARED
/* 111 */
@@ -1184,15 +1168,7 @@ typedef struct TclIntStubs {
VOID *reserved107;
void (*tclTeardownNamespace) (Namespace *nsPtr); /* 108 */
int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
int (*tclSockMinimumBuffers) (VOID *sock, int size); /* 110 */
-#endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
- int (*tclSockMinimumBuffers) (VOID *sock, int size); /* 110 */
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
- int (*tclSockMinimumBuffers) (VOID *sock, int size); /* 110 */
-#endif /* MACOSX */
void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, CONST char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */
int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, CONST char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
@@ -1641,24 +1617,10 @@ extern TclIntStubs *tclIntStubsPtr;
#define TclUpdateReturnInfo \
(tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */
#endif
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
-#ifndef TclSockMinimumBuffers
-#define TclSockMinimumBuffers \
- (tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
-#endif
-#endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
-#ifndef TclSockMinimumBuffers
-#define TclSockMinimumBuffers \
- (tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
-#endif
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
#ifndef TclSockMinimumBuffers
#define TclSockMinimumBuffers \
(tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
#endif
-#endif /* MACOSX */
#ifndef Tcl_AddInterpResolvers
#define Tcl_AddInterpResolvers \
(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 2dc8c40..f400e7e 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -76,12 +76,6 @@ MODULE_SCOPE TclStubs tclStubs;
MODULE_SCOPE TclTomMathStubs tclTomMathStubs;
#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
@@ -353,15 +347,7 @@ TclIntStubs tclIntStubs = {
NULL, /* 107 */
TclTeardownNamespace, /* 108 */
TclUpdateReturnInfo, /* 109 */
-#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
- TclSockMinimumBuffers, /* 110 */
-#endif /* UNIX */
-#ifdef __WIN32__ /* WIN */
TclSockMinimumBuffers, /* 110 */
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
- TclSockMinimumBuffers, /* 110 */
-#endif /* MACOSX */
Tcl_AddInterpResolvers, /* 111 */
Tcl_AppendExportList, /* 112 */
Tcl_CreateNamespace, /* 113 */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 57c17e3..4a9f85f 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -444,6 +444,9 @@ static int TestNumUtfCharsCmd(ClientData clientData,
static int TestHashSystemHashCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+static int TestcpuidCmd (ClientData dummy,
+ Tcl_Interp* interp, int objc,
+ Tcl_Obj *CONST objv[]);
static Tcl_Filesystem testReportingFilesystem = {
"reporting",
@@ -707,6 +710,8 @@ Tcltest_Init(
(ClientData) NULL, NULL);
Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
(ClientData) NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
+ (ClientData) 0, NULL);
t3ArgTypes[0] = TCL_EITHER;
t3ArgTypes[1] = TCL_EITHER;
Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
@@ -7103,6 +7108,60 @@ TestNumUtfCharsCmd(
}
return TCL_OK;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
/*
* Used to do basic checks of the TCL_HASH_KEY_SYSTEM_HASH flag
diff --git a/tests/platform.test b/tests/platform.test
index 9d88f98..4f1eb82 100644
--- a/tests/platform.test
+++ b/tests/platform.test
@@ -14,7 +14,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
-testConstraint testWinCPUID [llength [info commands testwincpuid]]
+testConstraint testCPUID [llength [info commands testcpuid]]
test platform-1.1 {TclpSetVariables: tcl_platform} {
interp create i
@@ -36,12 +36,12 @@ test platform-2.1 {tcl_platform(wordSize) indicates size of native word} {
list [expr {$result < 0}] [expr {$result ^ int($result - 1)}]
} {1 -1}
-# On Windows, test that the CPU ID works
+# On Windows/UNIX, test that the CPU ID works
-test platform-3.1 {CPU ID on Windows } \
- -constraints testWinCPUID \
+test platform-3.1 {CPU ID on Windows/UNIX} \
+ -constraints testCPUID \
-body {
- set cpudata [testwincpuid 0]
+ set cpudata [testcpuid 0]
binary format iii \
[lindex $cpudata 1] \
[lindex $cpudata 3] \
diff --git a/unix/configure b/unix/configure
index 522828d..4b141b6 100755
--- a/unix/configure
+++ b/unix/configure
@@ -18931,7 +18931,7 @@ main ()
"mov %%ebx, %%esi \n\t"
"mov %%edi, %%ebx \n\t"
: "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
- : "a"(index));
+ : "a"(index) : "edi");
;
return 0;
diff --git a/unix/configure.in b/unix/configure.in
index aea5ee5..441c98f 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -737,7 +737,7 @@ AC_CACHE_CHECK([whether the cpuid instruction is usable], tcl_cv_cpuid, [
"mov %%ebx, %%esi \n\t"
"mov %%edi, %%ebx \n\t"
: "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
- : "a"(index));
+ : "a"(index) : "edi");
], tcl_cv_cpuid=yes, tcl_cv_cpuid=no)])
if test $tcl_cv_cpuid = yes; then
AC_DEFINE(HAVE_CPUID, 1, [Is the cpuid instruction usable?])
diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c
index d9d5052..f582c0c 100644
--- a/unix/tclUnixCompat.c
+++ b/unix/tclUnixCompat.c
@@ -826,7 +826,7 @@ TclWinCPUID(
"mov %%ebx, %%esi \n\t" /* save what cpuid just put in %ebx */
"mov %%edi, %%ebx \n\t" /* restore the old %ebx */
: "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
- : "a"(index));
+ : "a"(index) : "edi");
status = TCL_OK;
#endif
return status;
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index f428af7..edd0d2f 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -44,14 +44,6 @@ TclpFindExecutable(
int length;
char buf[PATH_MAX * TCL_UTF_MAX + 1];
char name[PATH_MAX * TCL_UTF_MAX + 1];
-
- /* Make some symbols available without including <windows.h> */
-# define CP_UTF8 65001
- DLLIMPORT extern int cygwin_conv_to_full_posix_path(const char *, char *);
- DLLIMPORT extern __stdcall int GetModuleFileNameW(void *, const char *, int);
- DLLIMPORT extern __stdcall int WideCharToMultiByte(int, int, const char *, int,
- const char *, int, const char *, const char *);
-
GetModuleFileNameW(NULL, name, PATH_MAX);
WideCharToMultiByte(CP_UTF8, 0, name, -1, buf, PATH_MAX, NULL, NULL);
cygwin_conv_to_full_posix_path(buf, name);
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index 33348e2..8b7fab1 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -74,12 +74,22 @@ typedef off_t Tcl_SeekOffset;
#endif
#ifdef __CYGWIN__
-# define WSAEWOULDBLOCK 10035
-# define HINSTANCE void *
-# define HANDLE void *
+
+ /* Make some symbols available without including <windows.h> */
# define DWORD unsigned int
+# define CP_UTF8 65001
+# define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004
+# define HANDLE void *
+# define HINSTANCE void *
# define SOCKET unsigned int
-# typedef char TCHAR;
+# define WSAEWOULDBLOCK 10035
+ typedef char TCHAR;
+ DLLIMPORT extern __stdcall int GetModuleHandleExW(unsigned int, const char *, void *);
+ DLLIMPORT extern __stdcall int GetModuleFileNameW(void *, const char *, int);
+ DLLIMPORT extern __stdcall int WideCharToMultiByte(int, int, const char *, int,
+ const char *, int, const char *, const char *);
+
+ DLLIMPORT extern int cygwin_conv_to_full_posix_path(const char *, char *);
# define USE_PUTENV 1
# define USE_PUTENV_FOR_UNSET 1
/* On Cygwin, the environment is imported from the Cygwin DLL. */
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index 34aea42..e493fbf 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -40,8 +40,6 @@ static int TestwinclockCmd(ClientData dummy, Tcl_Interp* interp,
static int TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp,
int objc, Tcl_Obj *const objv[]);
static Tcl_ObjCmdProc TestExceptionCmd;
-static int TestwincpuidCmd(ClientData dummy, Tcl_Interp* interp,
- int objc, Tcl_Obj *const objv[]);
static int TestplatformChmod(const char *nativePath, int pmode);
static int TestchmodCmd(ClientData dummy,
Tcl_Interp *interp, int argc, const char **argv);
@@ -76,7 +74,6 @@ TclplatformtestInit(
Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL);
- Tcl_CreateObjCommand(interp, "testwincpuid", TestwincpuidCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL);
return TCL_OK;
@@ -292,83 +289,6 @@ TestwinclockCmd(
return TCL_OK;
}
-/*
- *----------------------------------------------------------------------
- *
- * 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, 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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TestwinsleepCmd --
- *
- * Causes this process to wait for the given number of milliseconds by
- * means of a direct call to Sleep.
- *
- * Usage:
- * testwinsleep <n>
- *
- * Parameters:
- * n - the number of milliseconds to sleep
- *
- * Results:
- * None.
- *
- * Side effects:
- * Sleeps for the requisite number of milliseconds.
- *
- *----------------------------------------------------------------------
- */
-
static int
TestwinsleepCmd(
ClientData clientData, /* Unused */
generated by cgit v0.12 at 2024-07-05 00:03:28 (GMT)