diff options
-rw-r--r-- | ChangeLog | 9 | ||||
-rw-r--r-- | generic/tcl.decls | 4 | ||||
-rw-r--r-- | generic/tclInt.decls | 10 | ||||
-rw-r--r-- | generic/tclIntPlatDecls.h | 75 | ||||
-rw-r--r-- | generic/tclPlatDecls.h | 54 | ||||
-rw-r--r-- | generic/tclStubInit.c | 81 | ||||
-rw-r--r-- | tools/genStubs.tcl | 77 | ||||
-rw-r--r-- | unix/tclUnixCompat.c | 39 |
8 files changed, 272 insertions, 77 deletions
@@ -1,3 +1,12 @@ +2012-03-20 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tcl.decls: [Bug 3508771] load tclreg.dll in cygwin tclsh + * generic/tclInt.decls: Implement TclWinGetPlatformId, Tcl_WinUtfToTChar, + * generic/tclIntPlatDecls.h: Tcl_WinTCharToUtf (and a dummy TclWinCPUID) for + * generic/tclPlatDecls.h: Cygwin, so win32 extensions using those can be + * generic/tclStubInit.c: loaded in the cygwin version of tclsh. + * unix/tclUnixCompat.c: + 2012-03-12 Jan Nijtmans <nijtmans@users.sf.net> * win/tclWinFile.c: [Bug 3388350] mingw64 compiler warnings diff --git a/generic/tcl.decls b/generic/tcl.decls index 4ebaea5..a2fb082 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -1862,14 +1862,14 @@ declare 8 mac { # Mac OS X declarations # -declare 0 macosx { +declare 0 unix { int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp, CONST char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath) } -declare 1 macosx { +declare 1 unix { int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp, CONST char *bundleName, CONST char *bundleVersion, diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 4fb88c6..269cd81 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -982,8 +982,9 @@ declare 8 unix { # Added in 8.1: +# On non-cygwin, this is actually a reference to TclpCreateTempFile declare 9 unix { - TclFile TclpCreateTempFile(CONST char *contents) + int TclWinGetPlatformId(void) } # Added in 8.4: @@ -1007,3 +1008,10 @@ declare 13 unix { char * TclpInetNtoa(struct in_addr addr) } +declare 22 unix { + TclFile TclpCreateTempFile(CONST char *contents) +} +declare 29 unix { + int TclWinCPUID(unsigned int index, unsigned int *regs) +} + diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index 35bacf1..ec474d4 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -55,8 +55,7 @@ EXTERN TclFile TclpOpenFile _ANSI_ARGS_((CONST char * fname, EXTERN int TclUnixWaitForFile _ANSI_ARGS_((int fd, int mask, int timeout)); /* 9 */ -EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_(( - CONST char * contents)); +EXTERN int TclWinGetPlatformId _ANSI_ARGS_((void)); /* 10 */ EXTERN Tcl_DirEntry * TclpReaddir _ANSI_ARGS_((DIR * dir)); /* 11 */ @@ -66,6 +65,26 @@ EXTERN struct tm * TclpLocaltime_unix _ANSI_ARGS_(( EXTERN struct tm * TclpGmtime_unix _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 13 */ EXTERN char * TclpInetNtoa _ANSI_ARGS_((struct in_addr addr)); +/* Slot 14 is reserved */ +/* Slot 15 is reserved */ +/* Slot 16 is reserved */ +/* Slot 17 is reserved */ +/* Slot 18 is reserved */ +/* Slot 19 is reserved */ +/* Slot 20 is reserved */ +/* Slot 21 is reserved */ +/* 22 */ +EXTERN TclFile TclpCreateTempFile _ANSI_ARGS_(( + CONST char * contents)); +/* Slot 23 is reserved */ +/* Slot 24 is reserved */ +/* Slot 25 is reserved */ +/* Slot 26 is reserved */ +/* Slot 27 is reserved */ +/* Slot 28 is reserved */ +/* 29 */ +EXTERN int TclWinCPUID _ANSI_ARGS_((unsigned int index, + unsigned int * regs)); #endif /* UNIX */ #ifdef __WIN32__ /* 0 */ @@ -229,11 +248,27 @@ typedef struct TclIntPlatStubs { TclFile (*tclpMakeFile) _ANSI_ARGS_((Tcl_Channel channel, int direction)); /* 6 */ TclFile (*tclpOpenFile) _ANSI_ARGS_((CONST char * fname, int mode)); /* 7 */ int (*tclUnixWaitForFile) _ANSI_ARGS_((int fd, int mask, int timeout)); /* 8 */ - TclFile (*tclpCreateTempFile) _ANSI_ARGS_((CONST char * contents)); /* 9 */ + int (*tclWinGetPlatformId) _ANSI_ARGS_((void)); /* 9 */ Tcl_DirEntry * (*tclpReaddir) _ANSI_ARGS_((DIR * dir)); /* 10 */ struct tm * (*tclpLocaltime_unix) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 11 */ struct tm * (*tclpGmtime_unix) _ANSI_ARGS_((TclpTime_t_CONST clock)); /* 12 */ char * (*tclpInetNtoa) _ANSI_ARGS_((struct in_addr addr)); /* 13 */ + void *reserved14; + void *reserved15; + void *reserved16; + void *reserved17; + void *reserved18; + void *reserved19; + void *reserved20; + void *reserved21; + TclFile (*tclpCreateTempFile) _ANSI_ARGS_((CONST char * contents)); /* 22 */ + void *reserved23; + void *reserved24; + void *reserved25; + void *reserved26; + void *reserved27; + void *reserved28; + int (*tclWinCPUID) _ANSI_ARGS_((unsigned int index, unsigned int * regs)); /* 29 */ #endif /* UNIX */ #ifdef __WIN32__ void (*tclWinConvertError) _ANSI_ARGS_((DWORD errCode)); /* 0 */ @@ -346,9 +381,9 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclUnixWaitForFile \ (tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */ #endif -#ifndef TclpCreateTempFile -#define TclpCreateTempFile \ - (tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */ +#ifndef TclWinGetPlatformId +#define TclWinGetPlatformId \ + (tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */ #endif #ifndef TclpReaddir #define TclpReaddir \ @@ -366,6 +401,28 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #define TclpInetNtoa \ (tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */ #endif +/* Slot 14 is reserved */ +/* Slot 15 is reserved */ +/* Slot 16 is reserved */ +/* Slot 17 is reserved */ +/* Slot 18 is reserved */ +/* Slot 19 is reserved */ +/* Slot 20 is reserved */ +/* Slot 21 is reserved */ +#ifndef TclpCreateTempFile +#define TclpCreateTempFile \ + (tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */ +#endif +/* Slot 23 is reserved */ +/* Slot 24 is reserved */ +/* Slot 25 is reserved */ +/* Slot 26 is reserved */ +/* Slot 27 is reserved */ +/* Slot 28 is reserved */ +#ifndef TclWinCPUID +#define TclWinCPUID \ + (tclIntPlatStubsPtr->tclWinCPUID) /* 29 */ +#endif #endif /* UNIX */ #ifdef __WIN32__ #ifndef TclWinConvertError @@ -592,4 +649,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr; #undef TclpLocaltime_unix #undef TclpGmtime_unix +#if !defined(__WIN32__) && !defined(MAC_TCL) && !defined(__CYGWIN__) && defined(USE_TCL_STUBS) +#undef TclpCreateTempFile +#define TclpCreateTempFile \ + ((TclFile (*)_ANSI_ARGS_((CONST char *))) tclIntPlatStubsPtr->tclWinGetPlatformId) +#endif + #endif /* _TCLINTPLATDECLS */ diff --git a/generic/tclPlatDecls.h b/generic/tclPlatDecls.h index c6fad72..0760250 100644 --- a/generic/tclPlatDecls.h +++ b/generic/tclPlatDecls.h @@ -34,6 +34,19 @@ * Exported function declarations: */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ +/* 0 */ +EXTERN int Tcl_MacOSXOpenBundleResources _ANSI_ARGS_(( + Tcl_Interp * interp, CONST char * bundleName, + int hasResourceFile, int maxPathLen, + char * libraryPath)); +/* 1 */ +EXTERN int Tcl_MacOSXOpenVersionedBundleResources _ANSI_ARGS_(( + Tcl_Interp * interp, CONST char * bundleName, + CONST char * bundleVersion, + int hasResourceFile, int maxPathLen, + char * libraryPath)); +#endif /* UNIX */ #ifdef __WIN32__ /* 0 */ EXTERN TCHAR * Tcl_WinUtfToTChar _ANSI_ARGS_((CONST char * str, @@ -74,24 +87,15 @@ EXTERN int strncasecmp _ANSI_ARGS_((CONST char * s1, EXTERN int strcasecmp _ANSI_ARGS_((CONST char * s1, CONST char * s2)); #endif /* MAC_TCL */ -#ifdef MAC_OSX_TCL -/* 0 */ -EXTERN int Tcl_MacOSXOpenBundleResources _ANSI_ARGS_(( - Tcl_Interp * interp, CONST char * bundleName, - int hasResourceFile, int maxPathLen, - char * libraryPath)); -/* 1 */ -EXTERN int Tcl_MacOSXOpenVersionedBundleResources _ANSI_ARGS_(( - Tcl_Interp * interp, CONST char * bundleName, - CONST char * bundleVersion, - int hasResourceFile, int maxPathLen, - char * libraryPath)); -#endif /* MAC_OSX_TCL */ typedef struct TclPlatStubs { int magic; struct TclPlatStubHooks *hooks; +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + int (*tcl_MacOSXOpenBundleResources) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * bundleName, int hasResourceFile, int maxPathLen, char * libraryPath)); /* 0 */ + int (*tcl_MacOSXOpenVersionedBundleResources) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * bundleName, CONST char * bundleVersion, int hasResourceFile, int maxPathLen, char * libraryPath)); /* 1 */ +#endif /* UNIX */ #ifdef __WIN32__ TCHAR * (*tcl_WinUtfToTChar) _ANSI_ARGS_((CONST char * str, int len, Tcl_DString * dsPtr)); /* 0 */ char * (*tcl_WinTCharToUtf) _ANSI_ARGS_((CONST TCHAR * str, int len, Tcl_DString * dsPtr)); /* 1 */ @@ -107,10 +111,6 @@ typedef struct TclPlatStubs { int (*strncasecmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2, size_t n)); /* 7 */ int (*strcasecmp) _ANSI_ARGS_((CONST char * s1, CONST char * s2)); /* 8 */ #endif /* MAC_TCL */ -#ifdef MAC_OSX_TCL - int (*tcl_MacOSXOpenBundleResources) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * bundleName, int hasResourceFile, int maxPathLen, char * libraryPath)); /* 0 */ - int (*tcl_MacOSXOpenVersionedBundleResources) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * bundleName, CONST char * bundleVersion, int hasResourceFile, int maxPathLen, char * libraryPath)); /* 1 */ -#endif /* MAC_OSX_TCL */ } TclPlatStubs; #ifdef __cplusplus @@ -127,6 +127,16 @@ extern TclPlatStubs *tclPlatStubsPtr; * Inline function declarations: */ +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ +#ifndef Tcl_MacOSXOpenBundleResources +#define Tcl_MacOSXOpenBundleResources \ + (tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */ +#endif +#ifndef Tcl_MacOSXOpenVersionedBundleResources +#define Tcl_MacOSXOpenVersionedBundleResources \ + (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ +#endif +#endif /* UNIX */ #ifdef __WIN32__ #ifndef Tcl_WinUtfToTChar #define Tcl_WinUtfToTChar \ @@ -175,16 +185,6 @@ extern TclPlatStubs *tclPlatStubsPtr; (tclPlatStubsPtr->strcasecmp) /* 8 */ #endif #endif /* MAC_TCL */ -#ifdef MAC_OSX_TCL -#ifndef Tcl_MacOSXOpenBundleResources -#define Tcl_MacOSXOpenBundleResources \ - (tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */ -#endif -#ifndef Tcl_MacOSXOpenVersionedBundleResources -#define Tcl_MacOSXOpenVersionedBundleResources \ - (tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */ -#endif -#endif /* MAC_OSX_TCL */ #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index a81f3e8..6493b4e 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -57,6 +57,61 @@ Tcl_NotifierProcs tclOriginalNotifier = { NULL }; +#ifdef __CYGWIN__ + +#define TclWinGetPlatformId winGetPlatformId +#define Tcl_WinUtfToTChar winUtfToTChar +#define Tcl_WinTCharToUtf winTCharToUtf + +static Tcl_Encoding winTCharEncoding; + +static int +TclWinGetPlatformId() +{ + /* Don't bother to determine the real platform on cygwin, + * because VER_PLATFORM_WIN32_NT is the only supported platform */ + return 2; /* VER_PLATFORM_WIN32_NT */; +} + +static char * +Tcl_WinUtfToTChar(string, len, dsPtr) + CONST char *string; + int len; + Tcl_DString *dsPtr; +{ + if (!winTCharEncoding) { + winTCharEncoding = Tcl_GetEncoding(NULL, "unicode"); + } + return Tcl_UtfToExternalDString(winTCharEncoding, + string, len, dsPtr); +} + +char * +Tcl_WinTCharToUtf(string, len, dsPtr) + CONST char *string; + int len; + Tcl_DString *dsPtr; +{ + if (!winTCharEncoding) { + winTCharEncoding = Tcl_GetEncoding(NULL, "unicode"); + } + return Tcl_ExternalToUtfDString(winTCharEncoding, + string, len, dsPtr); +} + +#define Tcl_MacOSXOpenBundleResources (int (*) _ANSI_ARGS_(( \ + Tcl_Interp *, CONST char *, int, int, char *))) Tcl_WinUtfToTChar +#define Tcl_MacOSXOpenVersionedBundleResources (int (*) _ANSI_ARGS_(( \ + Tcl_Interp *, CONST char *, CONST char *, int, int, char *))) Tcl_WinTCharToUtf + +#elif !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ +# define TclWinGetPlatformId (int (*)()) TclpCreateTempFile +# ifndef MAC_OSX_TCL +# define Tcl_MacOSXOpenBundleResources 0 +# define Tcl_MacOSXOpenVersionedBundleResources 0 +# endif +#endif + /* * WARNING: The contents of this file is automatically generated by the * tools/genStubs.tcl script. Any modifications to the function declarations @@ -307,11 +362,27 @@ TclIntPlatStubs tclIntPlatStubs = { TclpMakeFile, /* 6 */ TclpOpenFile, /* 7 */ TclUnixWaitForFile, /* 8 */ - TclpCreateTempFile, /* 9 */ + TclWinGetPlatformId, /* 9 */ TclpReaddir, /* 10 */ TclpLocaltime_unix, /* 11 */ TclpGmtime_unix, /* 12 */ TclpInetNtoa, /* 13 */ + NULL, /* 14 */ + NULL, /* 15 */ + NULL, /* 16 */ + NULL, /* 17 */ + NULL, /* 18 */ + NULL, /* 19 */ + NULL, /* 20 */ + NULL, /* 21 */ + TclpCreateTempFile, /* 22 */ + NULL, /* 23 */ + NULL, /* 24 */ + NULL, /* 25 */ + NULL, /* 26 */ + NULL, /* 27 */ + NULL, /* 28 */ + TclWinCPUID, /* 29 */ #endif /* UNIX */ #ifdef __WIN32__ TclWinConvertError, /* 0 */ @@ -379,6 +450,10 @@ TclIntPlatStubs tclIntPlatStubs = { TclPlatStubs tclPlatStubs = { TCL_STUB_MAGIC, NULL, +#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ + Tcl_MacOSXOpenBundleResources, /* 0 */ + Tcl_MacOSXOpenVersionedBundleResources, /* 1 */ +#endif /* UNIX */ #ifdef __WIN32__ Tcl_WinUtfToTChar, /* 0 */ Tcl_WinTCharToUtf, /* 1 */ @@ -394,10 +469,6 @@ TclPlatStubs tclPlatStubs = { strncasecmp, /* 7 */ strcasecmp, /* 8 */ #endif /* MAC_TCL */ -#ifdef MAC_OSX_TCL - Tcl_MacOSXOpenBundleResources, /* 0 */ - Tcl_MacOSXOpenVersionedBundleResources, /* 1 */ -#endif /* MAC_OSX_TCL */ }; static TclStubHooks tclStubHooks = { diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 8e8cbfd..5e86b69 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -1,8 +1,8 @@ # genStubs.tcl -- # # This script generates a set of stub files for a given -# interface. -# +# interface. +# # # Copyright (c) 1998-1999 by Scriptics Corporation. # See the file "license.terms" for information on usage and redistribution @@ -14,7 +14,7 @@ namespace eval genStubs { # libraryName -- # # The name of the entire library. This value is used to compute - # the USE_*_STUB_PROCS macro and the name of the init file. + # the USE_*_STUBS macro and the name of the init file. variable libraryName "UNKNOWN" @@ -131,10 +131,15 @@ proc genStubs::declare {args} { variable stubs variable curName - if {[llength $args] != 3} { + if {[llength $args] == 2} { + lassign $args index decl + set platformList generic + } elseif {[llength $args] == 3} { + lassign $args index platformList decl + } else { puts stderr "wrong # args: declare $args" + return } - lassign $args index platformList decl # Check for duplicate declarations, then add the declaration and # bump the lastNum counter if necessary. @@ -179,6 +184,7 @@ proc genStubs::rewriteFile {file text} { } set in [open ${file} r] set out [open ${file}.new w] + fconfigure $out -translation lf while {![eof $in]} { set line [gets $in] @@ -251,7 +257,6 @@ proc genStubs::addPlatformGuard {plat text} { # None. proc genStubs::emitSlots {name textVar} { - variable stubs upvar $textVar text forAllStubs $name makeSlot 1 text {" void *reserved$i;\n"} @@ -379,11 +384,14 @@ proc genStubs::makeDecl {name decl index} { foreach arg $args { append line $sep set next {} - append next [lindex $arg 0] " " [lindex $arg 1] \ - [lindex $arg 2] + append next [lindex $arg 0] + if {[string index $next end] ne "*"} { + append next " " + } + append next [lindex $arg 1] [lindex $arg 2] if {[string length $line] + [string length $next] \ + $pad > 76} { - append text $line \n + append text [string trimright $line] \n set line "\t\t\t\t" set pad 28 } @@ -393,10 +401,7 @@ proc genStubs::makeDecl {name decl index} { append line ")" } } - append text $line - - append text ");\n" - return $text + return "$text$line);\n" } # genStubs::makeMacro -- @@ -538,14 +543,17 @@ proc genStubs::makeSlot {name decl index} { default { set sep "(" foreach arg $args { - append text $sep [lindex $arg 0] " " [lindex $arg 1] \ - [lindex $arg 2] + append text $sep [lindex $arg 0] + if {[string index $text end] ne "*"} { + append text " " + } + append text [lindex $arg 1] [lindex $arg 2] set sep ", " } append text ")" } } - + append text "); /* $index */\n" return $text } @@ -588,7 +596,7 @@ proc genStubs::makeInit {name decl index} { # Results: # None. -proc genStubs::forAllStubs {name slotProc onAll textVar \ +proc genStubs::forAllStubs {name slotProc onAll textVar {skipString {"/* Slot $i is reserved */\n"}}} { variable stubs upvar $textVar text @@ -607,7 +615,8 @@ proc genStubs::forAllStubs {name slotProc onAll textVar \ set emit 0 if {[info exists stubs($name,generic,$i)]} { if {[llength $slots] > 1} { - puts stderr "platform entry duplicates generic entry: $i" + puts stderr "conflicting generic and platform entries:\ + $name $i" } append text [$slotProc $name $stubs($name,generic,$i) $i] set emit 1 @@ -706,10 +715,10 @@ proc genStubs::forAllStubs {name slotProc onAll textVar \ eval {append temp} $skipString } else { append temp [$slotProc $name $stubs($name,x11,$i) $i] - } } - append text [addPlatformGuard x11 $temp] } + append text [addPlatformGuard x11 $temp] + } } } @@ -725,7 +734,6 @@ proc genStubs::forAllStubs {name slotProc onAll textVar \ # None. proc genStubs::emitDeclarations {name textVar} { - variable stubs upvar $textVar text append text "\n/*\n * Exported function declarations:\n */\n\n" @@ -745,14 +753,13 @@ proc genStubs::emitDeclarations {name textVar} { # None. proc genStubs::emitMacros {name textVar} { - variable stubs variable libraryName upvar $textVar text set upName [string toupper $libraryName] append text "\n#if defined(USE_${upName}_STUBS) && !defined(USE_${upName}_STUB_PROCS)\n" append text "\n/*\n * Inline function declarations:\n */\n\n" - + forAllStubs $name makeMacro 0 text append text "\n#endif /* defined(USE_${upName}_STUBS) && !defined(USE_${upName}_STUB_PROCS) */\n" @@ -794,9 +801,9 @@ proc genStubs::emitHeader {name} { emitSlots $name text - append text "} ${capName}Stubs;\n" + append text "} ${capName}Stubs;\n\n" - append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n" + append text "#ifdef __cplusplus\nextern \"C\" {\n#endif\n" append text "extern ${capName}Stubs *${name}StubsPtr;\n" append text "#ifdef __cplusplus\n}\n#endif\n" @@ -839,7 +846,6 @@ proc genStubs::emitStubs {name} { # Returns the formatted output. proc genStubs::emitInit {name textVar} { - variable stubs variable hooks upvar $textVar text @@ -847,7 +853,7 @@ proc genStubs::emitInit {name textVar} { append capName [string range $name 1 end] if {[info exists hooks($name)]} { - append text "\nstatic ${capName}StubHooks ${name}StubHooks = \{\n" + append text "\nstatic ${capName}StubHooks ${name}StubHooks = \{\n" set sep " " foreach sub $hooks($name) { append text $sep "&${sub}Stubs" @@ -862,7 +868,7 @@ proc genStubs::emitInit {name textVar} { } else { append text " NULL,\n" } - + forAllStubs $name makeInit 1 text {" NULL, /* $i */\n"} append text "\};\n" @@ -953,13 +959,14 @@ proc genStubs::init {} { # Results: # Returns any values that were not assigned to variables. -proc lassign {valueList args} { - if {[llength $args] == 0} { - error "wrong # args: lassign list varname ?varname..?" - } - - uplevel [list foreach $args $valueList {break}] - return [lrange $valueList [llength $args] end] +if {[string length [namespace which lassign]] == 0} { + proc lassign {valueList args} { + if {[llength $args] == 0} { + error "wrong # args: should be \"lassign list varName ?varName ...?\"" + } + uplevel [list foreach $args $valueList {break}] + return [lrange $valueList [llength $args] end] + } } genStubs::init diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index 42fb916..16e7a61 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -144,7 +144,7 @@ CopyArray(char **src, int elsize, char *buf, int buflen) static int -CopyString(char *src, char *buf, int buflen) +CopyString(CONST char *src, char *buf, int buflen) { int len = 0; @@ -666,3 +666,40 @@ TclpGetHostByAddr(const char *addr, int length, int type) return NULL; /* Not reached */ #endif /* TCL_THREADS */ } + +/* + *------------------------------------------------------------------------ + * + * TclWinCPUID -- + * + * Get CPU ID information on an Intel box under UNIX (either Linux or Cygwin) + * + * 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. */ + unsigned int *regsPtr) /* Registers after the CPUID. */ +{ + int status = TCL_ERROR; + + /* There is no reason this couldn't be implemented on UNIX as well */ + return status; +} + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |