summaryrefslogtreecommitdiffstats
path: root/generic/tclStubInit.c
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2018-10-28 19:36:34 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2018-10-28 19:36:34 (GMT)
commit1f6c360968fab22aa02a30a72c196a8f8eb19c0c (patch)
treec490d9cba824ba803b713fe06b6ccfb7f98caca3 /generic/tclStubInit.c
parent63b8d1466dca7693cf0f6b61d39fada6fd1e0e7f (diff)
parentccb97d88ffefe602e7eb5a9610bd356d66bc2f20 (diff)
downloadtcl-1f6c360968fab22aa02a30a72c196a8f8eb19c0c.zip
tcl-1f6c360968fab22aa02a30a72c196a8f8eb19c0c.tar.gz
tcl-1f6c360968fab22aa02a30a72c196a8f8eb19c0c.tar.bz2
Merge tip-468 branch
Diffstat (limited to 'generic/tclStubInit.c')
-rw-r--r--generic/tclStubInit.c228
1 files changed, 145 insertions, 83 deletions
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 8a6e367..330be74 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -12,6 +12,10 @@
#include "tclInt.h"
#include "tommath.h"
+#ifdef __CYGWIN__
+# include <wchar.h>
+#endif
+
#ifdef __GNUC__
#pragma GCC dependency "tcl.decls"
#pragma GCC dependency "tclInt.decls"
@@ -31,17 +35,21 @@
#undef Tcl_NewIntObj
#undef Tcl_NewListObj
#undef Tcl_NewLongObj
+#undef Tcl_DbNewLongObj
#undef Tcl_NewObj
#undef Tcl_NewStringObj
+#undef Tcl_GetUnicode
#undef Tcl_DumpActiveMemory
#undef Tcl_ValidateAllMemory
#undef Tcl_FindHashEntry
#undef Tcl_CreateHashEntry
#undef Tcl_Panic
#undef Tcl_FindExecutable
+#undef Tcl_SetPanicProc
#undef TclpGetPid
#undef TclSockMinimumBuffers
#undef Tcl_SetIntObj
+#undef Tcl_SetLongObj
#undef TclpInetNtoa
#undef TclWinGetServByName
#undef TclWinGetSockOpt
@@ -49,7 +57,7 @@
#undef TclWinNToHS
/* See bug 510001: TclSockMinimumBuffers needs plat imp */
-#if defined(_WIN64) || defined(TCL_NO_DEPRECATED)
+#if defined(_WIN64) || defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
# define TclSockMinimumBuffersOld 0
#else
#define TclSockMinimumBuffersOld sockMinimumBuffersOld
@@ -59,16 +67,31 @@ static int TclSockMinimumBuffersOld(int sock, int size)
}
#endif
-#if defined(TCL_NO_DEPRECATED)
+#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
# define TclSetStartupScriptPath 0
# define TclGetStartupScriptPath 0
# define TclSetStartupScriptFileName 0
# define TclGetStartupScriptFileName 0
+# define TclPrecTraceProc 0
# define TclpInetNtoa 0
# define TclWinGetServByName 0
# define TclWinGetSockOpt 0
# define TclWinSetSockOpt 0
# define TclWinNToHS 0
+# define TclWinGetPlatformId 0
+# define TclWinResetInterfaces 0
+# define TclWinSetInterfaces 0
+# define TclWinGetPlatformId 0
+# define TclBNInitBignumFromWideUInt 0
+# define TclBNInitBignumFromWideInt 0
+# define TclBNInitBignumFromLong 0
+# define Tcl_Backslash 0
+# define Tcl_GetDefaultEncodingDir 0
+# define Tcl_SetDefaultEncodingDir 0
+# define Tcl_EvalTokens 0
+# define Tcl_CreateMathFunc 0
+# define Tcl_GetMathFuncInfo 0
+# define Tcl_ListMathFuncs 0
#else
#define TclSetStartupScriptPath setStartupScriptPath
static void TclSetStartupScriptPath(Tcl_Obj *path)
@@ -95,14 +118,32 @@ static const char *TclGetStartupScriptFileName(void)
}
return Tcl_GetString(path);
}
-
#if defined(_WIN32) || defined(__CYGWIN__)
#undef TclWinNToHS
+#undef TclWinGetPlatformId
+#undef TclWinResetInterfaces
+#undef TclWinSetInterfaces
+static void
+doNothing(void)
+{
+ /* dummy implementation, no need to do anything */
+}
#define TclWinNToHS winNToHS
static unsigned short TclWinNToHS(unsigned short ns) {
return ntohs(ns);
}
+#define TclWinGetPlatformId winGetPlatformId
+static int
+TclWinGetPlatformId(void)
+{
+ return 2; /* VER_PLATFORM_WIN32_NT */;
+}
+#define TclWinResetInterfaces doNothing
+#define TclWinSetInterfaces (void (*) (int)) doNothing
#endif
+# define TclBNInitBignumFromWideUInt TclInitBignumFromWideUInt
+# define TclBNInitBignumFromWideInt TclInitBignumFromWideInt
+# define TclBNInitBignumFromLong TclInitBignumFromLong
#endif /* TCL_NO_DEPRECATED */
#ifdef _WIN32
@@ -113,12 +154,15 @@ static unsigned short TclWinNToHS(unsigned short ns) {
# define TclpIsAtty 0
#elif defined(__CYGWIN__)
# define TclpIsAtty TclPlatIsAtty
-# define TclWinSetInterfaces (void (*) (int)) doNothing
+#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
+static void
+doNothing(void)
+{
+ /* dummy implementation, no need to do anything */
+}
+#endif
# define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
# define TclWinFlushDirtyChannels doNothing
-# define TclWinResetInterfaces doNothing
-
-static Tcl_Encoding winTCharEncoding;
static int
TclpIsAtty(int fd)
@@ -126,23 +170,15 @@ TclpIsAtty(int fd)
return isatty(fd);
}
-#define TclWinGetPlatformId winGetPlatformId
-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 */;
-}
-
void *TclWinGetTclInstance()
{
void *hInstance = NULL;
GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
- (const char *)&winTCharEncoding, &hInstance);
+ (const char *)&TclpIsAtty, &hInstance);
return hInstance;
}
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#define TclWinSetSockOpt winSetSockOpt
static int
TclWinSetSockOpt(SOCKET s, int level, int optname,
@@ -165,6 +201,7 @@ TclWinGetServByName(const char *name, const char *proto)
{
return getservbyname(name, proto);
}
+#endif /* TCL_NO_DEPRECATED */
#define TclWinNoBackslash winNoBackslash
static char *
@@ -186,23 +223,17 @@ TclpGetPid(Tcl_Pid pid)
return (int) (size_t) pid;
}
-static void
-doNothing(void)
-{
- /* dummy implementation, no need to do anything */
-}
-
char *
Tcl_WinUtfToTChar(
const char *string,
int len,
Tcl_DString *dsPtr)
{
- if (!winTCharEncoding) {
- winTCharEncoding = Tcl_GetEncoding(0, "unicode");
+ Tcl_DStringInit(dsPtr);
+ if (!string) {
+ return NULL;
}
- return Tcl_UtfToExternalDString(winTCharEncoding,
- string, len, dsPtr);
+ return (char *)Tcl_UtfToUniCharDString(string, len, dsPtr);
}
char *
@@ -211,11 +242,16 @@ Tcl_WinTCharToUtf(
int len,
Tcl_DString *dsPtr)
{
- if (!winTCharEncoding) {
- winTCharEncoding = Tcl_GetEncoding(0, "unicode");
+ Tcl_DStringInit(dsPtr);
+ if (!string) {
+ return NULL;
}
- return Tcl_ExternalToUtfDString(winTCharEncoding,
- string, len, dsPtr);
+ if (len < 0) {
+ len = wcslen((wchar_t *)string);
+ } else {
+ len /= 2;
+ }
+ return Tcl_UniCharToUtfDString((Tcl_UniChar *)string, len, dsPtr);
}
#if defined(TCL_WIDE_INT_IS_LONG)
@@ -224,33 +260,11 @@ Tcl_WinTCharToUtf(
* signature. Tcl 9 must find a better solution, but that cannot be done
* without introducing a binary incompatibility.
*/
-#define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))dbNewLongObj)
-static Tcl_Obj *dbNewLongObj(
- int intValue,
- const char *file,
- int line
-) {
-#ifdef TCL_MEM_DEBUG
- register Tcl_Obj *objPtr;
-
- TclDbNewObj(objPtr, file, line);
- objPtr->bytes = NULL;
-
- objPtr->internalRep.longValue = (long) intValue;
- objPtr->typePtr = &tclIntType;
- return objPtr;
-#else
- return Tcl_NewIntObj(intValue);
-#endif
-}
-#define Tcl_GetLongFromObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetIntFromObj
-#define Tcl_NewLongObj (Tcl_Obj*(*)(long))Tcl_NewIntObj
-#define Tcl_SetLongObj (void(*)(Tcl_Obj*,long))Tcl_SetIntObj
static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
long longValue;
int result = Tcl_ExprLong(interp, expr, &longValue);
if (result == TCL_OK) {
- if ((longValue >= -(long)(UINT_MAX))
+ if ((longValue >= (long)(INT_MIN))
&& (longValue <= (long)(UINT_MAX))) {
*ptr = (int)longValue;
} else {
@@ -266,7 +280,7 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
long longValue;
int result = Tcl_ExprLongObj(interp, expr, &longValue);
if (result == TCL_OK) {
- if ((longValue >= -(long)(UINT_MAX))
+ if ((longValue >= (long)(INT_MIN))
&& (longValue <= (long)(UINT_MAX))) {
*ptr = (int)longValue;
} else {
@@ -294,16 +308,12 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig
return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n);
}
#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp
-static int formatInt(char *buffer, int n){
- return TclFormatInt(buffer, (long)n);
-}
-#define TclFormatInt (int(*)(char *, long))formatInt
#endif /* TCL_WIDE_INT_IS_LONG */
#endif /* __CYGWIN__ */
-#ifdef TCL_NO_DEPRECATED
+#if defined(TCL_NO_DEPRECATED)
# define Tcl_SeekOld 0
# define Tcl_TellOld 0
# undef Tcl_SetBooleanObj
@@ -358,6 +368,26 @@ static int formatInt(char *buffer, int n){
# define TclBackgroundException 0
# undef TclpReaddir
# define TclpReaddir 0
+# define TclSetStartupScript 0
+# define TclGetStartupScript 0
+# define TclCreateNamespace 0
+# define TclDeleteNamespace 0
+# define TclAppendExportList 0
+# define TclExport 0
+# define TclImport 0
+# define TclForgetImport 0
+# define TclGetCurrentNamespace_ 0
+# define TclGetGlobalNamespace_ 0
+# define TclFindNamespace 0
+# define TclFindCommand 0
+# define TclGetCommandFromObj 0
+# define TclGetCommandFullName 0
+# define TclCopyChannelOld 0
+# define Tcl_AppendResultVA 0
+# define Tcl_AppendStringsToObjVA 0
+# define Tcl_SetErrorCodeVA 0
+# define Tcl_PanicVA 0
+# define Tcl_VarEvalVA 0
# undef TclpGetDate
# define TclpGetDate 0
# undef TclpLocaltime
@@ -366,10 +396,25 @@ static int formatInt(char *buffer, int n){
# define TclpGmtime 0
# define TclpLocaltime_unix 0
# define TclpGmtime_unix 0
+# define Tcl_GetUnicode 0
#else /* TCL_NO_DEPRECATED */
# define Tcl_SeekOld seekOld
# define Tcl_TellOld tellOld
# define TclBackgroundException Tcl_BackgroundException
+# define TclSetStartupScript Tcl_SetStartupScript
+# define TclGetStartupScript Tcl_GetStartupScript
+# define TclCreateNamespace Tcl_CreateNamespace
+# define TclDeleteNamespace Tcl_DeleteNamespace
+# define TclAppendExportList Tcl_AppendExportList
+# define TclExport Tcl_Export
+# define TclImport Tcl_Import
+# define TclForgetImport Tcl_ForgetImport
+# define TclGetCurrentNamespace_ Tcl_GetCurrentNamespace
+# define TclGetGlobalNamespace_ Tcl_GetGlobalNamespace
+# define TclFindNamespace Tcl_FindNamespace
+# define TclFindCommand Tcl_FindCommand
+# define TclGetCommandFromObj Tcl_GetCommandFromObj
+# define TclGetCommandFullName Tcl_GetCommandFullName
# define TclpLocaltime_unix TclpLocaltime
# define TclpGmtime_unix TclpGmtime
@@ -379,20 +424,14 @@ seekOld(
int offset, /* Offset to seek to. */
int mode) /* Relative to which location to seek? */
{
- Tcl_WideInt wOffset, wResult;
-
- wOffset = Tcl_LongAsWide((long) offset);
- wResult = Tcl_Seek(chan, wOffset, mode);
- return (int) Tcl_WideAsLong(wResult);
+ return Tcl_Seek(chan, offset, mode);
}
static int
tellOld(
Tcl_Channel chan) /* The channel to return pos for. */
{
- Tcl_WideInt wResult = Tcl_Tell(chan);
-
- return (int) Tcl_WideAsLong(wResult);
+ return Tcl_Tell(chan);
}
#endif /* !TCL_NO_DEPRECATED */
@@ -405,6 +444,15 @@ tellOld(
MODULE_SCOPE const TclStubs tclStubs;
MODULE_SCOPE const TclTomMathStubs tclTomMathStubs;
+#ifdef __GNUC__
+/*
+ * The rest of this file shouldn't warn about deprecated functions; they're
+ * there because we intend them to be so and know that this file is OK to
+ * touch those fields.
+ */
+#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
+#endif
+
/* !BEGIN!: Do not edit below this line. */
static const TclIntStubs tclIntStubs = {
@@ -522,22 +570,22 @@ static const TclIntStubs tclIntStubs = {
TclUpdateReturnInfo, /* 109 */
TclSockMinimumBuffers, /* 110 */
Tcl_AddInterpResolvers, /* 111 */
- Tcl_AppendExportList, /* 112 */
- Tcl_CreateNamespace, /* 113 */
- Tcl_DeleteNamespace, /* 114 */
- Tcl_Export, /* 115 */
- Tcl_FindCommand, /* 116 */
- Tcl_FindNamespace, /* 117 */
+ TclAppendExportList, /* 112 */
+ TclCreateNamespace, /* 113 */
+ TclDeleteNamespace, /* 114 */
+ TclExport, /* 115 */
+ TclFindCommand, /* 116 */
+ TclFindNamespace, /* 117 */
Tcl_GetInterpResolvers, /* 118 */
Tcl_GetNamespaceResolvers, /* 119 */
Tcl_FindNamespaceVar, /* 120 */
- Tcl_ForgetImport, /* 121 */
- Tcl_GetCommandFromObj, /* 122 */
- Tcl_GetCommandFullName, /* 123 */
- Tcl_GetCurrentNamespace, /* 124 */
- Tcl_GetGlobalNamespace, /* 125 */
+ TclForgetImport, /* 121 */
+ TclGetCommandFromObj, /* 122 */
+ TclGetCommandFullName, /* 123 */
+ TclGetCurrentNamespace_, /* 124 */
+ TclGetGlobalNamespace_, /* 125 */
Tcl_GetVariableFullName, /* 126 */
- Tcl_Import, /* 127 */
+ TclImport, /* 127 */
Tcl_PopCallFrame, /* 128 */
Tcl_PushCallFrame, /* 129 */
Tcl_RemoveInterpResolvers, /* 130 */
@@ -588,8 +636,8 @@ static const TclIntStubs tclIntStubs = {
TclCallVarTraces, /* 175 */
TclCleanupVar, /* 176 */
TclVarErrMsg, /* 177 */
- Tcl_SetStartupScript, /* 178 */
- Tcl_GetStartupScript, /* 179 */
+ TclSetStartupScript, /* 178 */
+ TclGetStartupScript, /* 179 */
0, /* 180 */
0, /* 181 */
TclpLocaltime, /* 182 */
@@ -662,6 +710,11 @@ static const TclIntStubs tclIntStubs = {
TclDoubleDigits, /* 249 */
TclSetSlaveCancelFlags, /* 250 */
TclRegisterLiteral, /* 251 */
+ TclPtrGetVar, /* 252 */
+ TclPtrSetVar, /* 253 */
+ TclPtrIncrObjVar, /* 254 */
+ TclPtrObjMakeUpvar, /* 255 */
+ TclPtrUnsetVar, /* 256 */
};
static const TclIntPlatStubs tclIntPlatStubs = {
@@ -852,6 +905,11 @@ const TclTomMathStubs tclTomMathStubs = {
TclBNInitBignumFromWideInt, /* 65 */
TclBNInitBignumFromWideUInt, /* 66 */
TclBN_mp_expt_d_ex, /* 67 */
+ TclBN_mp_set_long_long, /* 68 */
+ TclBN_mp_get_long_long, /* 69 */
+ TclBN_mp_set_long, /* 70 */
+ TclBN_mp_get_long, /* 71 */
+ TclBN_mp_get_int, /* 72 */
};
static const TclStubHooks tclStubHooks = {
@@ -1519,7 +1577,11 @@ const TclStubs tclStubs = {
Tcl_FSUnloadFile, /* 629 */
Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
Tcl_OpenTcpServerEx, /* 631 */
- Tcl_OpenTcpClientEx, /* 632 */
+ TclZipfs_Mount, /* 632 */
+ TclZipfs_Unmount, /* 633 */
+ TclZipfs_TclLibrary, /* 634 */
+ TclZipfs_MountBuffer, /* 635 */
+ Tcl_OpenTcpClientEx, /* 636 */
};
/* !END!: Do not edit above this line. */