summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.decls133
-rw-r--r--generic/tcl.h36
-rw-r--r--generic/tclBasic.c36
-rw-r--r--generic/tclCmdMZ.c16
-rw-r--r--generic/tclCompCmds.c271
-rw-r--r--generic/tclCompExpr.c57
-rw-r--r--generic/tclCompile.c33
-rw-r--r--generic/tclCompile.h17
-rw-r--r--generic/tclDecls.h258
-rw-r--r--generic/tclEnv.c8
-rw-r--r--generic/tclEvent.c10
-rw-r--r--generic/tclInt.decls26
-rw-r--r--generic/tclInt.h24
-rw-r--r--generic/tclIntDecls.h53
-rw-r--r--generic/tclInterp.c9
-rw-r--r--generic/tclLink.c14
-rw-r--r--generic/tclObj.c4
-rw-r--r--generic/tclParse.c984
-rw-r--r--generic/tclParseExpr.c428
-rw-r--r--generic/tclProc.c4
-rw-r--r--generic/tclTest.c188
-rw-r--r--generic/tclUtf.c132
-rw-r--r--generic/tclUtil.c42
-rw-r--r--generic/tclVar.c107
24 files changed, 1569 insertions, 1321 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 6e0f5f5..faf06bd 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: tcl.decls,v 1.91 2002/07/22 16:51:47 vincentdarley Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.92 2002/08/05 03:24:39 dgp Exp $
library tcl
@@ -32,7 +32,7 @@ declare 0 generic {
CONST char* version, ClientData clientData)
}
declare 1 generic {
- CONST char * Tcl_PkgRequireEx(Tcl_Interp *interp, CONST char *name,
+ CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp, CONST char *name,
CONST char *version, int exact, ClientData *clientDataPtr)
}
declare 2 generic {
@@ -303,10 +303,10 @@ declare 81 generic {
int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 82 generic {
- int Tcl_CommandComplete(char *cmd)
+ int Tcl_CommandComplete(CONST char *cmd)
}
declare 83 generic {
- char * Tcl_Concat(int argc, CONST84 char * CONST *argv)
+ CONST84_RETURN char * Tcl_Concat(int argc, CONST84 char * CONST *argv)
}
declare 84 generic {
int Tcl_ConvertElement(CONST char *src, char *dst, int flags)
@@ -318,7 +318,7 @@ declare 85 generic {
declare 86 generic {
int Tcl_CreateAlias(Tcl_Interp *slave, CONST char *slaveCmd,
Tcl_Interp *target, CONST char *targetCmd, int argc,
- char * CONST *argv)
+ CONST84 char * CONST *argv)
}
declare 87 generic {
int Tcl_CreateAliasObj(Tcl_Interp *slave, CONST char *slaveCmd,
@@ -461,13 +461,13 @@ declare 126 generic {
int Tcl_Eof(Tcl_Channel chan)
}
declare 127 generic {
- CONST char * Tcl_ErrnoId(void)
+ CONST84_RETURN char * Tcl_ErrnoId(void)
}
declare 128 generic {
- CONST char * Tcl_ErrnoMsg(int err)
+ CONST84_RETURN char * Tcl_ErrnoMsg(int err)
}
declare 129 generic {
- int Tcl_Eval(Tcl_Interp *interp, char *string)
+ int Tcl_Eval(Tcl_Interp *interp, CONST char *string)
}
# This is obsolete, use Tcl_FSEvalFile
declare 130 generic {
@@ -530,7 +530,7 @@ declare 147 generic {
declare 148 generic {
int Tcl_GetAlias(Tcl_Interp *interp, CONST char *slaveCmd,
Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
- int *argcPtr, char ***argvPtr)
+ int *argcPtr, CONST84 char ***argvPtr)
}
declare 149 generic {
int Tcl_GetAliasObj(Tcl_Interp *interp, CONST char *slaveCmd,
@@ -559,7 +559,7 @@ declare 155 generic {
int Tcl_GetChannelMode(Tcl_Channel chan)
}
declare 156 generic {
- CONST char * Tcl_GetChannelName(Tcl_Channel chan)
+ CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan)
}
declare 157 generic {
int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan,
@@ -573,13 +573,14 @@ declare 159 generic {
Tcl_CmdInfo *infoPtr)
}
declare 160 generic {
- CONST char * Tcl_GetCommandName(Tcl_Interp *interp, Tcl_Command command)
+ CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp,
+ Tcl_Command command)
}
declare 161 generic {
int Tcl_GetErrno(void)
}
declare 162 generic {
- CONST char * Tcl_GetHostName(void)
+ CONST84_RETURN char * Tcl_GetHostName(void)
}
declare 163 generic {
int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp)
@@ -622,17 +623,18 @@ declare 173 generic {
Tcl_Channel Tcl_GetStdChannel(int type)
}
declare 174 generic {
- CONST char * Tcl_GetStringResult(Tcl_Interp *interp)
+ CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp)
}
declare 175 generic {
- CONST char * Tcl_GetVar(Tcl_Interp *interp, char *varName, int flags)
+ CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp, CONST char *varName,
+ int flags)
}
declare 176 generic {
- CONST char * Tcl_GetVar2(Tcl_Interp *interp, char *part1, CONST char *part2,
- int flags)
+ CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp, CONST char *part1,
+ CONST char *part2, int flags)
}
declare 177 generic {
- int Tcl_GlobalEval(Tcl_Interp *interp, char *command)
+ int Tcl_GlobalEval(Tcl_Interp *interp, CONST char *command)
}
declare 178 generic {
int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
@@ -665,7 +667,8 @@ declare 186 generic {
Tcl_DString *resultPtr)
}
declare 187 generic {
- int Tcl_LinkVar(Tcl_Interp *interp, char *varName, char *addr, int type)
+ int Tcl_LinkVar(Tcl_Interp *interp, CONST char *varName, char *addr,
+ int type)
}
# This slot is reserved for use by the plus patch:
@@ -727,7 +730,7 @@ declare 203 generic {
int Tcl_PutEnv(CONST char *string)
}
declare 204 generic {
- CONST char * Tcl_PosixError(Tcl_Interp *interp)
+ CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp)
}
declare 205 generic {
void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position)
@@ -834,18 +837,18 @@ declare 236 generic {
void Tcl_SetStdChannel(Tcl_Channel channel, int type)
}
declare 237 generic {
- CONST char * Tcl_SetVar(Tcl_Interp *interp, char *varName,
+ CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp, CONST char *varName,
CONST char *newValue, int flags)
}
declare 238 generic {
- CONST char * Tcl_SetVar2(Tcl_Interp *interp, char *part1, CONST char *part2,
- CONST char *newValue, int flags)
+ CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp, CONST char *part1,
+ CONST char *part2, CONST char *newValue, int flags)
}
declare 239 generic {
- CONST char * Tcl_SignalId(int sig)
+ CONST84_RETURN char * Tcl_SignalId(int sig)
}
declare 240 generic {
- CONST char * Tcl_SignalMsg(int sig)
+ CONST84_RETURN char * Tcl_SignalMsg(int sig)
}
declare 241 generic {
void Tcl_SourceRCFile(Tcl_Interp *interp)
@@ -870,11 +873,11 @@ declare 246 generic {
int Tcl_TellOld(Tcl_Channel chan)
}
declare 247 generic {
- int Tcl_TraceVar(Tcl_Interp *interp, char *varName, int flags,
+ int Tcl_TraceVar(Tcl_Interp *interp, CONST char *varName, int flags,
Tcl_VarTraceProc *proc, ClientData clientData)
}
declare 248 generic {
- int Tcl_TraceVar2(Tcl_Interp *interp, char *part1, CONST char *part2,
+ int Tcl_TraceVar2(Tcl_Interp *interp, CONST char *part1, CONST char *part2,
int flags, Tcl_VarTraceProc *proc, ClientData clientData)
}
declare 249 generic {
@@ -885,46 +888,47 @@ declare 250 generic {
int Tcl_Ungets(Tcl_Channel chan, CONST char *str, int len, int atHead)
}
declare 251 generic {
- void Tcl_UnlinkVar(Tcl_Interp *interp, char *varName)
+ void Tcl_UnlinkVar(Tcl_Interp *interp, CONST char *varName)
}
declare 252 generic {
int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 253 generic {
- int Tcl_UnsetVar(Tcl_Interp *interp, char *varName, int flags)
+ int Tcl_UnsetVar(Tcl_Interp *interp, CONST char *varName, int flags)
}
declare 254 generic {
- int Tcl_UnsetVar2(Tcl_Interp *interp, char *part1, CONST char *part2,
+ int Tcl_UnsetVar2(Tcl_Interp *interp, CONST char *part1, CONST char *part2,
int flags)
}
declare 255 generic {
- void Tcl_UntraceVar(Tcl_Interp *interp, char *varName, int flags,
+ void Tcl_UntraceVar(Tcl_Interp *interp, CONST char *varName, int flags,
Tcl_VarTraceProc *proc, ClientData clientData)
}
declare 256 generic {
- void Tcl_UntraceVar2(Tcl_Interp *interp, char *part1, CONST char *part2,
- int flags, Tcl_VarTraceProc *proc, ClientData clientData)
+ void Tcl_UntraceVar2(Tcl_Interp *interp, CONST char *part1,
+ CONST char *part2, int flags, Tcl_VarTraceProc *proc,
+ ClientData clientData)
}
declare 257 generic {
- void Tcl_UpdateLinkedVar(Tcl_Interp *interp, char *varName)
+ void Tcl_UpdateLinkedVar(Tcl_Interp *interp, CONST char *varName)
}
declare 258 generic {
- int Tcl_UpVar(Tcl_Interp *interp, CONST char *frameName, char *varName,
- CONST char *localName, int flags)
+ int Tcl_UpVar(Tcl_Interp *interp, CONST char *frameName,
+ CONST char *varName, CONST char *localName, int flags)
}
declare 259 generic {
- int Tcl_UpVar2(Tcl_Interp *interp, CONST char *frameName, char *part1,
+ int Tcl_UpVar2(Tcl_Interp *interp, CONST char *frameName, CONST char *part1,
CONST char *part2, CONST char *localName, int flags)
}
declare 260 generic {
int Tcl_VarEval(Tcl_Interp *interp, ...)
}
declare 261 generic {
- ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, char *varName,
+ ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, CONST char *varName,
int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)
}
declare 262 generic {
- ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, char *part1,
+ ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, CONST char *part1,
CONST char *part2, int flags, Tcl_VarTraceProc *procPtr,
ClientData prevClientData)
}
@@ -949,17 +953,18 @@ declare 268 generic {
void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
}
declare 269 generic {
- CONST char * Tcl_HashStats(Tcl_HashTable *tablePtr)
+ CONST84_RETURN char * Tcl_HashStats(Tcl_HashTable *tablePtr)
}
declare 270 generic {
- CONST char * Tcl_ParseVar(Tcl_Interp *interp, char *str, char **termPtr)
+ CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp, CONST char *str,
+ CONST84 char **termPtr)
}
declare 271 generic {
- CONST char * Tcl_PkgPresent(Tcl_Interp *interp, CONST char *name,
+ CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp, CONST char *name,
CONST char *version, int exact)
}
declare 272 generic {
- CONST char * Tcl_PkgPresentEx(Tcl_Interp *interp, CONST char *name,
+ CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp, CONST char *name,
CONST char *version, int exact, ClientData *clientDataPtr)
}
declare 273 generic {
@@ -967,7 +972,7 @@ declare 273 generic {
CONST char *version)
}
declare 274 generic {
- CONST char * Tcl_PkgRequire(Tcl_Interp *interp, CONST char *name,
+ CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp, CONST char *name,
CONST char *version, int exact)
}
declare 275 generic {
@@ -1042,7 +1047,8 @@ declare 290 generic {
void Tcl_DiscardResult(Tcl_SavedResult *statePtr)
}
declare 291 generic {
- int Tcl_EvalEx(Tcl_Interp *interp, char *script, int numBytes, int flags)
+ int Tcl_EvalEx(Tcl_Interp *interp, CONST char *script, int numBytes,
+ int flags)
}
declare 292 generic {
int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[],
@@ -1080,7 +1086,7 @@ declare 301 generic {
Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, CONST char *name)
}
declare 302 generic {
- CONST char * Tcl_GetEncodingName(Tcl_Encoding encoding)
+ CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding)
}
declare 303 generic {
void Tcl_GetEncodingNames(Tcl_Interp *interp)
@@ -1094,8 +1100,8 @@ declare 305 generic {
VOID * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size)
}
declare 306 generic {
- Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, char *part1, CONST char *part2,
- int flags)
+ Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, CONST char *part1,
+ CONST char *part2, int flags)
}
declare 307 generic {
ClientData Tcl_InitNotifier(void)
@@ -1130,8 +1136,8 @@ declare 316 generic {
int Tcl_SetSystemEncoding(Tcl_Interp *interp, CONST char *name)
}
declare 317 generic {
- Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, char *part1, CONST char *part2,
- Tcl_Obj *newValuePtr, int flags)
+ Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, CONST char *part1,
+ CONST char *part2, Tcl_Obj *newValuePtr, int flags)
}
declare 318 generic {
void Tcl_ThreadAlert(Tcl_ThreadId threadId)
@@ -1156,7 +1162,7 @@ declare 324 generic {
int Tcl_UniCharToUtf(int ch, char *buf)
}
declare 325 generic {
- CONST char * Tcl_UtfAtIndex(CONST char *src, int index)
+ CONST84_RETURN char * Tcl_UtfAtIndex(CONST char *src, int index)
}
declare 326 generic {
int Tcl_UtfCharComplete(CONST char *src, int len)
@@ -1165,16 +1171,16 @@ declare 327 generic {
int Tcl_UtfBackslash(CONST char *src, int *readPtr, char *dst)
}
declare 328 generic {
- CONST char * Tcl_UtfFindFirst(CONST char *src, int ch)
+ CONST84_RETURN char * Tcl_UtfFindFirst(CONST char *src, int ch)
}
declare 329 generic {
- CONST char * Tcl_UtfFindLast(CONST char *src, int ch)
+ CONST84_RETURN char * Tcl_UtfFindLast(CONST char *src, int ch)
}
declare 330 generic {
- CONST char * Tcl_UtfNext(CONST char *src)
+ CONST84_RETURN char * Tcl_UtfNext(CONST char *src)
}
declare 331 generic {
- CONST char * Tcl_UtfPrev(CONST char *src, CONST char *start)
+ CONST84_RETURN char * Tcl_UtfPrev(CONST char *src, CONST char *start)
}
declare 332 generic {
int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding,
@@ -1208,7 +1214,7 @@ declare 340 generic {
char * Tcl_GetString(Tcl_Obj *objPtr)
}
declare 341 generic {
- CONST char * Tcl_GetDefaultEncodingDir(void)
+ CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void)
}
declare 342 generic {
void Tcl_SetDefaultEncodingDir(CONST char *path)
@@ -1272,23 +1278,24 @@ declare 359 generic {
CONST char *command, int length)
}
declare 360 generic {
- int Tcl_ParseBraces(Tcl_Interp *interp, char *string,
- int numBytes, Tcl_Parse *parsePtr, int append, char **termPtr)
+ int Tcl_ParseBraces(Tcl_Interp *interp, CONST char *string, int numBytes,
+ Tcl_Parse *parsePtr, int append, CONST84 char **termPtr)
}
declare 361 generic {
- int Tcl_ParseCommand(Tcl_Interp *interp, char *string, int numBytes,
+ int Tcl_ParseCommand(Tcl_Interp *interp, CONST char *string, int numBytes,
int nested, Tcl_Parse *parsePtr)
}
declare 362 generic {
- int Tcl_ParseExpr(Tcl_Interp *interp, char *string, int numBytes,
+ int Tcl_ParseExpr(Tcl_Interp *interp, CONST char *string, int numBytes,
Tcl_Parse *parsePtr)
}
declare 363 generic {
- int Tcl_ParseQuotedString(Tcl_Interp *interp, char *string, int numBytes,
- Tcl_Parse *parsePtr, int append, char **termPtr)
+ int Tcl_ParseQuotedString(Tcl_Interp *interp, CONST char *string,
+ int numBytes, Tcl_Parse *parsePtr, int append,
+ CONST84 char **termPtr)
}
declare 364 generic {
- int Tcl_ParseVarName(Tcl_Interp *interp, char *string, int numBytes,
+ int Tcl_ParseVarName(Tcl_Interp *interp, CONST char *string, int numBytes,
Tcl_Parse *parsePtr, int append)
}
# These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir,
@@ -1401,7 +1408,7 @@ declare 397 generic {
int Tcl_ChannelBuffered(Tcl_Channel chan)
}
declare 398 generic {
- CONST char * Tcl_ChannelName(Tcl_ChannelType *chanTypePtr)
+ CONST84_RETURN char * Tcl_ChannelName(Tcl_ChannelType *chanTypePtr)
}
declare 399 generic {
Tcl_ChannelTypeVersion Tcl_ChannelVersion(Tcl_ChannelType *chanTypePtr)
diff --git a/generic/tcl.h b/generic/tcl.h
index 3e6e19c..3bf2ae0 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tcl.h,v 1.138 2002/07/29 15:56:53 msofer Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.139 2002/08/05 03:24:40 dgp Exp $
*/
#ifndef _TCL
@@ -249,9 +249,19 @@ extern "C" {
#endif
#ifdef USE_NON_CONST
+# ifdef USE_COMPAT_CONST
+# error define at most one of USE_NON_CONST and USE_COMPAT_CONST
+# endif
# define CONST84
+# define CONST84_RETURN
#else
-# define CONST84 CONST
+# ifdef USE_COMPAT_CONST
+# define CONST84
+# define CONST84_RETURN CONST
+# else
+# define CONST84 CONST
+# define CONST84_RETURN CONST
+# endif
#endif
@@ -636,10 +646,10 @@ typedef void (Tcl_ChannelProc) _ANSI_ARGS_((ClientData clientData, int mask));
typedef void (Tcl_CloseProc) _ANSI_ARGS_((ClientData data));
typedef void (Tcl_CmdDeleteProc) _ANSI_ARGS_((ClientData clientData));
typedef int (Tcl_CmdProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char *argv[]));
+ Tcl_Interp *interp, int argc, CONST84 char *argv[]));
typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc,
- ClientData cmdClientData, int argc, char *argv[]));
+ ClientData cmdClientData, int argc, CONST84 char *argv[]));
typedef int (Tcl_CmdObjTraceProc) _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int level, CONST char *command,
Tcl_Command commandInfo, int objc, struct Tcl_Obj * CONST * objv));
@@ -680,7 +690,7 @@ typedef int (Tcl_SetFromAnyProc) _ANSI_ARGS_((Tcl_Interp *interp,
struct Tcl_Obj *objPtr));
typedef void (Tcl_UpdateStringProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr));
typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, char *part1, CONST84 char *part2, int flags));
+ Tcl_Interp *interp, CONST84 char *part1, CONST84 char *part2, int flags));
typedef void (Tcl_CommandTraceProc) _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, CONST char *oldName, CONST char *newName,
int flags));
@@ -1583,7 +1593,7 @@ typedef Tcl_Channel (Tcl_FSOpenFileChannelProc)
_ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr,
int mode, int permissions));
typedef int (Tcl_FSMatchInDirectoryProc) _ANSI_ARGS_((Tcl_Interp* interp,
- Tcl_Obj *result, Tcl_Obj *pathPtr, CONST84 char *pattern,
+ Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern,
Tcl_GlobTypeData * types));
typedef Tcl_Obj* (Tcl_FSGetCwdProc) _ANSI_ARGS_((Tcl_Interp *interp));
typedef int (Tcl_FSChdirProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
@@ -1610,7 +1620,7 @@ typedef int (Tcl_FSNormalizePathProc) _ANSI_ARGS_((Tcl_Interp *interp,
typedef int (Tcl_FSFileAttrsGetProc) _ANSI_ARGS_((Tcl_Interp *interp,
int index, Tcl_Obj *pathPtr,
Tcl_Obj **objPtrRef));
-typedef CONST84 char** (Tcl_FSFileAttrStringsProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
+typedef CONST char** (Tcl_FSFileAttrStringsProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
Tcl_Obj** objPtrRef));
typedef int (Tcl_FSFileAttrsSetProc) _ANSI_ARGS_((Tcl_Interp *interp,
int index, Tcl_Obj *pathPtr,
@@ -1934,7 +1944,7 @@ typedef struct Tcl_EncodingType {
typedef struct Tcl_Token {
int type; /* Type of token, such as TCL_TOKEN_WORD;
* see below for valid types. */
- char *start; /* First character in token. */
+ CONST char *start; /* First character in token. */
int size; /* Number of bytes in token. */
int numComponents; /* If this token is composed of other
* tokens, this field tells how many of
@@ -2048,14 +2058,14 @@ typedef struct Tcl_Token {
#define NUM_STATIC_TOKENS 20
typedef struct Tcl_Parse {
- char *commentStart; /* Pointer to # that begins the first of
+ CONST char *commentStart; /* Pointer to # that begins the first of
* one or more comments preceding the
* command. */
int commentSize; /* Number of bytes in comments (up through
* newline character that terminates the
* last comment). If there were no
* comments, this field is 0. */
- char *commandStart; /* First character in first word of command. */
+ CONST char *commandStart; /* First character in first word of command. */
int commandSize; /* Number of bytes in command, including
* first character of first word, up
* through the terminating newline,
@@ -2079,13 +2089,13 @@ typedef struct Tcl_Parse {
* Tcl_ParseCommand.
*/
- char *string; /* The original command string passed to
+ CONST char *string; /* The original command string passed to
* Tcl_ParseCommand. */
- char *end; /* Points to the character just after the
+ CONST char *end; /* Points to the character just after the
* last one in the command string. */
Tcl_Interp *interp; /* Interpreter to use for error reporting,
* or NULL. */
- char *term; /* Points to character in string that
+ CONST char *term; /* Points to character in string that
* terminated most recent token. Filled in
* by ParseTokens. If an error occurs,
* points to beginning of region where the
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e927654..b1da3ad 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.67 2002/07/29 15:56:53 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.68 2002/08/05 03:24:40 dgp Exp $
*/
#include "tclInt.h"
@@ -1753,8 +1753,8 @@ TclInvokeStringCommand(clientData, interp, objc, objv)
*/
#define NUM_ARGS 20
- char *(argStorage[NUM_ARGS]);
- char **argv = argStorage;
+ CONST char *(argStorage[NUM_ARGS]);
+ CONST char **argv = argStorage;
/*
* Create the string argument array "argv". Make sure argv is large
@@ -1763,7 +1763,7 @@ TclInvokeStringCommand(clientData, interp, objc, objv)
*/
if ((objc + 1) > NUM_ARGS) {
- argv = (char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
+ argv = (CONST char **) ckalloc((unsigned)(objc + 1) * sizeof(char *));
}
for (i = 0; i < objc; i++) {
@@ -1814,7 +1814,7 @@ TclInvokeObjectCommand(clientData, interp, argc, argv)
ClientData clientData; /* Points to command's Command structure. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- register char **argv; /* Argument strings. */
+ register CONST char **argv; /* Argument strings. */
{
Command *cmdPtr = (Command *) clientData;
register Tcl_Obj *objPtr;
@@ -2914,7 +2914,7 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags)
int objc; /* Number of words in command. */
Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are
* the words that make up the command. */
- char *command; /* Points to the beginning of the string
+ CONST char *command; /* Points to the beginning of the string
* representation of the command; this
* is used for traces. If the string
* representation of the command is
@@ -3308,7 +3308,7 @@ Tcl_EvalTokensStandard(interp, tokenPtr, count)
#endif
char nameBuffer[MAX_VAR_CHARS+1];
char *varName, *index;
- char *p = NULL; /* Initialized to avoid compiler warning. */
+ CONST char *p = NULL; /* Initialized to avoid compiler warning. */
int length, code;
/*
@@ -3516,7 +3516,7 @@ int
Tcl_EvalEx(interp, script, numBytes, flags)
Tcl_Interp *interp; /* Interpreter in which to evaluate the
* script. Also used for error reporting. */
- char *script; /* First character of script to evaluate. */
+ CONST char *script; /* First character of script to evaluate. */
int numBytes; /* Number of bytes in script. If < 0, the
* script consists of all bytes up to the
* first null character. */
@@ -3526,7 +3526,7 @@ Tcl_EvalEx(interp, script, numBytes, flags)
* supported. */
{
Interp *iPtr = (Interp *) interp;
- char *p, *next;
+ CONST char *p, *next;
Tcl_Parse parse;
#define NUM_STATIC_OBJS 20
Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv;
@@ -3541,7 +3541,7 @@ Tcl_EvalEx(interp, script, numBytes, flags)
* nothing will be read nor written there.
*/
- char *onePast = NULL;
+ CONST char *onePast = NULL;
/*
* The variables below keep track of how much state has been
@@ -3712,7 +3712,7 @@ Tcl_EvalEx(interp, script, numBytes, flags)
Tcl_FreeParse(&parse);
if ((nested != 0) && (p > script)) {
- char *nextCmd = NULL; /* pointer to start of next command */
+ CONST char *nextCmd = NULL; /* pointer to start of next command */
/*
* We get here in the special case where the TCL_BRACKET_TERM
@@ -3791,11 +3791,9 @@ int
Tcl_Eval(interp, string)
Tcl_Interp *interp; /* Token for command interpreter (returned
* by previous call to Tcl_CreateInterp). */
- char *string; /* Pointer to TCL command to execute. */
+ CONST char *string; /* Pointer to TCL command to execute. */
{
- int code;
-
- code = Tcl_EvalEx(interp, string, -1, 0);
+ int code = Tcl_EvalEx(interp, string, -1, 0);
/*
* For backwards compatibility with old C code that predates the
@@ -4301,7 +4299,7 @@ int
TclInvoke(interp, argc, argv, flags)
Tcl_Interp *interp; /* Where to invoke the command. */
int argc; /* Count of args. */
- register char **argv; /* The arg strings; argv[0] is the name of
+ register CONST char **argv; /* The arg strings; argv[0] is the name of
* the command to invoke. */
int flags; /* Combination of flags controlling the
* call: TCL_INVOKE_HIDDEN and
@@ -4398,7 +4396,7 @@ int
TclGlobalInvoke(interp, argc, argv, flags)
Tcl_Interp *interp; /* Where to invoke the command. */
int argc; /* Count of args. */
- register char **argv; /* The arg strings; argv[0] is the name of
+ register CONST char **argv; /* The arg strings; argv[0] is the name of
* the command to invoke. */
int flags; /* Combination of flags controlling the
* call: TCL_INVOKE_HIDDEN and
@@ -4931,7 +4929,7 @@ StringTraceProc( clientData, interp, level, command, commandInfo, objc, objv )
( data->proc )( data->clientData, interp, level,
(char*) command, cmdPtr->proc, cmdPtr->clientData,
- objc, (char**) argv );
+ objc, argv );
ckfree( (char*) argv );
return TCL_OK;
@@ -5238,7 +5236,7 @@ Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
int
Tcl_GlobalEval(interp, command)
Tcl_Interp *interp; /* Interpreter in which to evaluate command. */
- char *command; /* Command to evaluate. */
+ CONST char *command; /* Command to evaluate. */
{
register Interp *iPtr = (Interp *) interp;
int result;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index ee37ff2..bc832ea 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.73 2002/06/19 22:38:39 hobbs Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.74 2002/08/05 03:24:40 dgp Exp $
*/
#include "tclInt.h"
@@ -113,11 +113,11 @@ static Tcl_TraceTypeObjCmd* traceSubCmds[] = {
*/
static int CallTraceProcedure _ANSI_ARGS_((Tcl_Interp *interp,
Trace *tracePtr, Command *cmdPtr,
- char *command, int numChars,
+ CONST char *command, int numChars,
int objc, Tcl_Obj *CONST objv[]));
static char * TraceVarProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, char *name1, CONST char *name2,
- int flags));
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
static void TraceCommandProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, CONST char *oldName,
CONST char *newName, int flags));
@@ -4001,7 +4001,7 @@ TraceCommandProc(clientData, interp, oldName, newName, flags)
int
TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, traceFlags, objc, objv)
Tcl_Interp *interp; /* The current interpreter. */
- char *command; /* Pointer to beginning of the current
+ CONST char *command; /* Pointer to beginning of the current
* command string. */
int numChars; /* The number of characters in 'command'
* which are part of the command string. */
@@ -4081,7 +4081,7 @@ TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, traceFlags, obj
int
TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, traceFlags, objc, objv)
Tcl_Interp *interp; /* The current interpreter. */
- char *command; /* Pointer to beginning of the current
+ CONST char *command; /* Pointer to beginning of the current
* command string. */
int numChars; /* The number of characters in 'command'
* which are part of the command string. */
@@ -4186,7 +4186,7 @@ CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv)
Tcl_Interp *interp; /* The current interpreter. */
register Trace *tracePtr; /* Describes the trace procedure to call. */
Command *cmdPtr; /* Points to command's Command struct. */
- char *command; /* Points to the first character of the
+ CONST char *command; /* Points to the first character of the
* command's source before substitutions. */
int numChars; /* The number of characters in the
* command's source. */
@@ -4417,7 +4417,7 @@ static char *
TraceVarProc(clientData, interp, name1, name2, flags)
ClientData clientData; /* Information about the variable trace. */
Tcl_Interp *interp; /* Interpreter containing variable. */
- char *name1; /* Name of variable or array. */
+ CONST char *name1; /* Name of variable or array. */
CONST char *name2; /* Name of element within array; NULL means
* scalar variable is being referenced. */
int flags; /* OR-ed bits giving operation and other
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 43d2146..680061e 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompCmds.c,v 1.31 2002/07/03 17:33:39 msofer Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.32 2002/08/05 03:24:40 dgp Exp $
*/
#include "tclInt.h"
@@ -123,8 +123,8 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
if (numWords > 2) {
valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- TclEmitPush(TclRegisterLiteral(envPtr, valueTokenPtr[1].start,
- valueTokenPtr[1].size, /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr,
+ valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
@@ -241,7 +241,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
{
JumpFixup jumpFixup;
Tcl_Token *cmdTokenPtr, *nameTokenPtr;
- char *name;
+ CONST char *name;
int localIndex, nameChars, range, startOffset, jumpDist;
int code;
int savedStackDepth = envPtr->currStackDepth;
@@ -340,8 +340,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
}
}
TclEmitOpcode(INST_POP, envPtr);
- TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0),
- envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
/*
@@ -669,7 +668,7 @@ TclCompileForCmd(interp, parsePtr, envPtr)
*/
envPtr->currStackDepth = savedStackDepth;
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
code = TCL_OK;
done:
@@ -697,7 +696,7 @@ TclCompileForCmd(interp, parsePtr, envPtr)
* Instructions are added to envPtr to execute the "foreach" command
* at runtime.
*
- *----------------------------------------------------------------------
+n*----------------------------------------------------------------------
*/
int
@@ -716,16 +715,13 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
int loopCtTemp; /* Index of temp var holding the loop's
* iteration count. */
Tcl_Token *tokenPtr, *bodyTokenPtr;
- char *varList;
unsigned char *jumpPc;
JumpFixup jumpFalseFixup;
int jumpDist, jumpBackDist, jumpBackOffset, infoIndex, range;
int numWords, numLists, numVars, loopIndex, tempVar, i, j, code;
- char savedChar;
char buffer[32 + TCL_INTEGER_SPACE];
int savedStackDepth = envPtr->currStackDepth;
-
/*
* We parse the variable list argument words and create two arrays:
* varcList[i] is number of variables in i-th var list
@@ -775,7 +771,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
numLists = (numWords - 2)/2;
if (numLists > STATIC_VAR_LIST_SIZE) {
varcList = (int *) ckalloc(numLists * sizeof(int));
- varvList = (CONST char ***) ckalloc(numLists * sizeof(char **));
+ varvList = (CONST char ***) ckalloc(numLists * sizeof(CONST char **));
}
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
varcList[loopIndex] = 0;
@@ -804,32 +800,29 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
code = TCL_OUT_LINE_COMPILE;
goto done;
- }
- varList = tokenPtr[1].start;
- savedChar = varList[tokenPtr[1].size];
+ } else {
+ /* Lots of copying going on here. Need a ListObj wizard
+ * to show a better way. */
- /*
- * Note there is a danger that modifying the string could have
- * undesirable side effects. In this case, Tcl_SplitList does
- * not have any dependencies on shared strings so we should be
- * safe.
- */
+ Tcl_DString varList;
- varList[tokenPtr[1].size] = '\0';
- code = Tcl_SplitList(interp, varList,
- &varcList[loopIndex], &varvList[loopIndex]);
- varList[tokenPtr[1].size] = savedChar;
- if (code != TCL_OK) {
- goto done;
- }
-
- numVars = varcList[loopIndex];
- for (j = 0; j < numVars; j++) {
- CONST char *varName = varvList[loopIndex][j];
- if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
- code = TCL_OUT_LINE_COMPILE;
+ Tcl_DStringInit(&varList);
+ Tcl_DStringAppend(&varList, tokenPtr[1].start,
+ tokenPtr[1].size);
+ code = Tcl_SplitList(interp, Tcl_DStringValue(&varList),
+ &varcList[loopIndex], &varvList[loopIndex]);
+ Tcl_DStringFree(&varList);
+ if (code != TCL_OK) {
goto done;
}
+ numVars = varcList[loopIndex];
+ for (j = 0; j < numVars; j++) {
+ CONST char *varName = varvList[loopIndex][j];
+ if (!TclIsLocalScalar(varName, (int) strlen(varName))) {
+ code = TCL_OUT_LINE_COMPILE;
+ goto done;
+ }
+ }
}
loopIndex++;
}
@@ -1004,14 +997,14 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
*/
envPtr->currStackDepth = savedStackDepth;
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
done:
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
- if (varvList[loopIndex] != NULL) {
- ckfree((char *) varvList[loopIndex]);
- }
+ if (varvList[loopIndex] != (CONST char **) NULL) {
+ ckfree((char *) varvList[loopIndex]);
+ }
}
if (varcList != varcListStaticSpace) {
ckfree((char *) varcList);
@@ -1149,13 +1142,12 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
int jumpDist, jumpFalseDist;
int jumpIndex = 0; /* avoid compiler warning. */
int numWords, wordIdx, numBytes, j, code;
- char *word;
+ CONST char *word;
char buffer[100];
int savedStackDepth = envPtr->currStackDepth;
/* Saved stack depth at the start of the first
* test; the envPtr current depth is restored
* to this value at the start of each test. */
- char *condStart, *savedPos, savedChar;
int realCond = 1; /* set to 0 for static conditions: "if 0 {..}" */
int boolVal; /* value of static condition */
int compileScripts = 1;
@@ -1226,31 +1218,20 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
* Find out if the condition is a constant.
*/
- condStart = testTokenPtr[1].start;
- savedPos = condStart + testTokenPtr[1].size - 1;
-
- while (*condStart == ' ') {
- condStart++;
- }
- while (*savedPos == ' ') {
- savedPos--;
- }
- savedPos++;
-
- savedChar = *savedPos;
- *savedPos = '\0';
-
- if (Tcl_GetBoolean(interp, condStart, &boolVal) != TCL_ERROR) {
+ Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start,
+ testTokenPtr[1].size);
+ Tcl_IncrRefCount(boolObj);
+ code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
+ Tcl_DecrRefCount(boolObj);
+ if (code == TCL_OK) {
/*
* A static condition
*/
- *savedPos = savedChar;
realCond = 0;
if (!boolVal) {
compileScripts = 0;
}
} else {
- *savedPos = savedChar;
Tcl_ResetResult(interp);
code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
if (code != TCL_OK) {
@@ -1438,7 +1419,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
*/
if (compileScripts) {
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0,/*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
}
}
@@ -1546,9 +1527,9 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
if (parsePtr->numWords == 3) {
incrTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- char *word = incrTokenPtr[1].start;
+ CONST char *word = incrTokenPtr[1].start;
int numBytes = incrTokenPtr[1].size;
- char savedChar = word[numBytes];
+ int validLength = TclParseInteger(word, numBytes);
long n;
/*
@@ -1558,18 +1539,20 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
* should be safe.
*/
- word[numBytes] = '\0';
- if (TclLooksLikeInt(word, numBytes)
- && (TclGetLong((Tcl_Interp *) NULL, word, &n) == TCL_OK)) {
- if ((-127 <= n) && (n <= 127)) {
+ if (validLength == numBytes) {
+ int code;
+ Tcl_Obj *longObj = Tcl_NewStringObj(word, numBytes);
+ Tcl_IncrRefCount(longObj);
+ code = Tcl_GetLongFromObj(NULL, longObj, &n);
+ Tcl_DecrRefCount(longObj);
+ if ((code == TCL_OK) && (-127 <= n) && (n <= 127)) {
haveImmValue = 1;
immValue = n;
}
}
- word[numBytes] = savedChar;
if (!haveImmValue) {
- TclEmitPush(TclRegisterLiteral(envPtr, word, numBytes,
- /*onHeap*/ 0), envPtr);
+ TclEmitPush(
+ TclRegisterNewLiteral(envPtr, word, numBytes), envPtr);
}
} else {
code = TclCompileTokens(interp, incrTokenPtr+1,
@@ -1716,8 +1699,8 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
if (numWords > 2) {
valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- TclEmitPush(TclRegisterLiteral(envPtr, valueTokenPtr[1].start,
- valueTokenPtr[1].size, /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr,
+ valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
@@ -1732,7 +1715,7 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
* always creates the variable.
*/
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
numValues = 1;
#endif
}
@@ -1826,11 +1809,9 @@ TclCompileLindexCmd(interp, parsePtr, envPtr)
for ( i = 1 ; i < numWords ; i++ ) {
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- TclEmitPush( TclRegisterLiteral( envPtr,
- varTokenPtr[1].start,
- varTokenPtr[1].size,
- 0),
- envPtr);
+ TclEmitPush(
+ TclRegisterNewLiteral( envPtr, varTokenPtr[1].start,
+ varTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
@@ -1897,7 +1878,7 @@ TclCompileListCmd(interp, parsePtr, envPtr)
* Empty args case
*/
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0, 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
} else {
/*
* Push the all values onto the stack.
@@ -1911,9 +1892,8 @@ TclCompileListCmd(interp, parsePtr, envPtr)
+ (parsePtr->tokenPtr->numComponents + 1);
for (i = 1; i < numWords; i++) {
if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- TclEmitPush(TclRegisterLiteral(envPtr,
- valueTokenPtr[1].start, valueTokenPtr[1].size,
- /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr,
+ valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
@@ -1973,8 +1953,8 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr)
* We could simply count the number of elements here and push
* that value, but that is too rare a case to waste the code space.
*/
- TclEmitPush(TclRegisterLiteral(envPtr, varTokenPtr[1].start,
- varTokenPtr[1].size, 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
+ varTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
@@ -2085,11 +2065,8 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
/* Push an arg */
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- TclEmitPush( TclRegisterLiteral( envPtr,
- varTokenPtr[1].start,
- varTokenPtr[1].size,
- 0),
- envPtr);
+ TclEmitPush(TclRegisterNewLiteral( envPtr, varTokenPtr[1].start,
+ varTokenPtr[1].size), envPtr);
} else {
result = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
@@ -2219,7 +2196,8 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr)
Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing
* the parse of the RE or string */
int i, len, code, exactMatch, nocase;
- char c, *str;
+ Tcl_Obj *patternObj;
+ CONST char *str;
/*
* We are only interested in compiling simple regexp cases.
@@ -2279,7 +2257,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr)
/*
* The semantics of regexp are always match on re == "".
*/
- TclEmitPush(TclRegisterLiteral(envPtr, "1", 1, 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
return TCL_OK;
}
@@ -2317,16 +2295,17 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr)
} else {
exactMatch = 0;
}
- c = str[len];
- str[len] = '\0';
- if (strpbrk(str, "*+?{}()[].\\|^$") != NULL) {
- str[len] = c;
+
+ patternObj = Tcl_NewStringObj(str, len);
+ Tcl_IncrRefCount(patternObj);
+ code = (strpbrk(Tcl_GetString(patternObj), "*+?{}()[].\\|^$") != NULL);
+ Tcl_DecrRefCount(patternObj);
+ if (code) {
/* We don't do anything with REs with special chars yet. */
return TCL_OUT_LINE_COMPILE;
}
- str[len] = c;
if (exactMatch) {
- TclEmitPush(TclRegisterLiteral(envPtr, str, len, 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, str, len), envPtr);
} else {
/*
* This needs to find the substring anywhere in the string, so
@@ -2337,7 +2316,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr)
strncpy(newStr + 1, str, (size_t) len);
newStr[len+1] = '*';
newStr[len+2] = '\0';
- TclEmitPush(TclRegisterLiteral(envPtr, newStr, len+2, 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, newStr, len+2), envPtr);
ckfree((char *) newStr);
}
@@ -2346,8 +2325,8 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr)
*/
varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- TclEmitPush(TclRegisterLiteral(envPtr,
- varTokenPtr[1].start, varTokenPtr[1].size, 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr,
+ varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
@@ -2412,7 +2391,7 @@ TclCompileReturnCmd(interp, parsePtr, envPtr)
* Simple case: [return]
* Just push the literal string "".
*/
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0, 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
break;
}
case 2: {
@@ -2429,8 +2408,8 @@ TclCompileReturnCmd(interp, parsePtr, envPtr)
* [return "foo"] case: the parse token is a simple word,
* so just push it.
*/
- TclEmitPush(TclRegisterLiteral(envPtr, varTokenPtr[1].start,
- varTokenPtr[1].size, /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
+ varTokenPtr[1].size), envPtr);
} else {
/*
* Parse token is more complex, so compile it; this handles the
@@ -2532,8 +2511,8 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
if (isAssignment) {
valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1);
if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- TclEmitPush(TclRegisterLiteral(envPtr, valueTokenPtr[1].start,
- valueTokenPtr[1].size, /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, valueTokenPtr[1].start,
+ valueTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
@@ -2695,9 +2674,8 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
for (i = 0; i < 2; i++) {
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- TclEmitPush(TclRegisterLiteral(envPtr,
- varTokenPtr[1].start, varTokenPtr[1].size,
- 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr,
+ varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
@@ -2726,9 +2704,8 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
for (i = 0; i < 2; i++) {
if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- TclEmitPush(TclRegisterLiteral(envPtr,
- varTokenPtr[1].start, varTokenPtr[1].size,
- 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr,
+ varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
@@ -2757,7 +2734,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
int len = Tcl_NumUtfChars(varTokenPtr[1].start,
varTokenPtr[1].size);
len = sprintf(buf, "%d", len);
- TclEmitPush(TclRegisterLiteral(envPtr, buf, len, 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, buf, len), envPtr);
return TCL_OK;
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
@@ -2771,7 +2748,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
}
case STR_MATCH: {
int i, length, exactMatch = 0, nocase = 0;
- char c, *str;
+ CONST char *str;
if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
/* Fail at run time, not in compilation */
@@ -2803,18 +2780,19 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
* On the first (pattern) arg, check to see if any
* glob special characters are in the word '*[]?\\'.
* If not, this is the same as 'string equal'. We
- * can use strchr here because the glob chars are all
+ * can use strpbrk here because the glob chars are all
* in the ascii-7 range. If -nocase was specified,
* we can't do this because INST_STR_EQ has no support
* for nocase.
*/
- c = str[length];
- str[length] = '\0';
- exactMatch = (strpbrk(str, "*[]?\\") == NULL);
- str[length] = c;
+ Tcl_Obj *copy = Tcl_NewStringObj(str, length);
+ Tcl_IncrRefCount(copy);
+ exactMatch = (strpbrk(Tcl_GetString(copy),
+ "*[]?\\") == NULL);
+ Tcl_DecrRefCount(copy);
}
- TclEmitPush(TclRegisterLiteral(envPtr, str, length,
- 0), envPtr);
+ TclEmitPush(
+ TclRegisterNewLiteral(envPtr, str, length), envPtr);
} else {
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
@@ -2862,7 +2840,7 @@ TclCompileVariableCmd(interp, parsePtr, envPtr)
{
Tcl_Token *varTokenPtr;
int i, numWords;
- char *varName, *tail;
+ CONST char *varName, *tail;
if (envPtr->procPtr == NULL) {
return TCL_OUT_LINE_COMPILE;
@@ -2929,9 +2907,8 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
int savedStackDepth = envPtr->currStackDepth;
int loopMayEnd = 1; /* This is set to 0 if it is recognized as
* an infinite loop. */
+ Tcl_Obj *boolObj;
int boolVal;
- char *condStart;
- char savedChar, *savedPos;
if (parsePtr->numWords != 3) {
Tcl_ResetResult(interp);
@@ -2961,21 +2938,11 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
* Find out if the condition is a constant.
*/
- condStart = testTokenPtr[1].start;
- savedPos = condStart + testTokenPtr[1].size - 1;
-
- while (*condStart == ' ') {
- condStart++;
- }
- while (*savedPos == ' ') {
- savedPos--;
- }
- savedPos++;
-
- savedChar = *savedPos;
- *savedPos = '\0';
-
- if (Tcl_GetBoolean(interp, condStart, &boolVal) != TCL_ERROR) {
+ boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size);
+ Tcl_IncrRefCount(boolObj);
+ code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
+ Tcl_DecrRefCount(boolObj);
+ if (code == TCL_OK) {
if (boolVal) {
/*
* it is an infinite loop
@@ -2988,14 +2955,10 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
* Compile no bytecodes.
*/
- *savedPos = savedChar;
goto pushResult;
}
- } else {
- Tcl_ResetResult(interp);
}
- *savedPos = savedChar;
-
+
/*
* Create a ExceptionRange record for the loop body. This is used to
* implement break and continue.
@@ -3102,7 +3065,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
pushResult:
envPtr->currStackDepth = savedStackDepth;
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
envPtr->exceptDepth--;
return TCL_OK;
@@ -3145,11 +3108,14 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
{
Tcl_Parse elemParse;
int gotElemParse = 0;
- register char *p;
- char *name, *elName;
+ register CONST char *p;
+ CONST char *name, *elName;
register int i, n;
int nameChars, elNameChars, simpleVarName, localIndex;
int code = TCL_OK;
+ Tcl_DString copy;
+
+ Tcl_DStringInit(&copy);
/*
* Decide if we can use a frame slot for the var/array name or if we
@@ -3273,8 +3239,7 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
}
}
if (localIndex < 0) {
- TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars,
- /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameChars), envPtr);
}
/*
@@ -3285,13 +3250,11 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
/*
* Temporarily replace the '(' and ')' by '"'s.
*/
-
- *(elName-1) = '"';
- *(elName+elNameChars) = '"';
- code = Tcl_ParseCommand(interp, elName-1, elNameChars+2,
- /*nested*/ 0, &elemParse);
- *(elName-1) = '(';
- *(elName+elNameChars) = ')';
+ Tcl_DStringAppend(&copy, "\"", 1);
+ Tcl_DStringAppend(&copy, elName, elNameChars);
+ Tcl_DStringAppend(&copy, "\"", 1);
+ code = Tcl_ParseCommand(interp, Tcl_DStringValue(&copy),
+ elNameChars+2, /*nested*/ 0, &elemParse);
gotElemParse = 1;
if ((code != TCL_OK) || (elemParse.numWords > 1)) {
char buffer[160];
@@ -3307,8 +3270,7 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
goto done;
}
} else {
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0,
- /*alreadyAlloced*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
}
}
} else {
@@ -3327,6 +3289,7 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
if (gotElemParse) {
Tcl_FreeParse(&elemParse);
}
+ Tcl_DStringFree(&copy);
*localIndexPtr = localIndex;
*simpleVarNamePtr = simpleVarName;
*isScalarPtr = (elName == NULL);
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index e51aa15..8d74efa 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompExpr.c,v 1.11 2002/07/19 12:31:09 dkf Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.12 2002/08/05 03:24:40 dgp Exp $
*/
#include "tclInt.h"
@@ -51,9 +51,9 @@ typedef struct ExprInfo {
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Parse *parsePtr; /* Structure filled with information about
* the parsed expression. */
- char *expr; /* The expression that was originally passed
+ CONST char *expr; /* The expression that was originally passed
* to TclCompileExpr. */
- char *lastChar; /* Points just after last byte of expr. */
+ CONST char *lastChar; /* Points just after last byte of expr. */
int hasOperators; /* Set 1 if the expr has operators; 0 if
* expr is only a primary. If 1 after
* compiling an expr, a tryCvtToNumeric
@@ -156,7 +156,7 @@ static int CompileLandOrLorExpr _ANSI_ARGS_((
ExprInfo *infoPtr, CompileEnv *envPtr,
Tcl_Token **endPtrPtr));
static int CompileMathFuncCall _ANSI_ARGS_((
- Tcl_Token *exprTokenPtr, char *funcName,
+ Tcl_Token *exprTokenPtr, CONST char *funcName,
ExprInfo *infoPtr, CompileEnv *envPtr,
Tcl_Token **endPtrPtr));
static int CompileSubExpr _ANSI_ARGS_((
@@ -203,7 +203,7 @@ static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr));
int
TclCompileExpr(interp, script, numBytes, envPtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *script; /* The source script to compile. */
+ CONST char *script; /* The source script to compile. */
int numBytes; /* Number of bytes in script. If < 0, the
* string consists of all bytes up to the
* first null character. */
@@ -343,8 +343,8 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
Tcl_Token *tokenPtr, *endPtr, *afterSubexprPtr;
OperatorDesc *opDescPtr;
Tcl_HashEntry *hPtr;
- char *operator;
- char savedChar;
+ CONST char *operator;
+ Tcl_DString opBuf;
int objIndex, opIndex, length, code;
char buffer[TCL_UTF_MAX];
@@ -375,10 +375,10 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
case TCL_TOKEN_TEXT:
if (tokenPtr->size > 0) {
- objIndex = TclRegisterLiteral(envPtr, tokenPtr->start,
- tokenPtr->size, /*onHeap*/ 0);
+ objIndex = TclRegisterNewLiteral(envPtr, tokenPtr->start,
+ tokenPtr->size);
} else {
- objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0);
+ objIndex = TclRegisterNewLiteral(envPtr, "", 0);
}
TclEmitPush(objIndex, envPtr);
tokenPtr += 1;
@@ -388,10 +388,9 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
buffer);
if (length > 0) {
- objIndex = TclRegisterLiteral(envPtr, buffer, length,
- /*onHeap*/ 0);
+ objIndex = TclRegisterNewLiteral(envPtr, buffer, length);
} else {
- objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0);
+ objIndex = TclRegisterNewLiteral(envPtr, "", 0);
}
TclEmitPush(objIndex, envPtr);
tokenPtr += 1;
@@ -424,33 +423,24 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr)
case TCL_TOKEN_OPERATOR:
/*
- * Look up the operator. Temporarily overwrite the character
- * just after the end of the operator with a 0 byte. If the
- * operator isn't found, treat it as a math function.
+ * Look up the operator. If the operator isn't found, treat it
+ * as a math function.
*/
-
- /*
- * TODO: Note that the string is modified in place. This is unsafe
- * and will break if any of the routines called while the string is
- * modified have side effects that depend on the original string
- * being unmodified (e.g. adding an entry to the literal table).
- */
-
- operator = tokenPtr->start;
- savedChar = operator[tokenPtr->size];
- operator[tokenPtr->size] = 0;
+ Tcl_DStringInit(&opBuf);
+ operator = Tcl_DStringAppend(&opBuf,
+ tokenPtr->start, tokenPtr->size);
hPtr = Tcl_FindHashEntry(&opHashTable, operator);
if (hPtr == NULL) {
code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr,
envPtr, &endPtr);
- operator[tokenPtr->size] = (char) savedChar;
+ Tcl_DStringFree(&opBuf);
if (code != TCL_OK) {
goto done;
}
tokenPtr = endPtr;
break;
}
- operator[tokenPtr->size] = (char) savedChar;
+ Tcl_DStringFree(&opBuf);
opIndex = (int) Tcl_GetHashValue(hPtr);
opDescPtr = &(operatorTable[opIndex]);
@@ -627,7 +617,7 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
*/
TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &lhsTrueFixup);
- TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr);
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &lhsEndFixup);
dist = (envPtr->codeNext - envPtr->codeStart) - lhsTrueFixup.codeOffset;
if (TclFixupForwardJump(envPtr, &lhsTrueFixup, dist, 127)) {
@@ -635,7 +625,7 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr)
panic("CompileLandOrLorExpr: bad jump distance %d\n", dist);
}
envPtr->currStackDepth = savedStackDepth;
- TclEmitPush(TclRegisterLiteral(envPtr, "1", 1, /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr);
dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset;
if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) {
goto badDist;
@@ -836,7 +826,7 @@ static int
CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token
* containing the math function call. */
- char *funcName; /* Name of the math function. */
+ CONST char *funcName; /* Name of the math function. */
ExprInfo *infoPtr; /* Describes the compilation state for the
* expression being compiled. */
CompileEnv *envPtr; /* Holds resulting instructions. */
@@ -870,8 +860,7 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr)
*/
if (mathFuncPtr->builtinFuncIndex < 0) {
- TclEmitPush(TclRegisterLiteral(envPtr, funcName, -1, /*onHeap*/ 0),
- envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, funcName, -1), envPtr);
}
/*
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index dc2aa25..75f253e 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.c,v 1.39 2002/07/19 12:31:09 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.40 2002/08/05 03:24:40 dgp Exp $
*/
#include "tclInt.h"
@@ -292,7 +292,8 @@ static void FreeByteCodeInternalRep _ANSI_ARGS_((
static int GetCmdLocEncodingSize _ANSI_ARGS_((
CompileEnv *envPtr));
static void LogCompilationInfo _ANSI_ARGS_((Tcl_Interp *interp,
- char *script, char *command, int length));
+ CONST char *script, CONST char *command,
+ int length));
#ifdef TCL_COMPILE_STATS
static void RecordByteCodeStats _ANSI_ARGS_((
ByteCode *codePtr));
@@ -798,7 +799,7 @@ TclFreeCompileEnv(envPtr)
int
TclCompileScript(interp, script, numBytes, nested, envPtr)
Tcl_Interp *interp; /* Used for error and status reporting. */
- char *script; /* The source script to compile. */
+ CONST char *script; /* The source script to compile. */
int numBytes; /* Number of bytes in script. If < 0, the
* script consists of all bytes up to the
* first null character. */
@@ -817,7 +818,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
int startCodeOffset = -1; /* Offset of first byte of current command's
* code. Init. to avoid compiler warning. */
unsigned char *entryCodeNext = envPtr->codeNext;
- char *p, *next;
+ CONST char *p, *next;
Namespace *cmdNsPtr;
Command *cmdPtr;
Tcl_Token *tokenPtr;
@@ -972,18 +973,16 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
* reduce runtime lookups.
*/
- objIndex = TclRegisterLiteral(envPtr,
- tokenPtr[1].start, tokenPtr[1].size,
- /*onHeap*/ 0);
+ objIndex = TclRegisterNewLiteral(envPtr,
+ tokenPtr[1].start, tokenPtr[1].size);
if (cmdPtr != NULL) {
TclSetCmdNameObj(interp,
envPtr->literalArrayPtr[objIndex].objPtr,
cmdPtr);
}
} else {
- objIndex = TclRegisterLiteral(envPtr,
- tokenPtr[1].start, tokenPtr[1].size,
- /*onHeap*/ 0);
+ objIndex = TclRegisterNewLiteral(envPtr,
+ tokenPtr[1].start, tokenPtr[1].size);
}
TclEmitPush(objIndex, envPtr);
} else {
@@ -1127,7 +1126,7 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
Tcl_DString textBuffer; /* Holds concatenated chars from adjacent
* TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
char buffer[TCL_UTF_MAX];
- char *name, *p;
+ CONST char *name, *p;
int numObjsToConcat, nameBytes, localVarName, localVar;
int length, i, code;
unsigned char *entryCodeNext = envPtr->codeNext;
@@ -1225,8 +1224,8 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
localVarName, /*flags*/ 0, envPtr->procPtr);
}
if (localVar < 0) {
- TclEmitPush(TclRegisterLiteral(envPtr, name,
- nameBytes, /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes),
+ envPtr);
}
/*
@@ -1406,7 +1405,7 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr)
{
Tcl_Token *wordPtr;
int range, numBytes, i, code;
- char *script;
+ CONST char *script;
range = -1;
code = TCL_OK;
@@ -1639,15 +1638,15 @@ static void
LogCompilationInfo(interp, script, command, length)
Tcl_Interp *interp; /* Interpreter in which to log the
* information. */
- char *script; /* First character in script containing
+ CONST char *script; /* First character in script containing
* command (must be <= command). */
- char *command; /* First character in command that
+ CONST char *command; /* First character in command that
* generated the error. */
int length; /* Number of bytes in command (-1 means
* use all bytes up to first null byte). */
{
char buffer[200];
- register char *p;
+ register CONST char *p;
char *ellipsis = "";
Interp *iPtr = (Interp *) interp;
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index e6c2740..88fe81d 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -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: tclCompile.h,v 1.29 2002/07/19 12:31:09 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.30 2002/08/05 03:24:40 dgp Exp $
*/
#ifndef _TCLCOMPILATION
@@ -724,7 +724,7 @@ extern AuxDataType tclForeachInfoType;
*/
EXTERN int TclEvalObjvInternal _ANSI_ARGS_((Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[], char *command, int length,
+ Tcl_Obj *CONST objv[], CONST char *command, int length,
int flags));
EXTERN int TclInterpReady _ANSI_ARGS_((Tcl_Interp *interp));
@@ -750,13 +750,13 @@ EXTERN int TclCompileCmdWord _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *tokenPtr, int count,
CompileEnv *envPtr));
EXTERN int TclCompileExpr _ANSI_ARGS_((Tcl_Interp *interp,
- char *script, int numBytes,
+ CONST char *script, int numBytes,
CompileEnv *envPtr));
EXTERN int TclCompileExprWords _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *tokenPtr, int numWords,
CompileEnv *envPtr));
EXTERN int TclCompileScript _ANSI_ARGS_((Tcl_Interp *interp,
- char *script, int numBytes, int nested,
+ CONST char *script, int numBytes, int nested,
CompileEnv *envPtr));
EXTERN int TclCompileTokens _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *tokenPtr, int count,
@@ -836,6 +836,15 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_((
*/
/*
+ * Form of TclRegisterLiteral with onHeap == 0.
+ * In that case, it is safe to cast away CONSTness, and it
+ * is cleanest to do that here, all in one place.
+ */
+
+#define TclRegisterNewLiteral(envPtr, bytes, length) \
+ TclRegisterLiteral(envPtr, (char *)(bytes), length, /*onHeap*/ 0)
+
+/*
* Macro used to update the stack requirements.
* It is called by the macros TclEmitOpCode, TclEmitInst1 and
* TclEmitInst4.
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 19687a3..a0a8b4b 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -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: tclDecls.h,v 1.91 2002/07/22 16:51:48 vincentdarley Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.92 2002/08/05 03:24:40 dgp Exp $
*/
#ifndef _TCLDECLS
@@ -31,9 +31,10 @@ EXTERN int Tcl_PkgProvideEx _ANSI_ARGS_((Tcl_Interp* interp,
CONST char* name, CONST char* version,
ClientData clientData));
/* 1 */
-EXTERN CONST char * Tcl_PkgRequireEx _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name, CONST char * version,
- int exact, ClientData * clientDataPtr));
+EXTERN CONST84_RETURN char * Tcl_PkgRequireEx _ANSI_ARGS_((
+ Tcl_Interp * interp, CONST char * name,
+ CONST char * version, int exact,
+ ClientData * clientDataPtr));
/* 2 */
EXTERN void Tcl_Panic _ANSI_ARGS_(TCL_VARARGS(CONST char *,format));
/* 3 */
@@ -271,9 +272,9 @@ EXTERN void Tcl_CancelIdleCall _ANSI_ARGS_((
EXTERN int Tcl_Close _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Channel chan));
/* 82 */
-EXTERN int Tcl_CommandComplete _ANSI_ARGS_((char * cmd));
+EXTERN int Tcl_CommandComplete _ANSI_ARGS_((CONST char * cmd));
/* 83 */
-EXTERN char * Tcl_Concat _ANSI_ARGS_((int argc,
+EXTERN CONST84_RETURN char * Tcl_Concat _ANSI_ARGS_((int argc,
CONST84 char * CONST * argv));
/* 84 */
EXTERN int Tcl_ConvertElement _ANSI_ARGS_((CONST char * src,
@@ -286,7 +287,7 @@ EXTERN int Tcl_ConvertCountedElement _ANSI_ARGS_((
EXTERN int Tcl_CreateAlias _ANSI_ARGS_((Tcl_Interp * slave,
CONST char * slaveCmd, Tcl_Interp * target,
CONST char * targetCmd, int argc,
- char * CONST * argv));
+ CONST84 char * CONST * argv));
/* 87 */
EXTERN int Tcl_CreateAliasObj _ANSI_ARGS_((Tcl_Interp * slave,
CONST char * slaveCmd, Tcl_Interp * target,
@@ -430,12 +431,12 @@ EXTERN void Tcl_DStringStartSublist _ANSI_ARGS_((
/* 126 */
EXTERN int Tcl_Eof _ANSI_ARGS_((Tcl_Channel chan));
/* 127 */
-EXTERN CONST char * Tcl_ErrnoId _ANSI_ARGS_((void));
+EXTERN CONST84_RETURN char * Tcl_ErrnoId _ANSI_ARGS_((void));
/* 128 */
-EXTERN CONST char * Tcl_ErrnoMsg _ANSI_ARGS_((int err));
+EXTERN CONST84_RETURN char * Tcl_ErrnoMsg _ANSI_ARGS_((int err));
/* 129 */
EXTERN int Tcl_Eval _ANSI_ARGS_((Tcl_Interp * interp,
- char * string));
+ CONST char * string));
/* 130 */
EXTERN int Tcl_EvalFile _ANSI_ARGS_((Tcl_Interp * interp,
CONST char * fileName));
@@ -493,7 +494,7 @@ EXTERN int Tcl_GetAlias _ANSI_ARGS_((Tcl_Interp * interp,
CONST char * slaveCmd,
Tcl_Interp ** targetInterpPtr,
CONST84 char ** targetCmdPtr, int * argcPtr,
- char *** argvPtr));
+ CONST84 char *** argvPtr));
/* 149 */
EXTERN int Tcl_GetAliasObj _ANSI_ARGS_((Tcl_Interp * interp,
CONST char * slaveCmd,
@@ -519,7 +520,8 @@ EXTERN ClientData Tcl_GetChannelInstanceData _ANSI_ARGS_((
/* 155 */
EXTERN int Tcl_GetChannelMode _ANSI_ARGS_((Tcl_Channel chan));
/* 156 */
-EXTERN CONST char * Tcl_GetChannelName _ANSI_ARGS_((Tcl_Channel chan));
+EXTERN CONST84_RETURN char * Tcl_GetChannelName _ANSI_ARGS_((
+ Tcl_Channel chan));
/* 157 */
EXTERN int Tcl_GetChannelOption _ANSI_ARGS_((
Tcl_Interp * interp, Tcl_Channel chan,
@@ -530,12 +532,12 @@ EXTERN Tcl_ChannelType * Tcl_GetChannelType _ANSI_ARGS_((Tcl_Channel chan));
EXTERN int Tcl_GetCommandInfo _ANSI_ARGS_((Tcl_Interp * interp,
CONST char * cmdName, Tcl_CmdInfo * infoPtr));
/* 160 */
-EXTERN CONST char * Tcl_GetCommandName _ANSI_ARGS_((Tcl_Interp * interp,
- Tcl_Command command));
+EXTERN CONST84_RETURN char * Tcl_GetCommandName _ANSI_ARGS_((
+ Tcl_Interp * interp, Tcl_Command command));
/* 161 */
EXTERN int Tcl_GetErrno _ANSI_ARGS_((void));
/* 162 */
-EXTERN CONST char * Tcl_GetHostName _ANSI_ARGS_((void));
+EXTERN CONST84_RETURN char * Tcl_GetHostName _ANSI_ARGS_((void));
/* 163 */
EXTERN int Tcl_GetInterpPath _ANSI_ARGS_((
Tcl_Interp * askInterp,
@@ -568,16 +570,18 @@ EXTERN Tcl_Interp * Tcl_GetSlave _ANSI_ARGS_((Tcl_Interp * interp,
/* 173 */
EXTERN Tcl_Channel Tcl_GetStdChannel _ANSI_ARGS_((int type));
/* 174 */
-EXTERN CONST char * Tcl_GetStringResult _ANSI_ARGS_((Tcl_Interp * interp));
+EXTERN CONST84_RETURN char * Tcl_GetStringResult _ANSI_ARGS_((
+ Tcl_Interp * interp));
/* 175 */
-EXTERN CONST char * Tcl_GetVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName, int flags));
+EXTERN CONST84_RETURN char * Tcl_GetVar _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * varName, int flags));
/* 176 */
-EXTERN CONST char * Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, CONST char * part2, int flags));
+EXTERN CONST84_RETURN char * Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * part1, CONST char * part2,
+ int flags));
/* 177 */
EXTERN int Tcl_GlobalEval _ANSI_ARGS_((Tcl_Interp * interp,
- char * command));
+ CONST char * command));
/* 178 */
EXTERN int Tcl_GlobalEvalObj _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_Obj * objPtr));
@@ -604,7 +608,7 @@ EXTERN char * Tcl_JoinPath _ANSI_ARGS_((int argc,
Tcl_DString * resultPtr));
/* 187 */
EXTERN int Tcl_LinkVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName, char * addr, int type));
+ CONST char * varName, char * addr, int type));
/* Slot 188 is reserved */
/* 189 */
EXTERN Tcl_Channel Tcl_MakeFileChannel _ANSI_ARGS_((ClientData handle,
@@ -664,7 +668,7 @@ EXTERN void Tcl_PrintDouble _ANSI_ARGS_((Tcl_Interp * interp,
/* 203 */
EXTERN int Tcl_PutEnv _ANSI_ARGS_((CONST char * string));
/* 204 */
-EXTERN CONST char * Tcl_PosixError _ANSI_ARGS_((Tcl_Interp * interp));
+EXTERN CONST84_RETURN char * Tcl_PosixError _ANSI_ARGS_((Tcl_Interp * interp));
/* 205 */
EXTERN void Tcl_QueueEvent _ANSI_ARGS_((Tcl_Event * evPtr,
Tcl_QueuePosition position));
@@ -767,17 +771,17 @@ EXTERN void Tcl_SetObjResult _ANSI_ARGS_((Tcl_Interp * interp,
EXTERN void Tcl_SetStdChannel _ANSI_ARGS_((Tcl_Channel channel,
int type));
/* 237 */
-EXTERN CONST char * Tcl_SetVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName, CONST char * newValue,
+EXTERN CONST84_RETURN char * Tcl_SetVar _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * varName, CONST char * newValue,
int flags));
/* 238 */
-EXTERN CONST char * Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, CONST char * part2,
+EXTERN CONST84_RETURN char * Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * part1, CONST char * part2,
CONST char * newValue, int flags));
/* 239 */
-EXTERN CONST char * Tcl_SignalId _ANSI_ARGS_((int sig));
+EXTERN CONST84_RETURN char * Tcl_SignalId _ANSI_ARGS_((int sig));
/* 240 */
-EXTERN CONST char * Tcl_SignalMsg _ANSI_ARGS_((int sig));
+EXTERN CONST84_RETURN char * Tcl_SignalMsg _ANSI_ARGS_((int sig));
/* 241 */
EXTERN void Tcl_SourceRCFile _ANSI_ARGS_((Tcl_Interp * interp));
/* 242 */
@@ -799,13 +803,13 @@ EXTERN int Tcl_StringMatch _ANSI_ARGS_((CONST char * str,
EXTERN int Tcl_TellOld _ANSI_ARGS_((Tcl_Channel chan));
/* 247 */
EXTERN int Tcl_TraceVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName, int flags,
+ CONST char * varName, int flags,
Tcl_VarTraceProc * proc,
ClientData clientData));
/* 248 */
EXTERN int Tcl_TraceVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, CONST char * part2, int flags,
- Tcl_VarTraceProc * proc,
+ CONST char * part1, CONST char * part2,
+ int flags, Tcl_VarTraceProc * proc,
ClientData clientData));
/* 249 */
EXTERN char * Tcl_TranslateFileName _ANSI_ARGS_((
@@ -816,49 +820,50 @@ EXTERN int Tcl_Ungets _ANSI_ARGS_((Tcl_Channel chan,
CONST char * str, int len, int atHead));
/* 251 */
EXTERN void Tcl_UnlinkVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName));
+ CONST char * varName));
/* 252 */
EXTERN int Tcl_UnregisterChannel _ANSI_ARGS_((
Tcl_Interp * interp, Tcl_Channel chan));
/* 253 */
EXTERN int Tcl_UnsetVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName, int flags));
+ CONST char * varName, int flags));
/* 254 */
EXTERN int Tcl_UnsetVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, CONST char * part2, int flags));
+ CONST char * part1, CONST char * part2,
+ int flags));
/* 255 */
EXTERN void Tcl_UntraceVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName, int flags,
+ CONST char * varName, int flags,
Tcl_VarTraceProc * proc,
ClientData clientData));
/* 256 */
EXTERN void Tcl_UntraceVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, CONST char * part2, int flags,
- Tcl_VarTraceProc * proc,
+ CONST char * part1, CONST char * part2,
+ int flags, Tcl_VarTraceProc * proc,
ClientData clientData));
/* 257 */
EXTERN void Tcl_UpdateLinkedVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName));
+ CONST char * varName));
/* 258 */
EXTERN int Tcl_UpVar _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * frameName, char * varName,
+ CONST char * frameName, CONST char * varName,
CONST char * localName, int flags));
/* 259 */
EXTERN int Tcl_UpVar2 _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * frameName, char * part1,
+ CONST char * frameName, CONST char * part1,
CONST char * part2, CONST char * localName,
int flags));
/* 260 */
EXTERN int Tcl_VarEval _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
/* 261 */
EXTERN ClientData Tcl_VarTraceInfo _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName, int flags,
+ CONST char * varName, int flags,
Tcl_VarTraceProc * procPtr,
ClientData prevClientData));
/* 262 */
EXTERN ClientData Tcl_VarTraceInfo2 _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, CONST char * part2, int flags,
- Tcl_VarTraceProc * procPtr,
+ CONST char * part1, CONST char * part2,
+ int flags, Tcl_VarTraceProc * procPtr,
ClientData prevClientData));
/* 263 */
EXTERN int Tcl_Write _ANSI_ARGS_((Tcl_Channel chan,
@@ -880,23 +885,25 @@ EXTERN void Tcl_AppendResultVA _ANSI_ARGS_((Tcl_Interp * interp,
EXTERN void Tcl_AppendStringsToObjVA _ANSI_ARGS_((
Tcl_Obj * objPtr, va_list argList));
/* 269 */
-EXTERN CONST char * Tcl_HashStats _ANSI_ARGS_((Tcl_HashTable * tablePtr));
+EXTERN CONST84_RETURN char * Tcl_HashStats _ANSI_ARGS_((
+ Tcl_HashTable * tablePtr));
/* 270 */
-EXTERN CONST char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * str, char ** termPtr));
+EXTERN CONST84_RETURN char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp * interp,
+ CONST char * str, CONST84 char ** termPtr));
/* 271 */
-EXTERN CONST char * Tcl_PkgPresent _ANSI_ARGS_((Tcl_Interp * interp,
+EXTERN CONST84_RETURN char * Tcl_PkgPresent _ANSI_ARGS_((Tcl_Interp * interp,
CONST char * name, CONST char * version,
int exact));
/* 272 */
-EXTERN CONST char * Tcl_PkgPresentEx _ANSI_ARGS_((Tcl_Interp * interp,
- CONST char * name, CONST char * version,
- int exact, ClientData * clientDataPtr));
+EXTERN CONST84_RETURN char * Tcl_PkgPresentEx _ANSI_ARGS_((
+ Tcl_Interp * interp, CONST char * name,
+ CONST char * version, int exact,
+ ClientData * clientDataPtr));
/* 273 */
EXTERN int Tcl_PkgProvide _ANSI_ARGS_((Tcl_Interp * interp,
CONST char * name, CONST char * version));
/* 274 */
-EXTERN CONST char * Tcl_PkgRequire _ANSI_ARGS_((Tcl_Interp * interp,
+EXTERN CONST84_RETURN char * Tcl_PkgRequire _ANSI_ARGS_((Tcl_Interp * interp,
CONST char * name, CONST char * version,
int exact));
/* 275 */
@@ -946,7 +953,7 @@ EXTERN void Tcl_DiscardResult _ANSI_ARGS_((
Tcl_SavedResult * statePtr));
/* 291 */
EXTERN int Tcl_EvalEx _ANSI_ARGS_((Tcl_Interp * interp,
- char * script, int numBytes, int flags));
+ CONST char * script, int numBytes, int flags));
/* 292 */
EXTERN int Tcl_EvalObjv _ANSI_ARGS_((Tcl_Interp * interp,
int objc, Tcl_Obj *CONST objv[], int flags));
@@ -979,7 +986,7 @@ EXTERN Tcl_ThreadId Tcl_GetCurrentThread _ANSI_ARGS_((void));
EXTERN Tcl_Encoding Tcl_GetEncoding _ANSI_ARGS_((Tcl_Interp * interp,
CONST char * name));
/* 302 */
-EXTERN CONST char * Tcl_GetEncodingName _ANSI_ARGS_((
+EXTERN CONST84_RETURN char * Tcl_GetEncodingName _ANSI_ARGS_((
Tcl_Encoding encoding));
/* 303 */
EXTERN void Tcl_GetEncodingNames _ANSI_ARGS_((
@@ -994,7 +1001,8 @@ EXTERN VOID * Tcl_GetThreadData _ANSI_ARGS_((
Tcl_ThreadDataKey * keyPtr, int size));
/* 306 */
EXTERN Tcl_Obj * Tcl_GetVar2Ex _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, CONST char * part2, int flags));
+ CONST char * part1, CONST char * part2,
+ int flags));
/* 307 */
EXTERN ClientData Tcl_InitNotifier _ANSI_ARGS_((void));
/* 308 */
@@ -1026,7 +1034,7 @@ EXTERN int Tcl_SetSystemEncoding _ANSI_ARGS_((
Tcl_Interp * interp, CONST char * name));
/* 317 */
EXTERN Tcl_Obj * Tcl_SetVar2Ex _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, CONST char * part2,
+ CONST char * part1, CONST char * part2,
Tcl_Obj * newValuePtr, int flags));
/* 318 */
EXTERN void Tcl_ThreadAlert _ANSI_ARGS_((Tcl_ThreadId threadId));
@@ -1046,7 +1054,7 @@ EXTERN Tcl_UniChar Tcl_UniCharToUpper _ANSI_ARGS_((int ch));
/* 324 */
EXTERN int Tcl_UniCharToUtf _ANSI_ARGS_((int ch, char * buf));
/* 325 */
-EXTERN CONST char * Tcl_UtfAtIndex _ANSI_ARGS_((CONST char * src,
+EXTERN CONST84_RETURN char * Tcl_UtfAtIndex _ANSI_ARGS_((CONST char * src,
int index));
/* 326 */
EXTERN int Tcl_UtfCharComplete _ANSI_ARGS_((CONST char * src,
@@ -1055,15 +1063,15 @@ EXTERN int Tcl_UtfCharComplete _ANSI_ARGS_((CONST char * src,
EXTERN int Tcl_UtfBackslash _ANSI_ARGS_((CONST char * src,
int * readPtr, char * dst));
/* 328 */
-EXTERN CONST char * Tcl_UtfFindFirst _ANSI_ARGS_((CONST char * src,
+EXTERN CONST84_RETURN char * Tcl_UtfFindFirst _ANSI_ARGS_((CONST char * src,
int ch));
/* 329 */
-EXTERN CONST char * Tcl_UtfFindLast _ANSI_ARGS_((CONST char * src,
+EXTERN CONST84_RETURN char * Tcl_UtfFindLast _ANSI_ARGS_((CONST char * src,
int ch));
/* 330 */
-EXTERN CONST char * Tcl_UtfNext _ANSI_ARGS_((CONST char * src));
+EXTERN CONST84_RETURN char * Tcl_UtfNext _ANSI_ARGS_((CONST char * src));
/* 331 */
-EXTERN CONST char * Tcl_UtfPrev _ANSI_ARGS_((CONST char * src,
+EXTERN CONST84_RETURN char * Tcl_UtfPrev _ANSI_ARGS_((CONST char * src,
CONST char * start));
/* 332 */
EXTERN int Tcl_UtfToExternal _ANSI_ARGS_((Tcl_Interp * interp,
@@ -1094,7 +1102,7 @@ EXTERN int Tcl_WriteObj _ANSI_ARGS_((Tcl_Channel chan,
/* 340 */
EXTERN char * Tcl_GetString _ANSI_ARGS_((Tcl_Obj * objPtr));
/* 341 */
-EXTERN CONST char * Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void));
+EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void));
/* 342 */
EXTERN void Tcl_SetDefaultEncodingDir _ANSI_ARGS_((
CONST char * path));
@@ -1144,25 +1152,25 @@ EXTERN void Tcl_LogCommandInfo _ANSI_ARGS_((Tcl_Interp * interp,
int length));
/* 360 */
EXTERN int Tcl_ParseBraces _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, int numBytes,
+ CONST char * string, int numBytes,
Tcl_Parse * parsePtr, int append,
- char ** termPtr));
+ CONST84 char ** termPtr));
/* 361 */
EXTERN int Tcl_ParseCommand _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, int numBytes, int nested,
- Tcl_Parse * parsePtr));
+ CONST char * string, int numBytes,
+ int nested, Tcl_Parse * parsePtr));
/* 362 */
EXTERN int Tcl_ParseExpr _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, int numBytes,
+ CONST char * string, int numBytes,
Tcl_Parse * parsePtr));
/* 363 */
EXTERN int Tcl_ParseQuotedString _ANSI_ARGS_((
- Tcl_Interp * interp, char * string,
+ Tcl_Interp * interp, CONST char * string,
int numBytes, Tcl_Parse * parsePtr,
- int append, char ** termPtr));
+ int append, CONST84 char ** termPtr));
/* 364 */
EXTERN int Tcl_ParseVarName _ANSI_ARGS_((Tcl_Interp * interp,
- char * string, int numBytes,
+ CONST char * string, int numBytes,
Tcl_Parse * parsePtr, int append));
/* 365 */
EXTERN char * Tcl_GetCwd _ANSI_ARGS_((Tcl_Interp * interp,
@@ -1255,7 +1263,7 @@ EXTERN Tcl_Channel Tcl_GetTopChannel _ANSI_ARGS_((Tcl_Channel chan));
/* 397 */
EXTERN int Tcl_ChannelBuffered _ANSI_ARGS_((Tcl_Channel chan));
/* 398 */
-EXTERN CONST char * Tcl_ChannelName _ANSI_ARGS_((
+EXTERN CONST84_RETURN char * Tcl_ChannelName _ANSI_ARGS_((
Tcl_ChannelType * chanTypePtr));
/* 399 */
EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion _ANSI_ARGS_((
@@ -1568,7 +1576,7 @@ typedef struct TclStubs {
struct TclStubHooks *hooks;
int (*tcl_PkgProvideEx) _ANSI_ARGS_((Tcl_Interp* interp, CONST char* name, CONST char* version, ClientData clientData)); /* 0 */
- CONST char * (*tcl_PkgRequireEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 1 */
+ CONST84_RETURN char * (*tcl_PkgRequireEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 1 */
void (*tcl_Panic) _ANSI_ARGS_(TCL_VARARGS(CONST char *,format)); /* 2 */
char * (*tcl_Alloc) _ANSI_ARGS_((unsigned int size)); /* 3 */
void (*tcl_Free) _ANSI_ARGS_((char * ptr)); /* 4 */
@@ -1665,11 +1673,11 @@ typedef struct TclStubs {
void (*tcl_CallWhenDeleted) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 79 */
void (*tcl_CancelIdleCall) _ANSI_ARGS_((Tcl_IdleProc * idleProc, ClientData clientData)); /* 80 */
int (*tcl_Close) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 81 */
- int (*tcl_CommandComplete) _ANSI_ARGS_((char * cmd)); /* 82 */
- char * (*tcl_Concat) _ANSI_ARGS_((int argc, CONST84 char * CONST * argv)); /* 83 */
+ int (*tcl_CommandComplete) _ANSI_ARGS_((CONST char * cmd)); /* 82 */
+ CONST84_RETURN char * (*tcl_Concat) _ANSI_ARGS_((int argc, CONST84 char * CONST * argv)); /* 83 */
int (*tcl_ConvertElement) _ANSI_ARGS_((CONST char * src, char * dst, int flags)); /* 84 */
int (*tcl_ConvertCountedElement) _ANSI_ARGS_((CONST char * src, int length, char * dst, int flags)); /* 85 */
- int (*tcl_CreateAlias) _ANSI_ARGS_((Tcl_Interp * slave, CONST char * slaveCmd, Tcl_Interp * target, CONST char * targetCmd, int argc, char * CONST * argv)); /* 86 */
+ int (*tcl_CreateAlias) _ANSI_ARGS_((Tcl_Interp * slave, CONST char * slaveCmd, Tcl_Interp * target, CONST char * targetCmd, int argc, CONST84 char * CONST * argv)); /* 86 */
int (*tcl_CreateAliasObj) _ANSI_ARGS_((Tcl_Interp * slave, CONST char * slaveCmd, Tcl_Interp * target, CONST char * targetCmd, int objc, Tcl_Obj *CONST objv[])); /* 87 */
Tcl_Channel (*tcl_CreateChannel) _ANSI_ARGS_((Tcl_ChannelType * typePtr, CONST char * chanName, ClientData instanceData, int mask)); /* 88 */
void (*tcl_CreateChannelHandler) _ANSI_ARGS_((Tcl_Channel chan, int mask, Tcl_ChannelProc * proc, ClientData clientData)); /* 89 */
@@ -1718,9 +1726,9 @@ typedef struct TclStubs {
void (*tcl_DStringSetLength) _ANSI_ARGS_((Tcl_DString * dsPtr, int length)); /* 124 */
void (*tcl_DStringStartSublist) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 125 */
int (*tcl_Eof) _ANSI_ARGS_((Tcl_Channel chan)); /* 126 */
- CONST char * (*tcl_ErrnoId) _ANSI_ARGS_((void)); /* 127 */
- CONST char * (*tcl_ErrnoMsg) _ANSI_ARGS_((int err)); /* 128 */
- int (*tcl_Eval) _ANSI_ARGS_((Tcl_Interp * interp, char * string)); /* 129 */
+ CONST84_RETURN char * (*tcl_ErrnoId) _ANSI_ARGS_((void)); /* 127 */
+ CONST84_RETURN char * (*tcl_ErrnoMsg) _ANSI_ARGS_((int err)); /* 128 */
+ int (*tcl_Eval) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 129 */
int (*tcl_EvalFile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * fileName)); /* 130 */
int (*tcl_EvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 131 */
void (*tcl_EventuallyFree) _ANSI_ARGS_((ClientData clientData, Tcl_FreeProc * freeProc)); /* 132 */
@@ -1739,7 +1747,7 @@ typedef struct TclStubs {
Tcl_HashEntry * (*tcl_FirstHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, Tcl_HashSearch * searchPtr)); /* 145 */
int (*tcl_Flush) _ANSI_ARGS_((Tcl_Channel chan)); /* 146 */
void (*tcl_FreeResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 147 */
- int (*tcl_GetAlias) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveCmd, Tcl_Interp ** targetInterpPtr, CONST84 char ** targetCmdPtr, int * argcPtr, char *** argvPtr)); /* 148 */
+ int (*tcl_GetAlias) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveCmd, Tcl_Interp ** targetInterpPtr, CONST84 char ** targetCmdPtr, int * argcPtr, CONST84 char *** argvPtr)); /* 148 */
int (*tcl_GetAliasObj) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveCmd, Tcl_Interp ** targetInterpPtr, CONST84 char ** targetCmdPtr, int * objcPtr, Tcl_Obj *** objv)); /* 149 */
ClientData (*tcl_GetAssocData) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_InterpDeleteProc ** procPtr)); /* 150 */
Tcl_Channel (*tcl_GetChannel) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * chanName, int * modePtr)); /* 151 */
@@ -1747,13 +1755,13 @@ typedef struct TclStubs {
int (*tcl_GetChannelHandle) _ANSI_ARGS_((Tcl_Channel chan, int direction, ClientData * handlePtr)); /* 153 */
ClientData (*tcl_GetChannelInstanceData) _ANSI_ARGS_((Tcl_Channel chan)); /* 154 */
int (*tcl_GetChannelMode) _ANSI_ARGS_((Tcl_Channel chan)); /* 155 */
- CONST char * (*tcl_GetChannelName) _ANSI_ARGS_((Tcl_Channel chan)); /* 156 */
+ CONST84_RETURN char * (*tcl_GetChannelName) _ANSI_ARGS_((Tcl_Channel chan)); /* 156 */
int (*tcl_GetChannelOption) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, CONST char * optionName, Tcl_DString * dsPtr)); /* 157 */
Tcl_ChannelType * (*tcl_GetChannelType) _ANSI_ARGS_((Tcl_Channel chan)); /* 158 */
int (*tcl_GetCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, Tcl_CmdInfo * infoPtr)); /* 159 */
- CONST char * (*tcl_GetCommandName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command)); /* 160 */
+ CONST84_RETURN char * (*tcl_GetCommandName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command)); /* 160 */
int (*tcl_GetErrno) _ANSI_ARGS_((void)); /* 161 */
- CONST char * (*tcl_GetHostName) _ANSI_ARGS_((void)); /* 162 */
+ CONST84_RETURN char * (*tcl_GetHostName) _ANSI_ARGS_((void)); /* 162 */
int (*tcl_GetInterpPath) _ANSI_ARGS_((Tcl_Interp * askInterp, Tcl_Interp * slaveInterp)); /* 163 */
Tcl_Interp * (*tcl_GetMaster) _ANSI_ARGS_((Tcl_Interp * interp)); /* 164 */
CONST char * (*tcl_GetNameOfExecutable) _ANSI_ARGS_((void)); /* 165 */
@@ -1773,10 +1781,10 @@ typedef struct TclStubs {
int (*tcl_GetServiceMode) _ANSI_ARGS_((void)); /* 171 */
Tcl_Interp * (*tcl_GetSlave) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveName)); /* 172 */
Tcl_Channel (*tcl_GetStdChannel) _ANSI_ARGS_((int type)); /* 173 */
- CONST char * (*tcl_GetStringResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 174 */
- CONST char * (*tcl_GetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags)); /* 175 */
- CONST char * (*tcl_GetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags)); /* 176 */
- int (*tcl_GlobalEval) _ANSI_ARGS_((Tcl_Interp * interp, char * command)); /* 177 */
+ CONST84_RETURN char * (*tcl_GetStringResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 174 */
+ CONST84_RETURN char * (*tcl_GetVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags)); /* 175 */
+ CONST84_RETURN char * (*tcl_GetVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags)); /* 176 */
+ int (*tcl_GlobalEval) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * command)); /* 177 */
int (*tcl_GlobalEvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 178 */
int (*tcl_HideCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, CONST char * hiddenCmdToken)); /* 179 */
int (*tcl_Init) _ANSI_ARGS_((Tcl_Interp * interp)); /* 180 */
@@ -1786,7 +1794,7 @@ typedef struct TclStubs {
int (*tcl_InterpDeleted) _ANSI_ARGS_((Tcl_Interp * interp)); /* 184 */
int (*tcl_IsSafe) _ANSI_ARGS_((Tcl_Interp * interp)); /* 185 */
char * (*tcl_JoinPath) _ANSI_ARGS_((int argc, CONST84 char * CONST * argv, Tcl_DString * resultPtr)); /* 186 */
- int (*tcl_LinkVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, char * addr, int type)); /* 187 */
+ int (*tcl_LinkVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, char * addr, int type)); /* 187 */
void *reserved188;
Tcl_Channel (*tcl_MakeFileChannel) _ANSI_ARGS_((ClientData handle, int mode)); /* 189 */
int (*tcl_MakeSafe) _ANSI_ARGS_((Tcl_Interp * interp)); /* 190 */
@@ -1811,7 +1819,7 @@ typedef struct TclStubs {
void (*tcl_Preserve) _ANSI_ARGS_((ClientData data)); /* 201 */
void (*tcl_PrintDouble) _ANSI_ARGS_((Tcl_Interp * interp, double value, char * dst)); /* 202 */
int (*tcl_PutEnv) _ANSI_ARGS_((CONST char * string)); /* 203 */
- CONST char * (*tcl_PosixError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 204 */
+ CONST84_RETURN char * (*tcl_PosixError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 204 */
void (*tcl_QueueEvent) _ANSI_ARGS_((Tcl_Event * evPtr, Tcl_QueuePosition position)); /* 205 */
int (*tcl_Read) _ANSI_ARGS_((Tcl_Channel chan, char * bufPtr, int toRead)); /* 206 */
#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
@@ -1852,44 +1860,44 @@ typedef struct TclStubs {
void (*tcl_SetObjErrorCode) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * errorObjPtr)); /* 234 */
void (*tcl_SetObjResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * resultObjPtr)); /* 235 */
void (*tcl_SetStdChannel) _ANSI_ARGS_((Tcl_Channel channel, int type)); /* 236 */
- CONST char * (*tcl_SetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, CONST char * newValue, int flags)); /* 237 */
- CONST char * (*tcl_SetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, CONST char * newValue, int flags)); /* 238 */
- CONST char * (*tcl_SignalId) _ANSI_ARGS_((int sig)); /* 239 */
- CONST char * (*tcl_SignalMsg) _ANSI_ARGS_((int sig)); /* 240 */
+ CONST84_RETURN char * (*tcl_SetVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, CONST char * newValue, int flags)); /* 237 */
+ CONST84_RETURN char * (*tcl_SetVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, CONST char * newValue, int flags)); /* 238 */
+ CONST84_RETURN char * (*tcl_SignalId) _ANSI_ARGS_((int sig)); /* 239 */
+ CONST84_RETURN char * (*tcl_SignalMsg) _ANSI_ARGS_((int sig)); /* 240 */
void (*tcl_SourceRCFile) _ANSI_ARGS_((Tcl_Interp * interp)); /* 241 */
int (*tcl_SplitList) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * listStr, int * argcPtr, CONST84 char *** argvPtr)); /* 242 */
void (*tcl_SplitPath) _ANSI_ARGS_((CONST char * path, int * argcPtr, CONST84 char *** argvPtr)); /* 243 */
void (*tcl_StaticPackage) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * pkgName, Tcl_PackageInitProc * initProc, Tcl_PackageInitProc * safeInitProc)); /* 244 */
int (*tcl_StringMatch) _ANSI_ARGS_((CONST char * str, CONST char * pattern)); /* 245 */
int (*tcl_TellOld) _ANSI_ARGS_((Tcl_Channel chan)); /* 246 */
- int (*tcl_TraceVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 247 */
- int (*tcl_TraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 248 */
+ int (*tcl_TraceVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 247 */
+ int (*tcl_TraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 248 */
char * (*tcl_TranslateFileName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_DString * bufferPtr)); /* 249 */
int (*tcl_Ungets) _ANSI_ARGS_((Tcl_Channel chan, CONST char * str, int len, int atHead)); /* 250 */
- void (*tcl_UnlinkVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 251 */
+ void (*tcl_UnlinkVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName)); /* 251 */
int (*tcl_UnregisterChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 252 */
- int (*tcl_UnsetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags)); /* 253 */
- int (*tcl_UnsetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags)); /* 254 */
- void (*tcl_UntraceVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 255 */
- void (*tcl_UntraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 256 */
- void (*tcl_UpdateLinkedVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 257 */
- int (*tcl_UpVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, char * varName, CONST char * localName, int flags)); /* 258 */
- int (*tcl_UpVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, char * part1, CONST char * part2, CONST char * localName, int flags)); /* 259 */
+ int (*tcl_UnsetVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags)); /* 253 */
+ int (*tcl_UnsetVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags)); /* 254 */
+ void (*tcl_UntraceVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 255 */
+ void (*tcl_UntraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 256 */
+ void (*tcl_UpdateLinkedVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName)); /* 257 */
+ int (*tcl_UpVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, CONST char * varName, CONST char * localName, int flags)); /* 258 */
+ int (*tcl_UpVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, CONST char * part1, CONST char * part2, CONST char * localName, int flags)); /* 259 */
int (*tcl_VarEval) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 260 */
- ClientData (*tcl_VarTraceInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 261 */
- ClientData (*tcl_VarTraceInfo2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 262 */
+ ClientData (*tcl_VarTraceInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 261 */
+ ClientData (*tcl_VarTraceInfo2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 262 */
int (*tcl_Write) _ANSI_ARGS_((Tcl_Channel chan, CONST char * s, int slen)); /* 263 */
void (*tcl_WrongNumArgs) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], CONST char * message)); /* 264 */
int (*tcl_DumpActiveMemory) _ANSI_ARGS_((CONST char * fileName)); /* 265 */
void (*tcl_ValidateAllMemory) _ANSI_ARGS_((CONST char * file, int line)); /* 266 */
void (*tcl_AppendResultVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 267 */
void (*tcl_AppendStringsToObjVA) _ANSI_ARGS_((Tcl_Obj * objPtr, va_list argList)); /* 268 */
- CONST char * (*tcl_HashStats) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 269 */
- CONST char * (*tcl_ParseVar) _ANSI_ARGS_((Tcl_Interp * interp, char * str, char ** termPtr)); /* 270 */
- CONST char * (*tcl_PkgPresent) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 271 */
- CONST char * (*tcl_PkgPresentEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 272 */
+ CONST84_RETURN char * (*tcl_HashStats) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 269 */
+ CONST84_RETURN char * (*tcl_ParseVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, CONST84 char ** termPtr)); /* 270 */
+ CONST84_RETURN char * (*tcl_PkgPresent) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 271 */
+ CONST84_RETURN char * (*tcl_PkgPresentEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 272 */
int (*tcl_PkgProvide) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version)); /* 273 */
- CONST char * (*tcl_PkgRequire) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 274 */
+ CONST84_RETURN char * (*tcl_PkgRequire) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 274 */
void (*tcl_SetErrorCodeVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 275 */
int (*tcl_VarEvalVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 276 */
Tcl_Pid (*tcl_WaitPid) _ANSI_ARGS_((Tcl_Pid pid, int * statPtr, int options)); /* 277 */
@@ -1906,7 +1914,7 @@ typedef struct TclStubs {
void (*tcl_CreateThreadExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 288 */
void (*tcl_DeleteThreadExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 289 */
void (*tcl_DiscardResult) _ANSI_ARGS_((Tcl_SavedResult * statePtr)); /* 290 */
- int (*tcl_EvalEx) _ANSI_ARGS_((Tcl_Interp * interp, char * script, int numBytes, int flags)); /* 291 */
+ int (*tcl_EvalEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * script, int numBytes, int flags)); /* 291 */
int (*tcl_EvalObjv) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 292 */
int (*tcl_EvalObjEx) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int flags)); /* 293 */
void (*tcl_ExitThread) _ANSI_ARGS_((int status)); /* 294 */
@@ -1917,11 +1925,11 @@ typedef struct TclStubs {
void (*tcl_FreeEncoding) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 299 */
Tcl_ThreadId (*tcl_GetCurrentThread) _ANSI_ARGS_((void)); /* 300 */
Tcl_Encoding (*tcl_GetEncoding) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 301 */
- CONST char * (*tcl_GetEncodingName) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 302 */
+ CONST84_RETURN char * (*tcl_GetEncodingName) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 302 */
void (*tcl_GetEncodingNames) _ANSI_ARGS_((Tcl_Interp * interp)); /* 303 */
int (*tcl_GetIndexFromObjStruct) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CONST VOID * tablePtr, int offset, CONST char * msg, int flags, int * indexPtr)); /* 304 */
VOID * (*tcl_GetThreadData) _ANSI_ARGS_((Tcl_ThreadDataKey * keyPtr, int size)); /* 305 */
- Tcl_Obj * (*tcl_GetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags)); /* 306 */
+ Tcl_Obj * (*tcl_GetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags)); /* 306 */
ClientData (*tcl_InitNotifier) _ANSI_ARGS_((void)); /* 307 */
void (*tcl_MutexLock) _ANSI_ARGS_((Tcl_Mutex * mutexPtr)); /* 308 */
void (*tcl_MutexUnlock) _ANSI_ARGS_((Tcl_Mutex * mutexPtr)); /* 309 */
@@ -1932,7 +1940,7 @@ typedef struct TclStubs {
void (*tcl_RestoreResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 314 */
void (*tcl_SaveResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 315 */
int (*tcl_SetSystemEncoding) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 316 */
- Tcl_Obj * (*tcl_SetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, Tcl_Obj * newValuePtr, int flags)); /* 317 */
+ Tcl_Obj * (*tcl_SetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, Tcl_Obj * newValuePtr, int flags)); /* 317 */
void (*tcl_ThreadAlert) _ANSI_ARGS_((Tcl_ThreadId threadId)); /* 318 */
void (*tcl_ThreadQueueEvent) _ANSI_ARGS_((Tcl_ThreadId threadId, Tcl_Event* evPtr, Tcl_QueuePosition position)); /* 319 */
Tcl_UniChar (*tcl_UniCharAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 320 */
@@ -1940,13 +1948,13 @@ typedef struct TclStubs {
Tcl_UniChar (*tcl_UniCharToTitle) _ANSI_ARGS_((int ch)); /* 322 */
Tcl_UniChar (*tcl_UniCharToUpper) _ANSI_ARGS_((int ch)); /* 323 */
int (*tcl_UniCharToUtf) _ANSI_ARGS_((int ch, char * buf)); /* 324 */
- CONST char * (*tcl_UtfAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 325 */
+ CONST84_RETURN char * (*tcl_UtfAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 325 */
int (*tcl_UtfCharComplete) _ANSI_ARGS_((CONST char * src, int len)); /* 326 */
int (*tcl_UtfBackslash) _ANSI_ARGS_((CONST char * src, int * readPtr, char * dst)); /* 327 */
- CONST char * (*tcl_UtfFindFirst) _ANSI_ARGS_((CONST char * src, int ch)); /* 328 */
- CONST char * (*tcl_UtfFindLast) _ANSI_ARGS_((CONST char * src, int ch)); /* 329 */
- CONST char * (*tcl_UtfNext) _ANSI_ARGS_((CONST char * src)); /* 330 */
- CONST char * (*tcl_UtfPrev) _ANSI_ARGS_((CONST char * src, CONST char * start)); /* 331 */
+ CONST84_RETURN char * (*tcl_UtfFindFirst) _ANSI_ARGS_((CONST char * src, int ch)); /* 328 */
+ CONST84_RETURN char * (*tcl_UtfFindLast) _ANSI_ARGS_((CONST char * src, int ch)); /* 329 */
+ CONST84_RETURN char * (*tcl_UtfNext) _ANSI_ARGS_((CONST char * src)); /* 330 */
+ CONST84_RETURN char * (*tcl_UtfPrev) _ANSI_ARGS_((CONST char * src, CONST char * start)); /* 331 */
int (*tcl_UtfToExternal) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Encoding encoding, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr)); /* 332 */
char * (*tcl_UtfToExternalDString) _ANSI_ARGS_((Tcl_Encoding encoding, CONST char * src, int srcLen, Tcl_DString * dsPtr)); /* 333 */
int (*tcl_UtfToLower) _ANSI_ARGS_((char * src)); /* 334 */
@@ -1956,7 +1964,7 @@ typedef struct TclStubs {
int (*tcl_WriteChars) _ANSI_ARGS_((Tcl_Channel chan, CONST char * src, int srcLen)); /* 338 */
int (*tcl_WriteObj) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj * objPtr)); /* 339 */
char * (*tcl_GetString) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 340 */
- CONST char * (*tcl_GetDefaultEncodingDir) _ANSI_ARGS_((void)); /* 341 */
+ CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) _ANSI_ARGS_((void)); /* 341 */
void (*tcl_SetDefaultEncodingDir) _ANSI_ARGS_((CONST char * path)); /* 342 */
void (*tcl_AlertNotifier) _ANSI_ARGS_((ClientData clientData)); /* 343 */
void (*tcl_ServiceModeHook) _ANSI_ARGS_((int mode)); /* 344 */
@@ -1975,11 +1983,11 @@ typedef struct TclStubs {
Tcl_Obj * (*tcl_EvalTokens) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); /* 357 */
void (*tcl_FreeParse) _ANSI_ARGS_((Tcl_Parse * parsePtr)); /* 358 */
void (*tcl_LogCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * script, CONST char * command, int length)); /* 359 */
- int (*tcl_ParseBraces) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append, char ** termPtr)); /* 360 */
- int (*tcl_ParseCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, int nested, Tcl_Parse * parsePtr)); /* 361 */
- int (*tcl_ParseExpr) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr)); /* 362 */
- int (*tcl_ParseQuotedString) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append, char ** termPtr)); /* 363 */
- int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append)); /* 364 */
+ int (*tcl_ParseBraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 360 */
+ int (*tcl_ParseCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, int nested, Tcl_Parse * parsePtr)); /* 361 */
+ int (*tcl_ParseExpr) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr)); /* 362 */
+ int (*tcl_ParseQuotedString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 363 */
+ int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append)); /* 364 */
char * (*tcl_GetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 365 */
int (*tcl_Chdir) _ANSI_ARGS_((CONST char * dirName)); /* 366 */
int (*tcl_Access) _ANSI_ARGS_((CONST char * path, int mode)); /* 367 */
@@ -2013,7 +2021,7 @@ typedef struct TclStubs {
int (*tcl_WriteRaw) _ANSI_ARGS_((Tcl_Channel chan, CONST char * src, int srcLen)); /* 395 */
Tcl_Channel (*tcl_GetTopChannel) _ANSI_ARGS_((Tcl_Channel chan)); /* 396 */
int (*tcl_ChannelBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 397 */
- CONST char * (*tcl_ChannelName) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 398 */
+ CONST84_RETURN char * (*tcl_ChannelName) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 398 */
Tcl_ChannelTypeVersion (*tcl_ChannelVersion) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 399 */
Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 400 */
Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 401 */
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 0f71547..6e3b106 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclEnv.c,v 1.15 2002/06/06 17:37:55 das Exp $
+ * RCS: @(#) $Id: tclEnv.c,v 1.16 2002/08/05 03:24:40 dgp Exp $
*/
#include "tclInt.h"
@@ -46,8 +46,8 @@ char **environ = NULL;
*/
static char * EnvTraceProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, char *name1, CONST char *name2,
- int flags));
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
static void ReplaceString _ANSI_ARGS_((CONST char *oldStr,
char *newStr));
void TclSetEnv _ANSI_ARGS_((CONST char *name,
@@ -520,7 +520,7 @@ EnvTraceProc(clientData, interp, name1, name2, flags)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Interpreter whose "env" variable is
* being modified. */
- char *name1; /* Better be "env". */
+ CONST char *name1; /* Better be "env". */
CONST char *name2; /* Name of variable being modified, or NULL
* if whole array is being deleted (UTF-8). */
int flags; /* Indicates what's happening. */
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index 4f0ec61..27365a4 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclEvent.c,v 1.22 2002/05/14 09:44:43 vincentdarley Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.23 2002/08/05 03:24:40 dgp Exp $
*/
#include "tclInt.h"
@@ -111,8 +111,8 @@ static void BgErrorDeleteProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp));
static void HandleBgErrors _ANSI_ARGS_((ClientData clientData));
static char * VwaitVarProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, char *name1, CONST char *name2,
- int flags));
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
/*
*----------------------------------------------------------------------
@@ -222,7 +222,7 @@ HandleBgErrors(clientData)
ClientData clientData; /* Pointer to ErrAssocData structure. */
{
Tcl_Interp *interp;
- char *argv[2];
+ CONST char *argv[2];
int code;
BgError *errPtr;
ErrAssocData *assocPtr = (ErrAssocData *) clientData;
@@ -1012,7 +1012,7 @@ static char *
VwaitVarProc(clientData, interp, name1, name2, flags)
ClientData clientData; /* Pointer to integer to set to 1. */
Tcl_Interp *interp; /* Interpreter containing variable. */
- char *name1; /* Name of variable. */
+ CONST char *name1; /* Name of variable. */
CONST char *name2; /* Second part of variable name. */
int flags; /* Information about what happened. */
{
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 63d47ad..5a91a50 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: tclInt.decls,v 1.53 2002/07/17 18:21:54 msofer Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.54 2002/08/05 03:24:40 dgp Exp $
library tcl
@@ -183,7 +183,7 @@ declare 42 generic {
char * TclpGetUserHome(CONST char *name, Tcl_DString *bufferPtr)
}
declare 43 generic {
- int TclGlobalInvoke(Tcl_Interp *interp, int argc, char **argv, int flags)
+ int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, int flags)
}
declare 44 generic {
int TclGuessPackageName(CONST char *fileName, Tcl_DString *bufPtr)
@@ -216,11 +216,11 @@ declare 51 generic {
int TclInterpInit(Tcl_Interp *interp)
}
declare 52 generic {
- int TclInvoke(Tcl_Interp *interp, int argc, char **argv, int flags)
+ int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, int flags)
}
declare 53 generic {
int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp,
- int argc, char **argv)
+ int argc, CONST84 char **argv)
}
declare 54 generic {
int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp,
@@ -240,7 +240,7 @@ declare 55 generic {
# int TclLooksLikeInt(char *p)
# }
declare 58 generic {
- Var * TclLookupVar(Tcl_Interp *interp, char *part1, CONST char *part2,
+ Var * TclLookupVar(Tcl_Interp *interp, CONST char *part1, CONST char *part2,
int flags, CONST char *msg, int createPart1, int createPart2,
Var **arrayPtrPtr)
}
@@ -351,7 +351,7 @@ declare 81 generic {
# }
declare 88 generic {
char * TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp,
- char *name1, CONST char *name2, int flags)
+ CONST char *name1, CONST char *name2, int flags)
}
declare 89 generic {
int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp,
@@ -374,7 +374,7 @@ declare 93 generic {
}
declare 94 generic {
int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp,
- int argc, char **argv)
+ int argc, CONST84 char **argv)
}
# Replaced by Tcl_FSStat in 8.4:
#declare 95 generic {
@@ -536,7 +536,7 @@ declare 135 generic {
# int TclpChdir(CONST char *dirName)
#}
declare 138 generic {
- CONST char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr)
+ CONST84_RETURN char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr)
}
#declare 139 generic {
# int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
@@ -548,7 +548,7 @@ declare 140 generic {
}
# This is used by TclX, but should otherwise be considered private
declare 141 generic {
- CONST char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
+ CONST84_RETURN char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 142 generic {
int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
@@ -614,13 +614,13 @@ declare 156 generic {
int status)
}
declare 157 generic {
- Var * TclVarTraceExists (Tcl_Interp *interp, char *varName)
+ Var * TclVarTraceExists (Tcl_Interp *interp, CONST char *varName)
}
declare 158 generic {
void TclSetStartupScriptFileName(CONST char *filename)
}
declare 159 generic {
- CONST char *TclGetStartupScriptFileName(void)
+ CONST84_RETURN char *TclGetStartupScriptFileName(void)
}
#declare 160 generic {
# int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators,
@@ -676,12 +676,12 @@ declare 169 generic {
int TclpUtfNcmp2(CONST char *s1, CONST char *s2, unsigned long n)
}
declare 170 generic {
- int TclCheckInterpTraces (Tcl_Interp *interp, char *command, int numChars, \
+ int TclCheckInterpTraces (Tcl_Interp *interp, CONST char *command, int numChars, \
Command *cmdPtr, int result, int traceFlags, int objc, \
Tcl_Obj *CONST objv[])
}
declare 171 generic {
- int TclCheckExecutionTraces (Tcl_Interp *interp, char *command, int numChars, \
+ int TclCheckExecutionTraces (Tcl_Interp *interp, CONST char *command, int numChars, \
Command *cmdPtr, int result, int traceFlags, int objc, \
Tcl_Obj *CONST objv[])
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 9632bdd..9193564 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.109 2002/07/31 14:57:09 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.110 2002/08/05 03:24:41 dgp Exp $
*/
#ifndef _TCLINT
@@ -1594,10 +1594,8 @@ typedef Tcl_Channel (TclOpenFileChannelProc_) _ANSI_ARGS_((Tcl_Interp *interp,
*----------------------------------------------------------------
*/
-typedef int (*TclCmdProcType) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char *argv[]));
-typedef int (*TclObjCmdProcType) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[]));
+typedef Tcl_CmdProc *TclCmdProcType;
+typedef Tcl_ObjCmdProc *TclObjCmdProcType;
/*
*----------------------------------------------------------------
@@ -1738,6 +1736,14 @@ EXTERN Tcl_Obj * TclLsetFlat _ANSI_ARGS_((Tcl_Interp* interp,
Tcl_Obj *CONST indexArray[],
Tcl_Obj* valuePtr
));
+EXTERN int TclParseBackslash _ANSI_ARGS_((CONST char *src,
+ int numBytes, int *readPtr, char *dst));
+EXTERN int TclParseHex _ANSI_ARGS_((CONST char *src, int numBytes,
+ Tcl_UniChar *resultPtr));
+EXTERN int TclParseInteger _ANSI_ARGS_((CONST char *string,
+ int numBytes));
+EXTERN int TclParseWhiteSpace _ANSI_ARGS_((CONST char *src,
+ int numBytes, Tcl_Parse *parsePtr, char *typePtr));
EXTERN int TclpObjAccess _ANSI_ARGS_((Tcl_Obj *filename,
int mode));
EXTERN int TclpObjLstat _ANSI_ARGS_((Tcl_Obj *pathPtr,
@@ -2007,7 +2013,7 @@ EXTERN int Tcl_WhileObjCmd _ANSI_ARGS_((ClientData clientData,
#ifdef MAC_TCL
EXTERN int Tcl_EchoCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST84 char **argv));
EXTERN int Tcl_LsObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
EXTERN int Tcl_BeepObjCmd _ANSI_ARGS_((ClientData clientData,
@@ -2078,13 +2084,13 @@ EXTERN Var * TclObjLookupVar _ANSI_ARGS_((Tcl_Interp *interp,
CONST char *msg, CONST int createPart1,
CONST int createPart2, Var **arrayPtrPtr));
EXTERN Tcl_Obj *TclPtrGetVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr,
- Var *arrayPtr, char *part1, CONST char *part2,
+ Var *arrayPtr, CONST char *part1, CONST char *part2,
CONST int flags));
EXTERN Tcl_Obj *TclPtrSetVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr,
- Var *arrayPtr, char *part1, CONST char *part2,
+ Var *arrayPtr, CONST char *part1, CONST char *part2,
Tcl_Obj *newValuePtr, CONST int flags));
EXTERN Tcl_Obj *TclPtrIncrVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr,
- Var *arrayPtr, char *part1, CONST char *part2,
+ Var *arrayPtr, CONST char *part1, CONST char *part2,
CONST long i, CONST int flags));
/*
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 5d7f063..4309c93 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIntDecls.h,v 1.44 2002/07/17 18:21:54 msofer Exp $
+ * RCS: @(#) $Id: tclIntDecls.h,v 1.45 2002/08/05 03:24:41 dgp Exp $
*/
#ifndef _TCLINTDECLS
@@ -160,7 +160,7 @@ EXTERN char * TclpGetUserHome _ANSI_ARGS_((CONST char * name,
Tcl_DString * bufferPtr));
/* 43 */
EXTERN int TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp * interp,
- int argc, char ** argv, int flags));
+ int argc, CONST84 char ** argv, int flags));
/* 44 */
EXTERN int TclGuessPackageName _ANSI_ARGS_((
CONST char * fileName, Tcl_DString * bufPtr));
@@ -183,11 +183,11 @@ EXTERN void TclInitCompiledLocals _ANSI_ARGS_((
EXTERN int TclInterpInit _ANSI_ARGS_((Tcl_Interp * interp));
/* 52 */
EXTERN int TclInvoke _ANSI_ARGS_((Tcl_Interp * interp, int argc,
- char ** argv, int flags));
+ CONST84 char ** argv, int flags));
/* 53 */
EXTERN int TclInvokeObjectCommand _ANSI_ARGS_((
ClientData clientData, Tcl_Interp * interp,
- int argc, char ** argv));
+ int argc, CONST84 char ** argv));
/* 54 */
EXTERN int TclInvokeStringCommand _ANSI_ARGS_((
ClientData clientData, Tcl_Interp * interp,
@@ -198,8 +198,8 @@ EXTERN Proc * TclIsProc _ANSI_ARGS_((Command * cmdPtr));
/* Slot 57 is reserved */
/* 58 */
EXTERN Var * TclLookupVar _ANSI_ARGS_((Tcl_Interp * interp,
- char * part1, CONST char * part2, int flags,
- CONST char * msg, int createPart1,
+ CONST char * part1, CONST char * part2,
+ int flags, CONST char * msg, int createPart1,
int createPart2, Var ** arrayPtrPtr));
/* Slot 59 is reserved */
/* 60 */
@@ -255,7 +255,7 @@ EXTERN char * TclpRealloc _ANSI_ARGS_((char * ptr,
/* Slot 87 is reserved */
/* 88 */
EXTERN char * TclPrecTraceProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp * interp, char * name1,
+ Tcl_Interp * interp, CONST char * name1,
CONST char * name2, int flags));
/* 89 */
EXTERN int TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp * interp,
@@ -272,7 +272,8 @@ EXTERN int TclProcCompileProc _ANSI_ARGS_((Tcl_Interp * interp,
EXTERN void TclProcDeleteProc _ANSI_ARGS_((ClientData clientData));
/* 94 */
EXTERN int TclProcInterpProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp * interp, int argc, char ** argv));
+ Tcl_Interp * interp, int argc,
+ CONST84 char ** argv));
/* Slot 95 is reserved */
/* 96 */
EXTERN int TclRenameCommand _ANSI_ARGS_((Tcl_Interp * interp,
@@ -410,14 +411,14 @@ EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void));
/* Slot 136 is reserved */
/* Slot 137 is reserved */
/* 138 */
-EXTERN CONST char * TclGetEnv _ANSI_ARGS_((CONST char * name,
+EXTERN CONST84_RETURN char * TclGetEnv _ANSI_ARGS_((CONST char * name,
Tcl_DString * valuePtr));
/* Slot 139 is reserved */
/* 140 */
EXTERN int TclLooksLikeInt _ANSI_ARGS_((CONST char * bytes,
int length));
/* 141 */
-EXTERN CONST char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp * interp,
+EXTERN CONST84_RETURN char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp * interp,
Tcl_DString * cwdPtr));
/* 142 */
EXTERN int TclSetByteCodeFromAny _ANSI_ARGS_((
@@ -458,12 +459,12 @@ EXTERN void TclRegError _ANSI_ARGS_((Tcl_Interp * interp,
CONST char * msg, int status));
/* 157 */
EXTERN Var * TclVarTraceExists _ANSI_ARGS_((Tcl_Interp * interp,
- char * varName));
+ CONST char * varName));
/* 158 */
EXTERN void TclSetStartupScriptFileName _ANSI_ARGS_((
CONST char * filename));
/* 159 */
-EXTERN CONST char * TclGetStartupScriptFileName _ANSI_ARGS_((void));
+EXTERN CONST84_RETURN char * TclGetStartupScriptFileName _ANSI_ARGS_((void));
/* Slot 160 is reserved */
/* 161 */
EXTERN int TclChannelTransform _ANSI_ARGS_((Tcl_Interp * interp,
@@ -491,13 +492,13 @@ EXTERN int TclpUtfNcmp2 _ANSI_ARGS_((CONST char * s1,
CONST char * s2, unsigned long n));
/* 170 */
EXTERN int TclCheckInterpTraces _ANSI_ARGS_((
- Tcl_Interp * interp, char * command,
+ Tcl_Interp * interp, CONST char * command,
int numChars, Command * cmdPtr, int result,
int traceFlags, int objc,
Tcl_Obj *CONST objv[]));
/* 171 */
EXTERN int TclCheckExecutionTraces _ANSI_ARGS_((
- Tcl_Interp * interp, char * command,
+ Tcl_Interp * interp, CONST char * command,
int numChars, Command * cmdPtr, int result,
int traceFlags, int objc,
Tcl_Obj *CONST objv[]));
@@ -565,7 +566,7 @@ typedef struct TclIntStubs {
int (*tclGetOpenMode) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * seekFlagPtr)); /* 40 */
Tcl_Command (*tclGetOriginalCommand) _ANSI_ARGS_((Tcl_Command command)); /* 41 */
char * (*tclpGetUserHome) _ANSI_ARGS_((CONST char * name, Tcl_DString * bufferPtr)); /* 42 */
- int (*tclGlobalInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 43 */
+ int (*tclGlobalInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST84 char ** argv, int flags)); /* 43 */
int (*tclGuessPackageName) _ANSI_ARGS_((CONST char * fileName, Tcl_DString * bufPtr)); /* 44 */
int (*tclHideUnsafeCommands) _ANSI_ARGS_((Tcl_Interp * interp)); /* 45 */
int (*tclInExit) _ANSI_ARGS_((void)); /* 46 */
@@ -574,13 +575,13 @@ typedef struct TclIntStubs {
Tcl_Obj * (*tclIncrVar2) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, long incrAmount, int part1NotParsed)); /* 49 */
void (*tclInitCompiledLocals) _ANSI_ARGS_((Tcl_Interp * interp, CallFrame * framePtr, Namespace * nsPtr)); /* 50 */
int (*tclInterpInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 51 */
- int (*tclInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 52 */
- int (*tclInvokeObjectCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 53 */
+ int (*tclInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST84 char ** argv, int flags)); /* 52 */
+ int (*tclInvokeObjectCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, CONST84 char ** argv)); /* 53 */
int (*tclInvokeStringCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 54 */
Proc * (*tclIsProc) _ANSI_ARGS_((Command * cmdPtr)); /* 55 */
void *reserved56;
void *reserved57;
- Var * (*tclLookupVar) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags, CONST char * msg, int createPart1, int createPart2, Var ** arrayPtrPtr)); /* 58 */
+ Var * (*tclLookupVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, CONST char * msg, int createPart1, int createPart2, Var ** arrayPtrPtr)); /* 58 */
void *reserved59;
int (*tclNeedSpace) _ANSI_ARGS_((CONST char * start, CONST char * end)); /* 60 */
Tcl_Obj * (*tclNewProcBodyObj) _ANSI_ARGS_((Proc * procPtr)); /* 61 */
@@ -610,13 +611,13 @@ typedef struct TclIntStubs {
void *reserved85;
void *reserved86;
void *reserved87;
- char * (*tclPrecTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, char * name1, CONST char * name2, int flags)); /* 88 */
+ char * (*tclPrecTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, CONST char * name1, CONST char * name2, int flags)); /* 88 */
int (*tclPreventAliasLoop) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Interp * cmdInterp, Tcl_Command cmd)); /* 89 */
void *reserved90;
void (*tclProcCleanupProc) _ANSI_ARGS_((Proc * procPtr)); /* 91 */
int (*tclProcCompileProc) _ANSI_ARGS_((Tcl_Interp * interp, Proc * procPtr, Tcl_Obj * bodyPtr, Namespace * nsPtr, CONST char * description, CONST char * procName)); /* 92 */
void (*tclProcDeleteProc) _ANSI_ARGS_((ClientData clientData)); /* 93 */
- int (*tclProcInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 94 */
+ int (*tclProcInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, CONST84 char ** argv)); /* 94 */
void *reserved95;
int (*tclRenameCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * oldName, char * newName)); /* 96 */
void (*tclResetShadowedCmdRefs) _ANSI_ARGS_((Tcl_Interp * interp, Command * newCmdPtr)); /* 97 */
@@ -676,10 +677,10 @@ typedef struct TclIntStubs {
int (*tclpCheckStackSpace) _ANSI_ARGS_((void)); /* 135 */
void *reserved136;
void *reserved137;
- CONST char * (*tclGetEnv) _ANSI_ARGS_((CONST char * name, Tcl_DString * valuePtr)); /* 138 */
+ CONST84_RETURN char * (*tclGetEnv) _ANSI_ARGS_((CONST char * name, Tcl_DString * valuePtr)); /* 138 */
void *reserved139;
int (*tclLooksLikeInt) _ANSI_ARGS_((CONST char * bytes, int length)); /* 140 */
- CONST char * (*tclpGetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 141 */
+ CONST84_RETURN char * (*tclpGetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 141 */
int (*tclSetByteCodeFromAny) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CompileHookProc * hookProc, ClientData clientData)); /* 142 */
int (*tclAddLiteralObj) _ANSI_ARGS_((struct CompileEnv * envPtr, Tcl_Obj * objPtr, LiteralEntry ** litPtrPtr)); /* 143 */
void (*tclHideLiteral) _ANSI_ARGS_((Tcl_Interp * interp, struct CompileEnv * envPtr, int index)); /* 144 */
@@ -695,9 +696,9 @@ typedef struct TclIntStubs {
void *reserved154;
void *reserved155;
void (*tclRegError) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * msg, int status)); /* 156 */
- Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 157 */
+ Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName)); /* 157 */
void (*tclSetStartupScriptFileName) _ANSI_ARGS_((CONST char * filename)); /* 158 */
- CONST char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */
+ CONST84_RETURN char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */
void *reserved160;
int (*tclChannelTransform) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, Tcl_Obj * cmdObjPtr)); /* 161 */
void (*tclChannelEventScriptInvoker) _ANSI_ARGS_((ClientData clientData, int flags)); /* 162 */
@@ -708,8 +709,8 @@ typedef struct TclIntStubs {
void (*tclSetStartupScriptPath) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 167 */
Tcl_Obj * (*tclGetStartupScriptPath) _ANSI_ARGS_((void)); /* 168 */
int (*tclpUtfNcmp2) _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); /* 169 */
- int (*tclCheckInterpTraces) _ANSI_ARGS_((Tcl_Interp * interp, char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 170 */
- int (*tclCheckExecutionTraces) _ANSI_ARGS_((Tcl_Interp * interp, char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 171 */
+ int (*tclCheckInterpTraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 170 */
+ int (*tclCheckExecutionTraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 171 */
} TclIntStubs;
#ifdef __cplusplus
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 77becd1..383bae3 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInterp.c,v 1.15 2002/07/31 12:34:23 msofer Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.16 2002/08/05 03:24:41 dgp Exp $
*/
#include "tclInt.h"
@@ -835,7 +835,7 @@ Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
Tcl_Interp *targetInterp; /* Interpreter for target command. */
CONST char *targetCmd; /* Name of target command. */
int argc; /* How many additional arguments? */
- char * CONST *argv; /* These are the additional args. */
+ CONST char * CONST *argv; /* These are the additional args. */
{
Tcl_Obj *slaveObjPtr, *targetObjPtr;
Tcl_Obj **objv;
@@ -933,7 +933,7 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
Tcl_Interp **targetInterpPtr; /* (Return) target interpreter. */
CONST char **targetNamePtr; /* (Return) name of target command. */
int *argcPtr; /* (Return) count of addnl args. */
- char ***argvPtr; /* (Return) additional arguments. */
+ CONST char ***argvPtr; /* (Return) additional arguments. */
{
InterpInfo *iiPtr;
Tcl_HashEntry *hPtr;
@@ -962,7 +962,8 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
*argcPtr = objc - 1;
}
if (argvPtr != NULL) {
- *argvPtr = (char **) ckalloc((unsigned) sizeof(char *) * (objc - 1));
+ *argvPtr = (CONST char **)
+ ckalloc((unsigned) sizeof(CONST char *) * (objc - 1));
for (i = 1; i < objc; i++) {
*argvPtr[i - 1] = Tcl_GetString(objv[i]);
}
diff --git a/generic/tclLink.c b/generic/tclLink.c
index b81554e..3476766 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclLink.c,v 1.7 2002/03/20 22:47:36 dgp Exp $
+ * RCS: @(#) $Id: tclLink.c,v 1.8 2002/08/05 03:24:41 dgp Exp $
*/
#include "tclInt.h"
@@ -60,8 +60,8 @@ typedef struct Link {
*/
static char * LinkTraceProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, char *name1, CONST char *name2,
- int flags));
+ Tcl_Interp *interp, CONST char *name1,
+ CONST char *name2, int flags));
static Tcl_Obj * ObjValue _ANSI_ARGS_((Link *linkPtr));
/*
@@ -88,7 +88,7 @@ static Tcl_Obj * ObjValue _ANSI_ARGS_((Link *linkPtr));
int
Tcl_LinkVar(interp, varName, addr, type)
Tcl_Interp *interp; /* Interpreter in which varName exists. */
- char *varName; /* Name of a global variable in interp. */
+ CONST char *varName; /* Name of a global variable in interp. */
char *addr; /* Address of a C variable to be linked
* to varName. */
int type; /* Type of C variable: TCL_LINK_INT, etc.
@@ -149,7 +149,7 @@ Tcl_LinkVar(interp, varName, addr, type)
void
Tcl_UnlinkVar(interp, varName)
Tcl_Interp *interp; /* Interpreter containing variable to unlink. */
- char *varName; /* Global variable in interp to unlink. */
+ CONST char *varName; /* Global variable in interp to unlink. */
{
Link *linkPtr;
@@ -187,7 +187,7 @@ Tcl_UnlinkVar(interp, varName)
void
Tcl_UpdateLinkedVar(interp, varName)
Tcl_Interp *interp; /* Interpreter containing variable. */
- char *varName; /* Name of global variable that is linked. */
+ CONST char *varName; /* Name of global variable that is linked. */
{
Link *linkPtr;
int savedFlag;
@@ -229,7 +229,7 @@ static char *
LinkTraceProc(clientData, interp, name1, name2, flags)
ClientData clientData; /* Contains information about the link. */
Tcl_Interp *interp; /* Interpreter containing Tcl variable. */
- char *name1; /* First part of variable name. */
+ CONST char *name1; /* First part of variable name. */
CONST char *name2; /* Second part of variable name. */
int flags; /* Miscellaneous additional information. */
{
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 926fa9f..78581f2 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclObj.c,v 1.34 2002/07/29 15:56:54 msofer Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.35 2002/08/05 03:24:41 dgp Exp $
*/
#include "tclInt.h"
@@ -1209,7 +1209,7 @@ SetBooleanFromAny(interp, objPtr)
* Still might be a string containing the characters representing an
* int or double that wasn't handled above. This would be a string
* like "27" or "1.0" that is non-zero and not "1". Such a string
- * whould result in the boolean value true. We try converting to
+ * would result in the boolean value true. We try converting to
* double. If that succeeds and the resulting double is non-zero, we
* have a "true". Note that numbers can't have embedded NULLs.
*/
diff --git a/generic/tclParse.c b/generic/tclParse.c
index b22df23..230edee 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -8,11 +8,12 @@
*
* Copyright (c) 1997 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 Ajuba Solutions.
+ * Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclParse.c,v 1.21 2002/07/19 10:12:28 dkf Exp $
+ * RCS: @(#) $Id: tclParse.c,v 1.22 2002/08/05 03:24:41 dgp Exp $
*/
#include "tclInt.h"
@@ -31,32 +32,32 @@
* information about its character argument. The following return
* values are defined.
*
- * TYPE_NORMAL - All characters that don't have special significance
- * to the Tcl parser.
- * TYPE_SPACE - The character is a whitespace character other
- * than newline.
- * TYPE_COMMAND_END - Character is newline or semicolon.
- * TYPE_SUBS - Character begins a substitution or has other
- * special meaning in ParseTokens: backslash, dollar
- * sign, open bracket, or null.
- * TYPE_QUOTE - Character is a double quote.
- * TYPE_CLOSE_PAREN - Character is a right parenthesis.
- * TYPE_CLOSE_BRACK - Character is a right square bracket.
- * TYPE_BRACE - Character is a curly brace (either left or right).
+ * TYPE_NORMAL - All characters that don't have special significance
+ * to the Tcl parser.
+ * TYPE_SPACE - The character is a whitespace character other
+ * than newline.
+ * TYPE_COMMAND_END - Character is newline or semicolon.
+ * TYPE_SUBS - Character begins a substitution or has other
+ * special meaning in ParseTokens: backslash, dollar
+ * sign, or open bracket.
+ * TYPE_QUOTE - Character is a double quote.
+ * TYPE_CLOSE_PAREN - Character is a right parenthesis.
+ * TYPE_CLOSE_BRACK - Character is a right square bracket.
+ * TYPE_BRACE - Character is a curly brace (either left or right).
*/
-#define TYPE_NORMAL 0
-#define TYPE_SPACE 0x1
-#define TYPE_COMMAND_END 0x2
-#define TYPE_SUBS 0x4
-#define TYPE_QUOTE 0x8
-#define TYPE_CLOSE_PAREN 0x10
-#define TYPE_CLOSE_BRACK 0x20
-#define TYPE_BRACE 0x40
+#define TYPE_NORMAL 0
+#define TYPE_SPACE 0x1
+#define TYPE_COMMAND_END 0x2
+#define TYPE_SUBS 0x4
+#define TYPE_QUOTE 0x8
+#define TYPE_CLOSE_PAREN 0x10
+#define TYPE_CLOSE_BRACK 0x20
+#define TYPE_BRACE 0x40
-#define CHAR_TYPE(c) (typeTable+128)[(int)(c)]
+#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]
-static CONST char typeTable[] = {
+static CONST char charTypeTable[] = {
/*
* Negative character values, from -128 to -1:
*/
@@ -173,11 +174,13 @@ static CONST char typeTable[] = {
* Prototypes for local procedures defined in this file:
*/
-static int CommandComplete _ANSI_ARGS_((char *script,
- int length));
-static int ParseTokens _ANSI_ARGS_((char *src, int mask,
+static int CommandComplete _ANSI_ARGS_((CONST char *script,
+ int numBytes));
+static int ParseComment _ANSI_ARGS_((CONST char *src, int numBytes,
Tcl_Parse *parsePtr));
-
+static int ParseTokens _ANSI_ARGS_((CONST char *src, int numBytes,
+ int mask, Tcl_Parse *parsePtr));
+
/*
*----------------------------------------------------------------------
*
@@ -209,14 +212,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
Tcl_Interp *interp; /* Interpreter to use for error reporting;
* if NULL, then no error message is
* provided. */
- char *string; /* First character of string containing
- * one or more Tcl commands. The string
- * must be in writable memory and must
- * have one additional byte of space at
- * string[length] where we can
- * temporarily store a 0 sentinel
- * character. */
- int numBytes; /* Total number of bytes in string. If < 0,
+ CONST char *string; /* First character of string containing
+ * one or more Tcl commands. */
+ register int numBytes; /* Total number of bytes in string. If < 0,
* the script consists of all bytes up to
* the first null character. */
int nested; /* Non-zero means this is a nested command:
@@ -229,21 +227,25 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
* information in the structure is
* ignored. */
{
- register char *src; /* Points to current character
+ register CONST char *src; /* Points to current character
* in the command. */
- int type; /* Result returned by CHAR_TYPE(*src). */
+ char type; /* Result returned by CHAR_TYPE(*src). */
Tcl_Token *tokenPtr; /* Pointer to token being filled in. */
int wordIndex; /* Index of word token for current word. */
- char utfBytes[TCL_UTF_MAX]; /* Holds result of backslash substitution. */
int terminators; /* CHAR_TYPE bits that indicate the end
* of a command. */
- char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to
+ CONST char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to
* point to char after terminating one. */
- int length, savedChar;
-
-
+ int scanned;
+
+ if ((string == NULL) && (numBytes>0)) {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC);
+ }
+ return TCL_ERROR;
+ }
if (numBytes < 0) {
- numBytes = (string? strlen(string) : 0);
+ numBytes = strlen(string);
}
parsePtr->commentStart = NULL;
parsePtr->commentSize = 0;
@@ -266,66 +268,15 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
}
/*
- * Temporarily overwrite the character just after the end of the
- * string with a 0 byte. This acts as a sentinel and reduces the
- * number of places where we have to check for the end of the
- * input string. The original value of the byte is restored at
- * the end of the parse.
- */
-
- savedChar = string[numBytes];
- if (savedChar != 0) {
- string[numBytes] = 0;
- }
-
- /*
* Parse any leading space and comments before the first word of the
* command.
*/
- src = string;
- while (1) {
- while ((CHAR_TYPE(*src) == TYPE_SPACE) || (*src == '\n')) {
- src++;
- }
- if ((*src == '\\') && (src[1] == '\n')) {
- /*
- * Skip backslash-newline sequence: it should be treated
- * just like white space.
- */
-
- if ((src + 2) == parsePtr->end) {
- parsePtr->incomplete = 1;
- }
- src += 2;
- continue;
- }
- if (*src != '#') {
- break;
- }
- if (parsePtr->commentStart == NULL) {
- parsePtr->commentStart = src;
- }
- while (1) {
- if (src == parsePtr->end) {
- if (nested) {
- parsePtr->incomplete = nested;
- }
- parsePtr->commentSize = src - parsePtr->commentStart;
- break;
- } else if (*src == '\\') {
- if ((src[1] == '\n') && ((src + 2) == parsePtr->end)) {
- parsePtr->incomplete = 1;
- }
- Tcl_UtfBackslash(src, &length, utfBytes);
- src += length;
- } else if (*src == '\n') {
- src++;
- parsePtr->commentSize = src - parsePtr->commentStart;
- break;
- } else {
- src++;
- }
+ scanned = ParseComment(string, numBytes, parsePtr);
+ src = (string + scanned); numBytes -= scanned;
+ if (numBytes == 0) {
+ if (nested) {
+ parsePtr->incomplete = nested;
}
}
@@ -352,19 +303,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
* sequence: it should be treated just like white space.
*/
- while (1) {
- type = CHAR_TYPE(*src);
- if (type == TYPE_SPACE) {
- src++;
- continue;
- } else if ((*src == '\\') && (src[1] == '\n')) {
- if ((src + 2) == parsePtr->end) {
- parsePtr->incomplete = 1;
- }
- Tcl_UtfBackslash(src, &length, utfBytes);
- src += length;
- continue;
- }
+ scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
+ src += scanned; numBytes -= scanned;
+ if (numBytes == 0) {
break;
}
if ((type & terminators) != 0) {
@@ -372,9 +313,6 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
src++;
break;
}
- if (src == parsePtr->end) {
- break;
- }
tokenPtr->start = src;
parsePtr->numTokens++;
parsePtr->numWords++;
@@ -386,28 +324,28 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
*/
if (*src == '"') {
- if (Tcl_ParseQuotedString(interp, src, (parsePtr->end - src),
- parsePtr, 1, &termPtr) != TCL_OK) {
+ if (Tcl_ParseQuotedString(interp, src, numBytes,
+ parsePtr, 1, &termPtr) != TCL_OK) {
goto error;
}
- src = termPtr;
+ src = termPtr; numBytes = parsePtr->end - src;
} else if (*src == '{') {
- if (Tcl_ParseBraces(interp, src, (parsePtr->end - src),
- parsePtr, 1, &termPtr) != TCL_OK) {
+ if (Tcl_ParseBraces(interp, src, numBytes,
+ parsePtr, 1, &termPtr) != TCL_OK) {
goto error;
}
- src = termPtr;
+ src = termPtr; numBytes = parsePtr->end - src;
} else {
/*
* This is an unquoted word. Call ParseTokens and let it do
* all of the work.
*/
- if (ParseTokens(src, TYPE_SPACE|terminators,
+ if (ParseTokens(src, numBytes, TYPE_SPACE|terminators,
parsePtr) != TCL_OK) {
goto error;
}
- src = parsePtr->term;
+ src = parsePtr->term; numBytes = parsePtr->end - src;
}
/*
@@ -431,32 +369,18 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
* command.
*/
- type = CHAR_TYPE(*src);
- if (type == TYPE_SPACE) {
- src++;
+ scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
+ if (scanned) {
+ src += scanned; numBytes -= scanned;
continue;
- } else {
- /*
- * Backslash-newline (and any following white space) must be
- * treated as if it were a space character.
- */
-
- if ((*src == '\\') && (src[1] == '\n')) {
- if ((src + 2) == parsePtr->end) {
- parsePtr->incomplete = 1;
- }
- Tcl_UtfBackslash(src, &length, utfBytes);
- src += length;
- continue;
- }
}
- if ((type & terminators) != 0) {
- parsePtr->term = src;
- src++;
+ if (numBytes == 0) {
break;
}
- if (src == parsePtr->end) {
+ if ((type & terminators) != 0) {
+ parsePtr->term = src;
+ src++;
break;
}
if (src[-1] == '"') {
@@ -476,17 +400,10 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
goto error;
}
-
parsePtr->commandSize = src - parsePtr->commandStart;
- if (savedChar != 0) {
- string[numBytes] = (char) savedChar;
- }
return TCL_OK;
error:
- if (savedChar != 0) {
- string[numBytes] = (char) savedChar;
- }
Tcl_FreeParse(parsePtr);
if (parsePtr->commandStart == NULL) {
parsePtr->commandStart = string;
@@ -494,17 +411,361 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
parsePtr->commandSize = parsePtr->term - parsePtr->commandStart;
return TCL_ERROR;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclParseWhiteSpace --
+ *
+ * Scans up to numBytes bytes starting at src, consuming white
+ * space as defined by Tcl's parsing rules.
+ *
+ * Results:
+ * Returns the number of bytes recognized as white space. Records
+ * at parsePtr, information about the parse. Records at typePtr
+ * the character type of the non-whitespace character that terminated
+ * the scan.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclParseWhiteSpace(src, numBytes, parsePtr, typePtr)
+ CONST char *src; /* First character to parse. */
+ register int numBytes; /* Max number of bytes to scan. */
+ Tcl_Parse *parsePtr; /* Information about parse in progress.
+ * Updated if parsing indicates
+ * an incomplete command. */
+ char *typePtr; /* Points to location to store character
+ * type of character that ends run
+ * of whitespace */
+{
+ register char type = TYPE_NORMAL;
+ register CONST char *p = src;
+
+ while (1) {
+ while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) {
+ numBytes--; p++;
+ }
+ if (numBytes && (type & TYPE_SUBS)) {
+ if (*p != '\\') {
+ break;
+ }
+ if (--numBytes == 0) {
+ break;
+ }
+ if (p[1] != '\n') {
+ break;
+ }
+ p+=2;
+ if (--numBytes == 0) {
+ parsePtr->incomplete = 1;
+ break;
+ }
+ continue;
+ }
+ break;
+ }
+ *typePtr = type;
+ return (p - src);
+}
/*
*----------------------------------------------------------------------
*
+ * TclParseHex --
+ *
+ * Scans a hexadecimal number as a Tcl_UniChar value.
+ * (e.g., for parsing \x and \u escape sequences).
+ * At most numBytes bytes are scanned.
+ *
+ * Results:
+ * The numeric value is stored in *resultPtr.
+ * Returns the number of bytes consumed.
+ *
+ * Notes:
+ * Relies on the following properties of the ASCII
+ * character set, with which UTF-8 is compatible:
+ *
+ * The digits '0' .. '9' and the letters 'A' .. 'Z' and 'a' .. 'z'
+ * occupy consecutive code points, and '0' < 'A' < 'a'.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclParseHex(src, numBytes, resultPtr)
+ CONST char *src; /* First character to parse. */
+ int numBytes; /* Max number of byes to scan */
+ Tcl_UniChar *resultPtr; /* Points to storage provided by
+ * caller where the Tcl_UniChar
+ * resulting from the conversion is
+ * to be written. */
+{
+ Tcl_UniChar result = 0;
+ register CONST char *p = src;
+
+ while (numBytes--) {
+ unsigned char digit = UCHAR(*p);
+
+ if (!isxdigit(digit))
+ break;
+
+ ++p;
+ result <<= 4;
+
+ if (digit >= 'a') {
+ result |= (10 + digit - 'a');
+ } else if (digit >= 'A') {
+ result |= (10 + digit - 'A');
+ } else {
+ result |= (digit - '0');
+ }
+ }
+
+ *resultPtr = result;
+ return (p - src);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclParseBackslash --
+ *
+ * Scans up to numBytes bytes starting at src, consuming a
+ * backslash sequence as defined by Tcl's parsing rules.
+ *
+ * Results:
+ * Records at readPtr the number of bytes making up the backslash
+ * sequence. Records at dst the UTF-8 encoded equivalent of
+ * that backslash sequence. Returns the number of bytes written
+ * to dst, at most TCL_UTF_MAX. Either readPtr or dst may be
+ * NULL, if the results are not needed, but the return value is
+ * the same either way.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TclParseBackslash(src, numBytes, readPtr, dst)
+ CONST char * src; /* Points to the backslash character of a
+ * a backslash sequence */
+ int numBytes; /* Max number of bytes to scan */
+ int *readPtr; /* NULL, or points to storage where the
+ * number of bytes scanned should be written. */
+ char *dst; /* NULL, or points to buffer where the UTF-8
+ * encoding of the backslash sequence is to be
+ * written. At most TCL_UTF_MAX bytes will be
+ * written there. */
+{
+ register CONST char *p = src+1;
+ Tcl_UniChar result;
+ int count;
+ char buf[TCL_UTF_MAX];
+
+ if (numBytes == 0) {
+ if (readPtr != NULL) {
+ *readPtr = 0;
+ }
+ return 0;
+ }
+
+ if (dst == NULL) {
+ dst = buf;
+ }
+
+ if (numBytes == 1) {
+ /* Can only scan the backslash. Return it. */
+ result = '\\';
+ count = 1;
+ goto done;
+ }
+
+ count = 2;
+ switch (*p) {
+ /*
+ * Note: in the conversions below, use absolute values (e.g.,
+ * 0xa) rather than symbolic values (e.g. \n) that get converted
+ * by the compiler. It's possible that compilers on some
+ * platforms will do the symbolic conversions differently, which
+ * could result in non-portable Tcl scripts.
+ */
+
+ case 'a':
+ result = 0x7;
+ break;
+ case 'b':
+ result = 0x8;
+ break;
+ case 'f':
+ result = 0xc;
+ break;
+ case 'n':
+ result = 0xa;
+ break;
+ case 'r':
+ result = 0xd;
+ break;
+ case 't':
+ result = 0x9;
+ break;
+ case 'v':
+ result = 0xb;
+ break;
+ case 'x':
+ count += TclParseHex(p+1, numBytes-1, &result);
+ if (count == 2) {
+ /* No hexadigits -> This is just "x". */
+ result = 'x';
+ } else {
+ /* Keep only the last byte (2 hex digits) */
+ result = (unsigned char) result;
+ }
+ break;
+ case 'u':
+ count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-1, &result);
+ if (count == 2) {
+ /* No hexadigits -> This is just "u". */
+ result = 'u';
+ }
+ break;
+ case '\n':
+ count--;
+ do {
+ p++; count++;
+ } while ((count < numBytes) && ((*p == ' ') || (*p == '\t')));
+ result = ' ';
+ break;
+ case 0:
+ result = '\\';
+ count = 1;
+ break;
+ default:
+ /*
+ * Check for an octal number \oo?o?
+ */
+ if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */
+ result = (unsigned char)(*p - '0');
+ p++;
+ if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */
+ || (UCHAR(*p) >= '8')) {
+ break;
+ }
+ count = 3;
+ result = (unsigned char)((result << 3) + (*p - '0'));
+ p++;
+ if ((numBytes == 3) || !isdigit(UCHAR(*p)) /* INTL: digit */
+ || (UCHAR(*p) >= '8')) {
+ break;
+ }
+ count = 4;
+ result = (unsigned char)((result << 3) + (*p - '0'));
+ break;
+ }
+ /*
+ * We have to convert here in case the user has put a
+ * backslash in front of a multi-byte utf-8 character.
+ * While this means nothing special, we shouldn't break up
+ * a correct utf-8 character. [Bug #217987] test subst-3.2
+ */
+ if (Tcl_UtfCharComplete(p, numBytes - 1)) {
+ count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '\' */
+ } else {
+ char utfBytes[TCL_UTF_MAX];
+ memcpy(utfBytes, p, (size_t) (numBytes - 1));
+ utfBytes[numBytes - 1] = '\0';
+ count = Tcl_UtfToUniChar(utfBytes, &result) + 1;
+ }
+ break;
+ }
+
+ done:
+ if (readPtr != NULL) {
+ *readPtr = count;
+ }
+ return Tcl_UniCharToUtf((int) result, dst);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseComment --
+ *
+ * Scans up to numBytes bytes starting at src, consuming a
+ * Tcl comment as defined by Tcl's parsing rules.
+ *
+ * Results:
+ * Records in parsePtr information about the parse. Returns the
+ * number of bytes consumed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ParseComment(src, numBytes, parsePtr)
+ CONST char *src; /* First character to parse. */
+ register int numBytes; /* Max number of bytes to scan. */
+ Tcl_Parse *parsePtr; /* Information about parse in progress.
+ * Updated if parsing indicates
+ * an incomplete command. */
+{
+ register CONST char *p = src;
+ while (numBytes) {
+ char type;
+ int scanned;
+ do {
+ scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);
+ p += scanned; numBytes -= scanned;
+ } while (numBytes && (*p == '\n') && (p++,numBytes--));
+ if ((numBytes == 0) || (*p != '#')) {
+ break;
+ }
+ if (parsePtr->commentStart == NULL) {
+ parsePtr->commentStart = p;
+ }
+ while (numBytes) {
+ if (*p == '\\') {
+ scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type);
+ if (scanned) {
+ p += scanned; numBytes -= scanned;
+ } else {
+ /*
+ * General backslash substitution in comments isn't
+ * part of the formal spec, but test parse-15.47
+ * and history indicate that it has been the de facto
+ * rule. Don't change it now.
+ */
+ TclParseBackslash(p, numBytes, &scanned, NULL);
+ p += scanned; numBytes -= scanned;
+ }
+ } else {
+ p++; numBytes--;
+ if (p[-1] == '\n') {
+ break;
+ }
+ }
+ }
+ parsePtr->commentSize = p - parsePtr->commentStart;
+ }
+ return (p - src);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ParseTokens --
*
* This procedure forms the heart of the Tcl parser. It parses one
* or more tokens from a string, up to a termination point
* specified by the caller. This procedure is used to parse
* unquoted command words (those not in quotes or braces), words in
- * quotes, and array indices for variables.
+ * quotes, and array indices for variables. No more than numBytes
+ * bytes will be scanned.
*
* Results:
* Tokens are added to parsePtr and parsePtr->term is filled in
@@ -522,8 +783,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr)
*/
static int
-ParseTokens(src, mask, parsePtr)
- register char *src; /* First character to parse. */
+ParseTokens(src, numBytes, mask, parsePtr)
+ register CONST char *src; /* First character to parse. */
+ register int numBytes; /* Max number of bytes to scan. */
int mask; /* Specifies when to stop parsing. The
* parse stops at the first unquoted
* character whose CHAR_TYPE contains
@@ -532,8 +794,8 @@ ParseTokens(src, mask, parsePtr)
* Updated with additional tokens and
* termination information. */
{
- int type, originalTokens, varToken;
- char utfBytes[TCL_UTF_MAX];
+ char type;
+ int originalTokens, varToken;
Tcl_Token *tokenPtr;
Tcl_Parse nested;
@@ -545,7 +807,7 @@ ParseTokens(src, mask, parsePtr)
*/
originalTokens = parsePtr->numTokens;
- while (1) {
+ while (numBytes && !((type = CHAR_TYPE(*src)) & mask)) {
if (parsePtr->numTokens == parsePtr->tokensAvailable) {
TclExpandTokenArray(parsePtr);
}
@@ -553,22 +815,15 @@ ParseTokens(src, mask, parsePtr)
tokenPtr->start = src;
tokenPtr->numComponents = 0;
- type = CHAR_TYPE(*src);
- if (type & mask) {
- break;
- }
-
if ((type & TYPE_SUBS) == 0) {
/*
* This is a simple range of characters. Scan to find the end
* of the range.
*/
- while (1) {
- src++;
- if (CHAR_TYPE(*src) & (mask | TYPE_SUBS)) {
- break;
- }
+ while ((++src, --numBytes)
+ && !(CHAR_TYPE(*src) & (mask | TYPE_SUBS))) {
+ /* empty loop */
}
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->size = src - tokenPtr->start;
@@ -580,11 +835,12 @@ ParseTokens(src, mask, parsePtr)
*/
varToken = parsePtr->numTokens;
- if (Tcl_ParseVarName(parsePtr->interp, src, parsePtr->end - src,
+ if (Tcl_ParseVarName(parsePtr->interp, src, numBytes,
parsePtr, 1) != TCL_OK) {
return TCL_ERROR;
}
src += parsePtr->tokenPtr[varToken].size;
+ numBytes -= parsePtr->tokenPtr[varToken].size;
} else if (*src == '[') {
/*
* Command substitution. Call Tcl_ParseCommand recursively
@@ -592,23 +848,24 @@ ParseTokens(src, mask, parsePtr)
* throw away the parse information.
*/
- src++;
+ src++; numBytes--;
while (1) {
if (Tcl_ParseCommand(parsePtr->interp, src,
- parsePtr->end - src, 1, &nested) != TCL_OK) {
+ numBytes, 1, &nested) != TCL_OK) {
parsePtr->errorType = nested.errorType;
parsePtr->term = nested.term;
parsePtr->incomplete = nested.incomplete;
return TCL_ERROR;
}
src = nested.commandStart + nested.commandSize;
+ numBytes = parsePtr->end - src;
if (nested.tokenPtr != nested.staticTokens) {
ckfree((char *) nested.tokenPtr);
}
if ((*nested.term == ']') && !nested.incomplete) {
break;
}
- if (src == parsePtr->end) {
+ if (numBytes == 0) {
if (parsePtr->interp != NULL) {
Tcl_SetResult(parsePtr->interp,
"missing close-bracket", TCL_STATIC);
@@ -626,9 +883,18 @@ ParseTokens(src, mask, parsePtr)
/*
* Backslash substitution.
*/
+ TclParseBackslash(src, numBytes, &tokenPtr->size, NULL);
+
+ if (tokenPtr->size == 1) {
+ /* Just a backslash, due to end of string */
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ parsePtr->numTokens++;
+ src++; numBytes--;
+ continue;
+ }
if (src[1] == '\n') {
- if ((src + 2) == parsePtr->end) {
+ if (numBytes == 2) {
parsePtr->incomplete = 1;
}
@@ -639,28 +905,22 @@ ParseTokens(src, mask, parsePtr)
*/
if (mask & TYPE_SPACE) {
+ if (parsePtr->numTokens == originalTokens) {
+ goto finishToken;
+ }
break;
}
}
+
tokenPtr->type = TCL_TOKEN_BS;
- Tcl_UtfBackslash(src, &tokenPtr->size, utfBytes);
parsePtr->numTokens++;
src += tokenPtr->size;
+ numBytes -= tokenPtr->size;
} else if (*src == 0) {
- /*
- * We encountered a null character. If it is the null
- * character at the end of the string, then return.
- * Otherwise generate a text token for the single
- * character.
- */
-
- if (src == parsePtr->end) {
- break;
- }
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->size = 1;
parsePtr->numTokens++;
- src++;
+ src++; numBytes--;
} else {
panic("ParseTokens encountered unknown character");
}
@@ -671,7 +931,14 @@ ParseTokens(src, mask, parsePtr)
* for the empty range, so that there is always at least one
* token added.
*/
+ if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
+ tokenPtr->start = src;
+ tokenPtr->numComponents = 0;
+ finishToken:
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->size = 0;
parsePtr->numTokens++;
@@ -679,7 +946,7 @@ ParseTokens(src, mask, parsePtr)
parsePtr->term = src;
return TCL_OK;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -708,7 +975,7 @@ Tcl_FreeParse(parsePtr)
parsePtr->tokenPtr = parsePtr->staticTokens;
}
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -746,14 +1013,15 @@ TclExpandTokenArray(parsePtr)
parsePtr->tokenPtr = newPtr;
parsePtr->tokensAvailable = newCount;
}
-
+
/*
*----------------------------------------------------------------------
*
* Tcl_ParseVarName --
*
* Given a string starting with a $ sign, parse off a variable
- * name and return information about the parse.
+ * name and return information about the parse. No more than
+ * numBytes bytes will be scanned.
*
* Results:
* The return value is TCL_OK if the command was parsed
@@ -780,9 +1048,9 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
Tcl_Interp *interp; /* Interpreter to use for error reporting;
* if NULL, then no error message is
* provided. */
- char *string; /* String containing variable name. First
+ CONST char *string; /* String containing variable name. First
* character must be "$". */
- int numBytes; /* Total number of bytes in string. If < 0,
+ register int numBytes; /* Total number of bytes in string. If < 0,
* the string consists of all bytes up to the
* first null character. */
Tcl_Parse *parsePtr; /* Structure to fill in with information
@@ -793,16 +1061,17 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
* it. */
{
Tcl_Token *tokenPtr;
- char *end, *src;
+ register CONST char *src;
unsigned char c;
int varIndex, offset;
Tcl_UniChar ch;
unsigned array;
- if (numBytes >= 0) {
- end = string + numBytes;
- } else {
- end = string + strlen(string);
+ if ((numBytes == 0) || (string == NULL)) {
+ return TCL_ERROR;
+ }
+ if (numBytes < 0) {
+ numBytes = strlen(string);
}
if (!append) {
@@ -811,7 +1080,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
parsePtr->numTokens = 0;
parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
parsePtr->string = string;
- parsePtr->end = end;
+ parsePtr->end = (string + numBytes);
parsePtr->interp = interp;
parsePtr->errorType = TCL_PARSE_SUCCESS;
parsePtr->incomplete = 0;
@@ -833,8 +1102,8 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
varIndex = parsePtr->numTokens;
parsePtr->numTokens++;
tokenPtr++;
- src++;
- if (src >= end) {
+ src++; numBytes--;
+ if (numBytes == 0) {
goto justADollarSign;
}
tokenPtr->type = TCL_TOKEN_TEXT;
@@ -859,26 +1128,23 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
*/
if (*src == '{') {
- src++;
+ src++; numBytes--;
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->start = src;
tokenPtr->numComponents = 0;
- while (1) {
- if (src == end) {
- if (interp != NULL) {
- Tcl_SetResult(interp,
- "missing close-brace for variable name",
+
+ while (numBytes && (*src != '}')) {
+ numBytes--; src++;
+ }
+ if (numBytes == 0) {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "missing close-brace for variable name",
TCL_STATIC);
- }
- parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
- parsePtr->term = tokenPtr->start-1;
- parsePtr->incomplete = 1;
- goto error;
- }
- if (*src == '}') {
- break;
}
- src++;
+ parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
+ parsePtr->term = tokenPtr->start-1;
+ parsePtr->incomplete = 1;
+ goto error;
}
tokenPtr->size = src - tokenPtr->start;
tokenPtr[-1].size = src - tokenPtr[-1].start;
@@ -888,17 +1154,24 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->start = src;
tokenPtr->numComponents = 0;
- while (src != end) {
- offset = Tcl_UtfToUniChar(src, &ch);
+ while (numBytes) {
+ if (Tcl_UtfCharComplete(src, numBytes)) {
+ offset = Tcl_UtfToUniChar(src, &ch);
+ } else {
+ char utfBytes[TCL_UTF_MAX];
+ memcpy(utfBytes, src, (size_t) numBytes);
+ utfBytes[numBytes] = '\0';
+ offset = Tcl_UtfToUniChar(utfBytes, &ch);
+ }
c = UCHAR(ch);
if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */
- src += offset;
+ src += offset; numBytes -= offset;
continue;
}
- if ((c == ':') && (((src+1) != end) && (src[1] == ':'))) {
- src += 2;
- while ((src != end) && (*src == ':')) {
- src += 1;
+ if ((c == ':') && (numBytes != 1) && (src[1] == ':')) {
+ src += 2; numBytes -= 2;
+ while (numBytes && (*src == ':')) {
+ src++; numBytes--;
}
continue;
}
@@ -908,9 +1181,9 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
/*
* Support for empty array names here.
*/
- array = ((src != end) && (*src == '('));
+ array = (numBytes && (*src == '('));
tokenPtr->size = src - tokenPtr->start;
- if (tokenPtr->size == 0 && !array) {
+ if ((tokenPtr->size == 0) && !array) {
goto justADollarSign;
}
parsePtr->numTokens++;
@@ -921,11 +1194,12 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
* since it could contain any number of substitutions.
*/
- if (ParseTokens(src+1, TYPE_CLOSE_PAREN, parsePtr)
+ if (ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN, parsePtr)
!= TCL_OK) {
goto error;
}
- if ((parsePtr->term == end) || (*parsePtr->term != ')')) {
+ if ((parsePtr->term == (src + numBytes))
+ || (*parsePtr->term != ')')) {
if (parsePtr->interp != NULL) {
Tcl_SetResult(parsePtr->interp, "missing )",
TCL_STATIC);
@@ -960,7 +1234,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
Tcl_FreeParse(parsePtr);
return TCL_ERROR;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -986,9 +1260,9 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append)
CONST char *
Tcl_ParseVar(interp, string, termPtr)
Tcl_Interp *interp; /* Context for looking up variable. */
- register char *string; /* String containing variable name.
+ register CONST char *string; /* String containing variable name.
* First character must be "$". */
- char **termPtr; /* If non-NULL, points to word to fill
+ CONST char **termPtr; /* If non-NULL, points to word to fill
* in with character just after last
* one in the variable specifier. */
@@ -1035,7 +1309,7 @@ Tcl_ParseVar(interp, string, termPtr)
Tcl_ResetResult(interp);
return TclGetString(objPtr);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1043,7 +1317,8 @@ Tcl_ParseVar(interp, string, termPtr)
*
* Given a string in braces such as a Tcl command argument or a string
* value in a Tcl expression, this procedure parses the string and
- * returns information about the parse.
+ * returns information about the parse. No more than numBytes bytes
+ * will be scanned.
*
* Results:
* The return value is TCL_OK if the string was parsed successfully and
@@ -1069,9 +1344,9 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
Tcl_Interp *interp; /* Interpreter to use for error reporting;
* if NULL, then no error message is
* provided. */
- char *string; /* String containing the string in braces.
+ CONST char *string; /* String containing the string in braces.
* The first character must be '{'. */
- int numBytes; /* Total number of bytes in string. If < 0,
+ register int numBytes; /* Total number of bytes in string. If < 0,
* the string consists of all bytes up to
* the first null character. */
register Tcl_Parse *parsePtr;
@@ -1081,35 +1356,35 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
* information in parsePtr; zero means
* ignore existing tokens in parsePtr and
* reinitialize it. */
- char **termPtr; /* If non-NULL, points to word in which to
+ CONST char **termPtr; /* If non-NULL, points to word in which to
* store a pointer to the character just
* after the terminating '}' if the parse
* was successful. */
{
- char utfBytes[TCL_UTF_MAX]; /* For result of backslash substitution. */
Tcl_Token *tokenPtr;
- register char *src, *end;
+ register CONST char *src;
int startIndex, level, length;
- if ((numBytes >= 0) || (string == NULL)) {
- end = string + numBytes;
- } else {
- end = string + strlen(string);
+ if ((numBytes == 0) || (string == NULL)) {
+ return TCL_ERROR;
}
-
+ if (numBytes < 0) {
+ numBytes = strlen(string);
+ }
+
if (!append) {
parsePtr->numWords = 0;
parsePtr->tokenPtr = parsePtr->staticTokens;
parsePtr->numTokens = 0;
parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
parsePtr->string = string;
- parsePtr->end = end;
+ parsePtr->end = (string + numBytes);
parsePtr->interp = interp;
parsePtr->errorType = TCL_PARSE_SUCCESS;
}
- src = string+1;
+ src = string;
startIndex = parsePtr->numTokens;
if (parsePtr->numTokens == parsePtr->tokensAvailable) {
@@ -1117,59 +1392,17 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
}
tokenPtr = &parsePtr->tokenPtr[startIndex];
tokenPtr->type = TCL_TOKEN_TEXT;
- tokenPtr->start = src;
+ tokenPtr->start = src+1;
tokenPtr->numComponents = 0;
level = 1;
while (1) {
- while (CHAR_TYPE(*src) == TYPE_NORMAL) {
- src++;
- }
- if (*src == '}') {
- level--;
- if (level == 0) {
+ while (++src, --numBytes) {
+ if (CHAR_TYPE(*src) != TYPE_NORMAL) {
break;
}
- src++;
- } else if (*src == '{') {
- level++;
- src++;
- } else if (*src == '\\') {
- Tcl_UtfBackslash(src, &length, utfBytes);
- if (src[1] == '\n') {
- /*
- * A backslash-newline sequence must be collapsed, even
- * inside braces, so we have to split the word into
- * multiple tokens so that the backslash-newline can be
- * represented explicitly.
- */
-
- if ((src + 2) == end) {
- parsePtr->incomplete = 1;
- }
- tokenPtr->size = (src - tokenPtr->start);
- if (tokenPtr->size != 0) {
- parsePtr->numTokens++;
- }
- if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) {
- TclExpandTokenArray(parsePtr);
- }
- tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
- tokenPtr->type = TCL_TOKEN_BS;
- tokenPtr->start = src;
- tokenPtr->size = length;
- tokenPtr->numComponents = 0;
- parsePtr->numTokens++;
-
- src += length;
- tokenPtr++;
- tokenPtr->type = TCL_TOKEN_TEXT;
- tokenPtr->start = src;
- tokenPtr->numComponents = 0;
- } else {
- src += length;
- }
- } else if (src == end) {
- register int openBrace; /* bool-flag for when scanning back */
+ }
+ if (numBytes == 0) {
+ register int openBrace = 0;
parsePtr->errorType = TCL_PARSE_MISSING_BRACE;
parsePtr->term = string;
@@ -1177,7 +1410,7 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
if (interp == NULL) {
/*
* Skip straight to the exit code since we have no
- * interpreter to put error messages in.
+ * interpreter to put error message in.
*/
goto error;
}
@@ -1185,22 +1418,22 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
Tcl_SetResult(interp, "missing close-brace", TCL_STATIC);
/*
- * Guess if the problem is due to comments by searching
- * the source string for a possible open brace within the
- * context of a comment. Since we aren't performing a
- * full Tcl parse, just look for an open brace preceeded
- * by a '<whitespace>#' on the same line.
+ * Guess if the problem is due to comments by searching
+ * the source string for a possible open brace within the
+ * context of a comment. Since we aren't performing a
+ * full Tcl parse, just look for an open brace preceded
+ * by a '<whitespace>#' on the same line.
*/
- openBrace = 0;
- for (; src>string ; src--) {
+
+ for (; src > string; src--) {
switch (*src) {
- case '{':
- openBrace = 1;
+ case '{':
+ openBrace = 1;
break;
case '\n':
- openBrace = 0;
+ openBrace = 0;
break;
- case '#':
+ case '#' :
if (openBrace && (isspace(UCHAR(src[-1])))) {
Tcl_AppendResult(interp,
": possible unbalanced brace in comment",
@@ -1210,37 +1443,84 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
break;
}
}
- goto error;
- } else {
- src++;
- }
- }
- /*
- * Decide if we need to finish emitting a partially-finished token.
- * There are 3 cases:
- * {abc \newline xyz} or {xyz} - finish emitting "xyz" token
- * {abc \newline} - don't emit token after \newline
- * {} - finish emitting zero-sized token
- * The last case ensures that there is a token (even if empty) that
- * describes the braced string.
- */
+ error:
+ Tcl_FreeParse(parsePtr);
+ return TCL_ERROR;
+ }
+ switch (*src) {
+ case '{':
+ level++;
+ break;
+ case '}':
+ if (--level == 0) {
+
+ /*
+ * Decide if we need to finish emitting a
+ * partially-finished token. There are 3 cases:
+ * {abc \newline xyz} or {xyz}
+ * - finish emitting "xyz" token
+ * {abc \newline}
+ * - don't emit token after \newline
+ * {} - finish emitting zero-sized token
+ *
+ * The last case ensures that there is a token
+ * (even if empty) that describes the braced string.
+ */
- if ((src != tokenPtr->start)
- || (parsePtr->numTokens == startIndex)) {
- tokenPtr->size = (src - tokenPtr->start);
- parsePtr->numTokens++;
- }
- if (termPtr != NULL) {
- *termPtr = src+1;
+ if ((src != tokenPtr->start)
+ || (parsePtr->numTokens == startIndex)) {
+ tokenPtr->size = (src - tokenPtr->start);
+ parsePtr->numTokens++;
+ }
+ if (termPtr != NULL) {
+ *termPtr = src+1;
+ }
+ return TCL_OK;
+ }
+ break;
+ case '\\':
+ TclParseBackslash(src, numBytes, &length, NULL);
+ if ((length > 1) && (src[1] == '\n')) {
+ /*
+ * A backslash-newline sequence must be collapsed, even
+ * inside braces, so we have to split the word into
+ * multiple tokens so that the backslash-newline can be
+ * represented explicitly.
+ */
+
+ if (numBytes == 2) {
+ parsePtr->incomplete = 1;
+ }
+ tokenPtr->size = (src - tokenPtr->start);
+ if (tokenPtr->size != 0) {
+ parsePtr->numTokens++;
+ }
+ if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
+ }
+ tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens];
+ tokenPtr->type = TCL_TOKEN_BS;
+ tokenPtr->start = src;
+ tokenPtr->size = length;
+ tokenPtr->numComponents = 0;
+ parsePtr->numTokens++;
+
+ src += length - 1;
+ numBytes -= length - 1;
+ tokenPtr++;
+ tokenPtr->type = TCL_TOKEN_TEXT;
+ tokenPtr->start = src + 1;
+ tokenPtr->numComponents = 0;
+ } else {
+ src += length - 1;
+ numBytes -= length - 1;
+ }
+ break;
+ }
}
- return TCL_OK;
-
- error:
- Tcl_FreeParse(parsePtr);
- return TCL_ERROR;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1248,7 +1528,8 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr)
*
* Given a double-quoted string such as a quoted Tcl command argument
* or a quoted value in a Tcl expression, this procedure parses the
- * string and returns information about the parse.
+ * string and returns information about the parse. No more than
+ * numBytes bytes will be scanned.
*
* Results:
* The return value is TCL_OK if the string was parsed successfully and
@@ -1274,9 +1555,9 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
Tcl_Interp *interp; /* Interpreter to use for error reporting;
* if NULL, then no error message is
* provided. */
- char *string; /* String containing the quoted string.
+ CONST char *string; /* String containing the quoted string.
* The first character must be '"'. */
- int numBytes; /* Total number of bytes in string. If < 0,
+ register int numBytes; /* Total number of bytes in string. If < 0,
* the string consists of all bytes up to
* the first null character. */
register Tcl_Parse *parsePtr;
@@ -1286,31 +1567,30 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
* information in parsePtr; zero means
* ignore existing tokens in parsePtr and
* reinitialize it. */
- char **termPtr; /* If non-NULL, points to word in which to
+ CONST char **termPtr; /* If non-NULL, points to word in which to
* store a pointer to the character just
* after the quoted string's terminating
* close-quote if the parse succeeds. */
{
- char *end;
-
- if ((numBytes >= 0) || (string == NULL)) {
- end = string + numBytes;
- } else {
- end = string + strlen(string);
+ if ((numBytes == 0) || (string == NULL)) {
+ return TCL_ERROR;
}
-
+ if (numBytes < 0) {
+ numBytes = strlen(string);
+ }
+
if (!append) {
parsePtr->numWords = 0;
parsePtr->tokenPtr = parsePtr->staticTokens;
parsePtr->numTokens = 0;
parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
parsePtr->string = string;
- parsePtr->end = end;
+ parsePtr->end = (string + numBytes);
parsePtr->interp = interp;
parsePtr->errorType = TCL_PARSE_SUCCESS;
}
- if (ParseTokens(string+1, TYPE_QUOTE, parsePtr) != TCL_OK) {
+ if (ParseTokens(string+1, numBytes-1, TYPE_QUOTE, parsePtr) != TCL_OK) {
goto error;
}
if (*parsePtr->term != '"') {
@@ -1331,7 +1611,7 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
Tcl_FreeParse(parsePtr);
return TCL_ERROR;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1353,16 +1633,16 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr)
*/
static int
-CommandComplete(script, length)
- char *script; /* Script to check. */
- int length; /* Number of bytes in script. */
+CommandComplete(script, numBytes)
+ CONST char *script; /* Script to check. */
+ int numBytes; /* Number of bytes in script. */
{
Tcl_Parse parse;
- char *p, *end;
+ CONST char *p, *end;
int result;
p = script;
- end = p + length;
+ end = p + numBytes;
while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse)
== TCL_OK) {
p = parse.commandStart + parse.commandSize;
@@ -1379,7 +1659,7 @@ CommandComplete(script, length)
Tcl_FreeParse(&parse);
return result;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1402,11 +1682,11 @@ CommandComplete(script, length)
int
Tcl_CommandComplete(script)
- char *script; /* Script to check. */
+ CONST char *script; /* Script to check. */
{
return CommandComplete(script, (int) strlen(script));
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1430,13 +1710,13 @@ TclObjCommandComplete(objPtr)
Tcl_Obj *objPtr; /* Points to object holding script
* to check. */
{
- char *script;
+ CONST char *script;
int length;
script = Tcl_GetStringFromObj(objPtr, &length);
return CommandComplete(script, length);
}
-
+
/*
*----------------------------------------------------------------------
*
diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c
index 1c6a5f5..077dddb 100644
--- a/generic/tclParseExpr.c
+++ b/generic/tclParseExpr.c
@@ -8,11 +8,12 @@
*
* Copyright (c) 1997 Sun Microsystems, Inc.
* Copyright (c) 1998-2000 by Scriptics Corporation.
+ * Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclParseExpr.c,v 1.14 2002/07/22 10:04:17 dkf Exp $
+ * RCS: @(#) $Id: tclParseExpr.c,v 1.15 2002/08/05 03:24:41 dgp Exp $
*/
#include "tclInt.h"
@@ -55,16 +56,16 @@ typedef struct ParseInfo {
int lexeme; /* Type of last lexeme scanned in expr.
* See below for definitions. Corresponds to
* size characters beginning at start. */
- char *start; /* First character in lexeme. */
+ CONST char *start; /* First character in lexeme. */
int size; /* Number of bytes in lexeme. */
- char *next; /* Position of the next character to be
+ CONST char *next; /* Position of the next character to be
* scanned in the expression string. */
- char *prevEnd; /* Points to the character just after the
+ CONST char *prevEnd; /* Points to the character just after the
* last one in the previous lexeme. Used to
* compute size of subexpression tokens. */
- char *originalExpr; /* Points to the start of the expression
+ CONST char *originalExpr; /* Points to the start of the expression
* originally passed to Tcl_ParseExpr. */
- char *lastChar; /* Points just after last byte of expr. */
+ CONST char *lastChar; /* Points just after last byte of expr. */
} ParseInfo;
/*
@@ -148,7 +149,7 @@ static char *lexemeStrings[] = {
static int GetLexeme _ANSI_ARGS_((ParseInfo *infoPtr));
static void LogSyntaxError _ANSI_ARGS_((ParseInfo *infoPtr,
- char *extraInfo));
+ CONST char *extraInfo));
static int ParseAddExpr _ANSI_ARGS_((ParseInfo *infoPtr));
static int ParseBitAndExpr _ANSI_ARGS_((ParseInfo *infoPtr));
static int ParseBitOrExpr _ANSI_ARGS_((ParseInfo *infoPtr));
@@ -157,13 +158,15 @@ static int ParseCondExpr _ANSI_ARGS_((ParseInfo *infoPtr));
static int ParseEqualityExpr _ANSI_ARGS_((ParseInfo *infoPtr));
static int ParseLandExpr _ANSI_ARGS_((ParseInfo *infoPtr));
static int ParseLorExpr _ANSI_ARGS_((ParseInfo *infoPtr));
+static int ParseMaxDoubleLength _ANSI_ARGS_((CONST char *string,
+ CONST char *end));
static int ParseMultiplyExpr _ANSI_ARGS_((ParseInfo *infoPtr));
static int ParsePrimaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
static int ParseRelationalExpr _ANSI_ARGS_((ParseInfo *infoPtr));
static int ParseShiftExpr _ANSI_ARGS_((ParseInfo *infoPtr));
static int ParseUnaryExpr _ANSI_ARGS_((ParseInfo *infoPtr));
-static void PrependSubExprTokens _ANSI_ARGS_((char *op,
- int opBytes, char *src, int srcBytes,
+static void PrependSubExprTokens _ANSI_ARGS_((CONST char *op,
+ int opBytes, CONST char *src, int srcBytes,
int firstIndex, ParseInfo *infoPtr));
/*
@@ -190,7 +193,8 @@ static void PrependSubExprTokens _ANSI_ARGS_((char *op,
* Given a string, this procedure parses the first Tcl expression
* in the string and returns information about the structure of
* the expression. This procedure is the top-level interface to the
- * the expression parsing module.
+ * the expression parsing module. No more that numBytes bytes will
+ * be scanned.
*
* Results:
* The return value is TCL_OK if the command was parsed successfully
@@ -212,7 +216,7 @@ static void PrependSubExprTokens _ANSI_ARGS_((char *op,
int
Tcl_ParseExpr(interp, string, numBytes, parsePtr)
Tcl_Interp *interp; /* Used for error reporting. */
- char *string; /* The source string to parse. */
+ CONST char *string; /* The source string to parse. */
int numBytes; /* Number of bytes in string. If < 0, the
* string consists of all bytes up to the
* first null character. */
@@ -223,7 +227,6 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr)
{
ParseInfo info;
int code;
- char savedChar;
if (numBytes < 0) {
numBytes = (string? strlen(string) : 0);
@@ -250,17 +253,6 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr)
parsePtr->incomplete = 0;
/*
- * Temporarily overwrite the character just after the end of the
- * string with a 0 byte. This acts as a sentinel and reduces the
- * number of places where we have to check for the end of the
- * input string. The original value of the byte is restored at
- * the end of the parse.
- */
-
- savedChar = string[numBytes];
- string[numBytes] = 0;
-
- /*
* Initialize the ParseInfo structure that holds state while parsing
* the expression.
*/
@@ -290,11 +282,9 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr)
LogSyntaxError(&info, "extra tokens at end of expression");
goto error;
}
- string[numBytes] = (char) savedChar;
return TCL_OK;
error:
- string[numBytes] = (char) savedChar;
if (parsePtr->tokenPtr != parsePtr->staticTokens) {
ckfree((char *) parsePtr->tokenPtr);
}
@@ -310,7 +300,7 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr)
* condExpr ::= lorExpr ['?' condExpr ':' condExpr]
*
* Note that this is the topmost recursive-descent parsing routine used
- * by TclParseExpr to parse expressions. This avoids an extra procedure
+ * by Tcl_ParseExpr to parse expressions. This avoids an extra procedure
* call since such a procedure would only return the result of calling
* ParseCondExpr. Other recursive-descent procedures that need to parse
* complete expressions also call ParseCondExpr.
@@ -336,7 +326,7 @@ ParseCondExpr(infoPtr)
Tcl_Parse *parsePtr = infoPtr->parsePtr;
Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr;
int firstIndex, numToMove, code;
- char *srcStart;
+ CONST char *srcStart;
HERE("condExpr", 1);
srcStart = infoPtr->start;
@@ -449,7 +439,7 @@ ParseLorExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("lorExpr", 2);
srcStart = infoPtr->start;
@@ -509,7 +499,7 @@ ParseLandExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("landExpr", 3);
srcStart = infoPtr->start;
@@ -569,7 +559,7 @@ ParseBitOrExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("bitOrExpr", 4);
srcStart = infoPtr->start;
@@ -630,7 +620,7 @@ ParseBitXorExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("bitXorExpr", 5);
srcStart = infoPtr->start;
@@ -691,7 +681,7 @@ ParseBitAndExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("bitAndExpr", 6);
srcStart = infoPtr->start;
@@ -752,7 +742,7 @@ ParseEqualityExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, lexeme, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("equalityExpr", 7);
srcStart = infoPtr->start;
@@ -816,7 +806,7 @@ ParseRelationalExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, lexeme, operatorSize, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("relationalExpr", 8);
srcStart = infoPtr->start;
@@ -884,7 +874,7 @@ ParseShiftExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, lexeme, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("shiftExpr", 9);
srcStart = infoPtr->start;
@@ -946,7 +936,7 @@ ParseAddExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, lexeme, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("addExpr", 10);
srcStart = infoPtr->start;
@@ -1008,7 +998,7 @@ ParseMultiplyExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, lexeme, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("multiplyExpr", 11);
srcStart = infoPtr->start;
@@ -1070,7 +1060,7 @@ ParseUnaryExpr(infoPtr)
{
Tcl_Parse *parsePtr = infoPtr->parsePtr;
int firstIndex, lexeme, code;
- char *srcStart, *operator;
+ CONST char *srcStart, *operator;
HERE("unaryExpr", 12);
srcStart = infoPtr->start;
@@ -1135,7 +1125,7 @@ ParsePrimaryExpr(infoPtr)
Tcl_Interp *interp = parsePtr->interp;
Tcl_Token *tokenPtr, *exprTokenPtr;
Tcl_Parse nested;
- char *dollarPtr, *stringStart, *termPtr, *src;
+ CONST char *dollarPtr, *stringStart, *termPtr, *src;
int lexeme, exprIndex, firstIndex, numToMove, code;
/*
@@ -1394,17 +1384,20 @@ ParsePrimaryExpr(infoPtr)
* serious as this is only done when generating an error.
*/
Interp *iPtr = (Interp *) infoPtr->parsePtr->interp;
- char savedChar;
+ Tcl_DString functionName;
Tcl_HashEntry *hPtr;
/*
- * Look up the name as a function name; note that this
- * requires the expression to be in writable memory.
+ * Look up the name as a function name. We need a writable
+ * copy (DString) so we can terminate it with a NULL for
+ * the benefit of Tcl_FindHashEntry which operates on
+ * NULL-terminated string keys.
*/
- savedChar = tokenPtr->start[tokenPtr->size];
- tokenPtr->start[tokenPtr->size] = '\0';
- hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, tokenPtr->start);
- tokenPtr->start[tokenPtr->size] = savedChar;
+ Tcl_DStringInit(&functionName);
+ hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable,
+ Tcl_DStringAppend(&functionName, tokenPtr->start,
+ tokenPtr->size));
+ Tcl_DStringFree(&functionName);
/*
* Assume that we have an attempted variable reference
@@ -1525,11 +1518,9 @@ GetLexeme(infoPtr)
ParseInfo *infoPtr; /* Holds state needed to parse the expr,
* including the resulting lexeme. */
{
- register char *src; /* Points to current source char. */
- char *termPtr; /* Points to char terminating a literal. */
- double doubleValue; /* Value of a scanned double literal. */
+ register CONST char *src; /* Points to current source char. */
char c;
- int startsWithDigit, offset;
+ int offset, length, numBytes;
Tcl_Parse *parsePtr = infoPtr->parsePtr;
Tcl_Interp *interp = parsePtr->interp;
Tcl_UniChar ch;
@@ -1543,26 +1534,18 @@ GetLexeme(infoPtr)
infoPtr->prevEnd = infoPtr->next;
/*
- * Scan over leading white space at the start of a lexeme. Note that a
- * backslash-newline is treated as a space.
+ * Scan over leading white space at the start of a lexeme.
*/
src = infoPtr->next;
- c = *src;
- while (isspace(UCHAR(c)) || (c == '\\')) { /* INTL: ISO space */
- if (c == '\\') {
- if (src[1] == '\n') {
- src += 2;
- } else {
- break; /* no longer white space */
- }
- } else {
- src++;
- }
- c = *src;
- }
+ numBytes = parsePtr->end - src;
+ do {
+ char type;
+ int scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type);
+ src += scanned; numBytes -= scanned;
+ } while (numBytes && (*src == '\n') && (src++,numBytes--));
parsePtr->term = src;
- if (src >= infoPtr->lastChar) {
+ if (numBytes == 0) {
infoPtr->lexeme = END;
infoPtr->next = src;
return TCL_OK;
@@ -1575,64 +1558,48 @@ GetLexeme(infoPtr)
* by mistake, which would eventually cause a syntax error.
*/
+ c = *src;
if ((c != '+') && (c != '-')) {
- startsWithDigit = isdigit(UCHAR(c)); /* INTL: digit */
- if (startsWithDigit && TclLooksLikeInt(src, -1)) {
- errno = 0;
-#ifdef TCL_WIDE_INT_IS_LONG
- (void) strtoul(src, &termPtr, 0);
-#else
- (void) strtoull(src, &termPtr, 0);
-#endif
- if (errno == ERANGE) {
- if (interp != NULL) {
- char *s = "integer value too large to represent";
- Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1);
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s,
- (char *) NULL);
- }
+ CONST char *end = infoPtr->lastChar;
+ if ((length = TclParseInteger(src, (end - src)))) {
+ /*
+ * First length bytes look like an integer. Verify by
+ * attempting the conversion to the largest integer we have.
+ */
+ int code;
+ Tcl_WideInt wide;
+ Tcl_Obj *value = Tcl_NewStringObj(src, length);
+
+ Tcl_IncrRefCount(value);
+ code = Tcl_GetWideIntFromObj(interp, value, &wide);
+ Tcl_DecrRefCount(value);
+ if (code == TCL_ERROR) {
parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
return TCL_ERROR;
}
- if (termPtr != src) {
- /*
- * src was the start of a valid integer, but was it
- * a bad octal? Stopping at a digit would cause that.
- */
- if (isdigit(UCHAR(*termPtr))) { /* INTL: digit. */
- /*
- * We only want to report an error for the number,
- * but we may have something like "08+1"
- */
- if (interp != NULL) {
- while (isdigit(UCHAR(*(++termPtr)))) {} /* INTL: digit. */
- Tcl_ResetResult(interp);
- offset = termPtr - src;
- c = src[offset];
- src[offset] = 0;
- Tcl_AppendResult(interp, "\"", src,
- "\" is an invalid octal number",
- (char *) NULL);
- src[offset] = c;
- }
- parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
- return TCL_ERROR;
- }
+ infoPtr->lexeme = LITERAL;
+ infoPtr->start = src;
+ infoPtr->size = length;
+ infoPtr->next = (src + length);
+ parsePtr->term = infoPtr->next;
+ return TCL_OK;
+ } else if ((length = ParseMaxDoubleLength(src, end))) {
+ /*
+ * There are length characters that could be a double.
+ * Let strtod() tells us for sure. Need a writable copy
+ * so we can set an terminating NULL to keep strtod from
+ * scanning too far.
+ */
+ char *startPtr, *termPtr;
+ double doubleValue;
+ Tcl_DString toParse;
- infoPtr->lexeme = LITERAL;
- infoPtr->start = src;
- infoPtr->size = (termPtr - src);
- infoPtr->next = termPtr;
- parsePtr->term = termPtr;
- return TCL_OK;
- }
- } else if (startsWithDigit || (c == '.')
- || (c == 'i') || (c == 'I') /* Could be 'Inf' */
- || (c == 'n') || (c == 'N')) { /* Could be 'NaN' */
errno = 0;
- doubleValue = strtod(src, &termPtr);
- if (termPtr != src) {
+ Tcl_DStringInit(&toParse);
+ startPtr = Tcl_DStringAppend(&toParse, src, length);
+ doubleValue = strtod(startPtr, &termPtr);
+ Tcl_DStringFree(&toParse);
+ if (termPtr != startPtr) {
if (errno != 0) {
if (interp != NULL) {
TclExprFloatError(interp, doubleValue);
@@ -1642,14 +1609,19 @@ GetLexeme(infoPtr)
}
/*
- * src was the start of a valid double.
+ * startPtr was the start of a valid double, copied
+ * from src.
*/
infoPtr->lexeme = LITERAL;
infoPtr->start = src;
- infoPtr->size = (termPtr - src);
- infoPtr->next = termPtr;
- parsePtr->term = termPtr;
+ if ((termPtr - startPtr) > length) {
+ infoPtr->size = length;
+ } else {
+ infoPtr->size = (termPtr - startPtr);
+ }
+ infoPtr->next = src + infoPtr->size;
+ parsePtr->term = infoPtr->next;
return TCL_OK;
}
}
@@ -1723,72 +1695,69 @@ GetLexeme(infoPtr)
return TCL_OK;
case '<':
- switch (src[1]) {
- case '<':
- infoPtr->lexeme = LEFT_SHIFT;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- break;
- case '=':
- infoPtr->lexeme = LEQ;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- break;
- default:
- infoPtr->lexeme = LESS;
- break;
+ infoPtr->lexeme = LESS;
+ if ((infoPtr->lastChar - src) > 1) {
+ switch (src[1]) {
+ case '<':
+ infoPtr->lexeme = LEFT_SHIFT;
+ infoPtr->size = 2;
+ infoPtr->next = src+2;
+ break;
+ case '=':
+ infoPtr->lexeme = LEQ;
+ infoPtr->size = 2;
+ infoPtr->next = src+2;
+ break;
+ }
}
parsePtr->term = infoPtr->next;
return TCL_OK;
case '>':
- switch (src[1]) {
- case '>':
- infoPtr->lexeme = RIGHT_SHIFT;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- break;
- case '=':
- infoPtr->lexeme = GEQ;
- infoPtr->size = 2;
- infoPtr->next = src+2;
- break;
- default:
- infoPtr->lexeme = GREATER;
- break;
+ infoPtr->lexeme = GREATER;
+ if ((infoPtr->lastChar - src) > 1) {
+ switch (src[1]) {
+ case '>':
+ infoPtr->lexeme = RIGHT_SHIFT;
+ infoPtr->size = 2;
+ infoPtr->next = src+2;
+ break;
+ case '=':
+ infoPtr->lexeme = GEQ;
+ infoPtr->size = 2;
+ infoPtr->next = src+2;
+ break;
+ }
}
parsePtr->term = infoPtr->next;
return TCL_OK;
case '=':
- if (src[1] == '=') {
+ infoPtr->lexeme = UNKNOWN;
+ if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
infoPtr->lexeme = EQUAL;
infoPtr->size = 2;
infoPtr->next = src+2;
- } else {
- infoPtr->lexeme = UNKNOWN;
}
parsePtr->term = infoPtr->next;
return TCL_OK;
case '!':
- if (src[1] == '=') {
+ infoPtr->lexeme = NOT;
+ if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) {
infoPtr->lexeme = NEQ;
infoPtr->size = 2;
infoPtr->next = src+2;
- } else {
- infoPtr->lexeme = NOT;
}
parsePtr->term = infoPtr->next;
return TCL_OK;
case '&':
- if (src[1] == '&') {
+ infoPtr->lexeme = BIT_AND;
+ if ((src[1] == '&') && ((infoPtr->lastChar - src) > 1)) {
infoPtr->lexeme = AND;
infoPtr->size = 2;
infoPtr->next = src+2;
- } else {
- infoPtr->lexeme = BIT_AND;
}
parsePtr->term = infoPtr->next;
return TCL_OK;
@@ -1798,12 +1767,11 @@ GetLexeme(infoPtr)
return TCL_OK;
case '|':
- if (src[1] == '|') {
+ infoPtr->lexeme = BIT_OR;
+ if ((src[1] == '|') && ((infoPtr->lastChar - src) > 1)) {
infoPtr->lexeme = OR;
infoPtr->size = 2;
infoPtr->next = src+2;
- } else {
- infoPtr->lexeme = BIT_OR;
}
parsePtr->term = infoPtr->next;
return TCL_OK;
@@ -1813,7 +1781,7 @@ GetLexeme(infoPtr)
return TCL_OK;
case 'e':
- if (src[1] == 'q') {
+ if ((src[1] == 'q') && ((infoPtr->lastChar - src) > 1)) {
infoPtr->lexeme = STREQ;
infoPtr->size = 2;
infoPtr->next = src+2;
@@ -1824,7 +1792,7 @@ GetLexeme(infoPtr)
}
case 'n':
- if (src[1] == 'e') {
+ if ((src[1] == 'e') && ((infoPtr->lastChar - src) > 1)) {
infoPtr->lexeme = STRNEQ;
infoPtr->size = 2;
infoPtr->next = src+2;
@@ -1836,13 +1804,28 @@ GetLexeme(infoPtr)
default:
checkFuncName:
- offset = Tcl_UtfToUniChar(src, &ch);
+ length = (infoPtr->lastChar - src);
+ if (Tcl_UtfCharComplete(src, length)) {
+ offset = Tcl_UtfToUniChar(src, &ch);
+ } else {
+ char utfBytes[TCL_UTF_MAX];
+ memcpy(utfBytes, src, (size_t) length);
+ utfBytes[length] = '\0';
+ offset = Tcl_UtfToUniChar(utfBytes, &ch);
+ }
c = UCHAR(ch);
if (isalpha(UCHAR(c))) { /* INTL: ISO only. */
infoPtr->lexeme = FUNC_NAME;
while (isalnum(UCHAR(c)) || (c == '_')) { /* INTL: ISO only. */
- src += offset;
- offset = Tcl_UtfToUniChar(src, &ch);
+ src += offset; length -= offset;
+ if (Tcl_UtfCharComplete(src, length)) {
+ offset = Tcl_UtfToUniChar(src, &ch);
+ } else {
+ char utfBytes[TCL_UTF_MAX];
+ memcpy(utfBytes, src, (size_t) length);
+ utfBytes[length] = '\0';
+ offset = Tcl_UtfToUniChar(utfBytes, &ch);
+ }
c = UCHAR(ch);
}
infoPtr->size = (src - infoPtr->start);
@@ -1902,6 +1885,107 @@ GetLexeme(infoPtr)
/*
*----------------------------------------------------------------------
*
+ * TclParseInteger --
+ *
+ * Scans up to numBytes bytes starting at src, and checks whether
+ * the leading bytes look like an integer's string representation.
+ *
+ * Results:
+ * Returns 0 if the leading bytes do not look like an integer.
+ * Otherwise, returns the number of bytes examined that look
+ * like an integer. This may be less than numBytes if the integer
+ * is only the leading part of the string.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclParseInteger(string, numBytes)
+ register CONST char *string;/* The string to examine. */
+ register int numBytes; /* Max number of bytes to scan. */
+{
+ register CONST char *p = string;
+
+ /* Take care of introductory "0x" */
+ if ((numBytes > 1) && (p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {
+ int scanned;
+ Tcl_UniChar ch;
+ p+=2; numBytes -= 2;
+ scanned = TclParseHex(p, numBytes, &ch);
+ if (scanned) {
+ return scanned + 2;
+ }
+ return 0;
+ }
+ while (numBytes && isdigit(UCHAR(*p))) { /* INTL: digit */
+ numBytes--; p++;
+ }
+ if (numBytes == 0) {
+ return (p - string);
+ }
+ if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
+ return (p - string);
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseMaxDoubleLength --
+ *
+ * Scans a sequence of bytes checking that the characters could
+ * be in a string rep of a double.
+ *
+ * Results:
+ * Returns the number of bytes starting with string, runing to, but
+ * not including end, all of which could be part of a string rep.
+ * of a double. Only character identity is used, no actual
+ * parsing is done.
+ *
+ * The legal bytes are '0' - '9', 'A' - 'F', 'a' - 'f',
+ * '.', '+', '-', 'i', 'I', 'n', 'N', 'p', 'P', 'x', and 'X'.
+ * This covers the values "Inf" and "Nan" as well as the
+ * decimal and hexadecimal representations recognized by a
+ * C99-compliant strtod().
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseMaxDoubleLength(string, end)
+ register CONST char *string;/* The string to examine. */
+ CONST char *end; /* Point to the first character past the end
+ * of the string we are examining. */
+{
+ CONST char *p = string;
+ while (p < end) {
+ switch (*p) {
+ case '0': case '1': case '2': case '3': case '4': case '5':
+ case '6': case '7': case '8': case '9': case 'A': case 'B':
+ case 'C': case 'D': case 'E': case 'F': case 'I': case 'N':
+ case 'P': case 'X': case 'a': case 'b': case 'c': case 'd':
+ case 'e': case 'f': case 'i': case 'n': case 'p': case 'x':
+ case '.': case '+': case '-':
+ p++;
+ break;
+ default:
+ goto done;
+ }
+ }
+ done:
+ return (p - string);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* PrependSubExprTokens --
*
* This procedure is called after the operands of an subexpression have
@@ -1921,10 +2005,10 @@ GetLexeme(infoPtr)
static void
PrependSubExprTokens(op, opBytes, src, srcBytes, firstIndex, infoPtr)
- char *op; /* Points to first byte of the operator
+ CONST char *op; /* Points to first byte of the operator
* in the source script. */
int opBytes; /* Number of bytes in the operator. */
- char *src; /* Points to first byte of the subexpression
+ CONST char *src; /* Points to first byte of the subexpression
* in the source script. */
int srcBytes; /* Number of bytes in subexpression's
* source. */
@@ -1984,7 +2068,7 @@ static void
LogSyntaxError(infoPtr, extraInfo)
ParseInfo *infoPtr; /* Holds the parse state for the
* expression being parsed. */
- char *extraInfo; /* String to provide extra information
+ CONST char *extraInfo; /* String to provide extra information
* about the syntax error. */
{
int numBytes = (infoPtr->lastChar - infoPtr->originalExpr);
@@ -1994,8 +2078,8 @@ LogSyntaxError(infoPtr, extraInfo)
sprintf(buffer, "syntax error in expression \"%.60s...\"",
infoPtr->originalExpr);
} else {
- sprintf(buffer, "syntax error in expression \"%s\"",
- infoPtr->originalExpr);
+ sprintf(buffer, "syntax error in expression \"%.*s\"",
+ numBytes, infoPtr->originalExpr);
}
Tcl_ResetResult(infoPtr->parsePtr->interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->parsePtr->interp),
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 57829ba..2d16c7f 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclProc.c,v 1.40 2002/07/25 22:06:35 jenglish Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.41 2002/08/05 03:24:41 dgp Exp $
*/
#include "tclInt.h"
@@ -798,7 +798,7 @@ TclProcInterpProc(clientData, interp, argc, argv)
* invoked. */
int argc; /* Count of number of arguments to this
* procedure. */
- register char **argv; /* Argument values. */
+ register CONST char **argv; /* Argument values. */
{
register Tcl_Obj *objPtr;
register int i;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 2c952e8..26bc889 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -13,11 +13,10 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTest.c,v 1.55 2002/07/22 16:57:47 vincentdarley Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.56 2002/08/05 03:24:41 dgp Exp $
*/
#define TCL_TEST
-
#include "tclInt.h"
#include "tclPort.h"
@@ -124,9 +123,9 @@ static void CleanupTestSetassocdataTests _ANSI_ARGS_((
static void CmdDelProc1 _ANSI_ARGS_((ClientData clientData));
static void CmdDelProc2 _ANSI_ARGS_((ClientData clientData));
static int CmdProc1 _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int CmdProc2 _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static void CmdTraceDeleteProc _ANSI_ARGS_((
ClientData clientData, Tcl_Interp *interp,
int level, char *command, Tcl_CmdProc *cmdProc,
@@ -138,14 +137,14 @@ static void CmdTraceProc _ANSI_ARGS_((ClientData clientData,
int argc, char **argv));
static int CreatedCommandProc _ANSI_ARGS_((
ClientData clientData, Tcl_Interp *interp,
- int argc, char **argv));
+ int argc, CONST char **argv));
static int CreatedCommandProc2 _ANSI_ARGS_((
ClientData clientData, Tcl_Interp *interp,
- int argc, char **argv));
+ int argc, CONST char **argv));
static void DelCallbackProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp));
static int DelCmdProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static void DelDeleteProc _ANSI_ARGS_((ClientData clientData));
static void EncodingFreeProc _ANSI_ARGS_((ClientData clientData));
static int EncodingToUtfProc _ANSI_ARGS_((ClientData clientData,
@@ -161,10 +160,10 @@ static int EncodingFromUtfProc _ANSI_ARGS_((ClientData clientData,
static void ExitProcEven _ANSI_ARGS_((ClientData clientData));
static void ExitProcOdd _ANSI_ARGS_((ClientData clientData));
static int GetTimesCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static void MainLoop _ANSI_ARGS_((void));
static int NoopCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int NoopObjCmd _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
@@ -181,7 +180,7 @@ static void PrintParse _ANSI_ARGS_((Tcl_Interp *interp,
static void SpecialFree _ANSI_ARGS_((char *blockPtr));
static int StaticInitProc _ANSI_ARGS_((Tcl_Interp *interp));
static int TestaccessprocCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int PretendTclpAccess _ANSI_ARGS_((CONST char *path,
int mode));
static int TestAccessProc1 _ANSI_ARGS_((CONST char *path,
@@ -191,25 +190,25 @@ static int TestAccessProc2 _ANSI_ARGS_((CONST char *path,
static int TestAccessProc3 _ANSI_ARGS_((CONST char *path,
int mode));
static int TestasyncCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestcmdinfoCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestcmdtokenCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestcmdtraceCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestchmodCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestcreatecommandCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestdcallCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestdelCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestdelassocdataCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestdstringCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestencodingObjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
@@ -220,31 +219,31 @@ static int TestevalobjvObjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
static int TestexithandlerCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestexprlongCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestexprparserObjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
static int TestexprstringCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestfileCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int TestfilelinkCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
static int TestfeventCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestgetassocdataCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestgetplatformCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestgetvarfullnameCmd _ANSI_ARGS_((
ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[]));
static int TestinterpdeleteCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestlinkCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestlocaleCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
@@ -255,11 +254,11 @@ static int TestMathFunc2 _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, Tcl_Value *args,
Tcl_Value *resultPtr));
static int TestmainthreadCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestsetmainloopCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestexitmainloopCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static Tcl_Channel PretendTclpOpenFileChannel _ANSI_ARGS_((
Tcl_Interp *interp, CONST char *fileName,
CONST char *modeString, int permissions));
@@ -273,7 +272,7 @@ static Tcl_Channel TestOpenFileChannelProc3 _ANSI_ARGS_((
Tcl_Interp *interp, CONST char *fileName,
CONST char *modeString, int permissions));
static int TestpanicCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestparserObjCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]));
@@ -293,18 +292,19 @@ static int TestsaveresultCmd _ANSI_ARGS_((ClientData dummy,
Tcl_Obj *CONST objv[]));
static void TestsaveresultFree _ANSI_ARGS_((char *blockPtr));
static int TestsetassocdataCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestsetCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestsetobjerrorcodeCmd _ANSI_ARGS_((
ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[]));
-static int TestopenfilechannelprocCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+static int TestopenfilechannelprocCmd _ANSI_ARGS_((
+ ClientData dummy, Tcl_Interp *interp, int argc,
+ CONST char **argv));
static int TestsetplatformCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TeststaticpkgCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int PretendTclpStat _ANSI_ARGS_((CONST char *path,
struct stat *buf));
static int TestStatProc1 _ANSI_ARGS_((CONST char *path,
@@ -314,11 +314,11 @@ static int TestStatProc2 _ANSI_ARGS_((CONST char *path,
static int TestStatProc3 _ANSI_ARGS_((CONST char *path,
struct stat *buf));
static int TeststatprocCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TesttranslatefilenameCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestupvarCmd _ANSI_ARGS_((ClientData dummy,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestWrongNumArgsObjCmd _ANSI_ARGS_((
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[]));
@@ -326,9 +326,9 @@ static int TestGetIndexFromObjStructObjCmd _ANSI_ARGS_((
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[]));
static int TestChannelCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
static int TestChannelEventCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
+ Tcl_Interp *interp, int argc, CONST char **argv));
/* Filesystem testing */
static int TestFilesystemObjCmd _ANSI_ARGS_((ClientData dummy,
@@ -664,7 +664,7 @@ TestasyncCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
TestAsyncHandler *asyncPtr, *prevPtr;
int id, code;
@@ -738,7 +738,7 @@ TestasyncCmd(dummy, interp, argc, argv)
break;
}
}
- Tcl_SetResult(interp, argv[3], TCL_VOLATILE);
+ Tcl_SetResult(interp, (char *)argv[3], TCL_VOLATILE);
return code;
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
@@ -757,8 +757,8 @@ AsyncHandlerProc(clientData, interp, code)
int code; /* Current return code from command. */
{
TestAsyncHandler *asyncPtr = (TestAsyncHandler *) clientData;
- CONST char *listArgv[4];
- char string[TCL_INTEGER_SPACE], *cmd;
+ CONST char *listArgv[4], *cmd;
+ char string[TCL_INTEGER_SPACE];
TclFormatInt(string, code);
listArgv[0] = asyncPtr->command;
@@ -775,7 +775,7 @@ AsyncHandlerProc(clientData, interp, code)
* checking is needed here.
*/
}
- ckfree(cmd);
+ ckfree((char *)cmd);
return code;
}
@@ -803,7 +803,7 @@ TestcmdinfoCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_CmdInfo info;
@@ -876,7 +876,7 @@ CmdProc1(clientData, interp, argc, argv)
ClientData clientData; /* String to return. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData,
(char *) NULL);
@@ -889,7 +889,7 @@ CmdProc2(clientData, interp, argc, argv)
ClientData clientData; /* String to return. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData,
(char *) NULL);
@@ -938,7 +938,7 @@ TestcmdtokenCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_Command token;
int *l;
@@ -1002,7 +1002,7 @@ TestcmdtraceCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_DString buffer;
int result;
@@ -1176,7 +1176,7 @@ TestcreatecommandCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
@@ -1209,7 +1209,7 @@ CreatedCommandProc(clientData, interp, argc, argv)
ClientData clientData; /* String to return. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_CmdInfo info;
int found;
@@ -1231,7 +1231,7 @@ CreatedCommandProc2(clientData, interp, argc, argv)
ClientData clientData; /* String to return. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_CmdInfo info;
int found;
@@ -1270,7 +1270,7 @@ TestdcallCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
int i, id;
@@ -1336,7 +1336,7 @@ TestdelCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
DelCmd *dPtr;
Tcl_Interp *slave;
@@ -1366,7 +1366,7 @@ DelCmdProc(clientData, interp, argc, argv)
ClientData clientData; /* String result to return. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
DelCmd *dPtr = (DelCmd *) clientData;
@@ -1411,7 +1411,7 @@ TestdelassocdataCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
@@ -1445,7 +1445,7 @@ TestdstringCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
int count;
@@ -1852,7 +1852,7 @@ TestexithandlerCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
int value;
@@ -1920,7 +1920,7 @@ TestexprlongCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
long exprResult;
char buf[4 + TCL_INTEGER_SPACE];
@@ -1957,7 +1957,7 @@ TestexprstringCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
@@ -2057,7 +2057,7 @@ TestgetassocdataCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
char *res;
@@ -2095,7 +2095,7 @@ TestgetplatformCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
static CONST char *platformStrings[] = { "unix", "mac", "windows" };
TclPlatformType *platform;
@@ -2140,7 +2140,7 @@ TestinterpdeleteCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_Interp *slaveToDelete;
@@ -2181,7 +2181,7 @@ TestlinkCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
static int intVar = 43;
static int boolVar = 4;
@@ -2826,7 +2826,7 @@ TestparsevarObjCmd(clientData, interp, objc, objv)
Tcl_Obj *CONST objv[]; /* The argument objects. */
{
CONST char *value;
- char *name, *termPtr;
+ CONST char *name, *termPtr;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "varName");
@@ -3263,7 +3263,7 @@ TestsetassocdataCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
char *buf;
char *oldData;
@@ -3316,7 +3316,7 @@ TestsetplatformCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
size_t length;
TclPlatformType *platform;
@@ -3371,7 +3371,7 @@ TeststaticpkgCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
int safe, loaded;
@@ -3422,7 +3422,7 @@ TesttranslatefilenameCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_DString buffer;
CONST char *result;
@@ -3464,7 +3464,7 @@ TestupvarCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
int flags = 0;
@@ -3556,7 +3556,7 @@ TestfeventCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
static Tcl_Interp *interp2 = NULL;
int code;
@@ -3628,18 +3628,18 @@ TestpanicCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
- char *argString;
+ CONST char *argString;
/*
* Put the arguments into a var args structure
* Append all of the arguments together separated by spaces
*/
- argString = Tcl_Merge(argc-1, (CONST char **) argv+1);
+ argString = Tcl_Merge(argc-1, argv+1);
panic(argString);
- ckfree(argString);
+ ckfree((char *)argString);
return TCL_OK;
}
@@ -3668,7 +3668,7 @@ TestchmodCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
int i, mode;
char *rest;
@@ -3871,7 +3871,7 @@ GetTimesCmd(unused, interp, argc, argv)
ClientData unused; /* Unused. */
Tcl_Interp *interp; /* The current interpreter. */
int argc; /* The number of arguments. */
- char **argv; /* The argument strings. */
+ CONST char **argv; /* The argument strings. */
{
Interp *iPtr = (Interp *) interp;
int i, n;
@@ -4051,7 +4051,7 @@ NoopCmd(unused, interp, argc, argv)
ClientData unused; /* Unused. */
Tcl_Interp *interp; /* The current interpreter. */
int argc; /* The number of arguments. */
- char **argv; /* The argument strings. */
+ CONST char **argv; /* The argument strings. */
{
return TCL_OK;
}
@@ -4106,7 +4106,7 @@ TestsetCmd(data, interp, argc, argv)
ClientData data; /* Additional flags for Get/SetVar2. */
register Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
int flags = (int) data;
CONST char *value;
@@ -4288,7 +4288,7 @@ TeststatprocCmd (dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
register Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
TclStatProc_ *proc;
int retVal;
@@ -4476,7 +4476,7 @@ TestmainthreadCmd (dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
register Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
if (argc == 1) {
Tcl_Obj *idObj = Tcl_NewLongObj((long)Tcl_GetCurrentThread());
@@ -4536,7 +4536,7 @@ TestsetmainloopCmd (dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
register Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
exitMainLoop = 0;
Tcl_SetMainLoop(MainLoop);
@@ -4565,7 +4565,7 @@ TestexitmainloopCmd (dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
register Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
exitMainLoop = 1;
return TCL_OK;
@@ -4593,7 +4593,7 @@ TestaccessprocCmd (dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
register Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
TclAccessProc_ *proc;
int retVal;
@@ -4705,7 +4705,7 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
register Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
TclOpenFileChannelProc_ *proc;
int retVal;
@@ -4904,9 +4904,9 @@ TestChannelCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Interpreter for result. */
int argc; /* Count of additional args. */
- char **argv; /* Additional arg strings. */
+ CONST char **argv; /* Additional arg strings. */
{
- char *cmdName; /* Sub command. */
+ CONST char *cmdName; /* Sub command. */
Tcl_HashTable *hTblPtr; /* Hash table of channels. */
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
@@ -5332,13 +5332,13 @@ TestChannelEventCmd(dummy, interp, argc, argv)
ClientData dummy; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
int argc; /* Number of arguments. */
- char **argv; /* Argument strings. */
+ CONST char **argv; /* Argument strings. */
{
Tcl_Obj *resultListPtr;
Channel *chanPtr;
ChannelState *statePtr; /* state info for channel */
EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr;
- char *cmd;
+ CONST char *cmd;
int index, i, mask, len;
if ((argc < 3) || (argc > 5)) {
@@ -5602,7 +5602,7 @@ TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- CONST char *ary[] = {
+ char *ary[] = {
"a", "b", "c", "d", "e", "f", (char *)NULL,(char *)NULL
};
int idx,target;
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 897d743..0fccf95 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.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: tclUtf.c,v 1.27 2002/07/19 12:31:10 dkf Exp $
+ * RCS: @(#) $Id: tclUtf.c,v 1.28 2002/08/05 03:24:41 dgp Exp $
*/
#include "tclInt.h"
@@ -778,129 +778,19 @@ Tcl_UtfBackslash(src, readPtr, dst)
char *dst; /* Filled with the bytes represented by the
* backslash sequence. */
{
- register CONST char *p = src+1;
- Tcl_UniChar result;
- int count, n;
- char buf[TCL_UTF_MAX];
-
- if (dst == NULL) {
- dst = buf;
+#define LINE_LENGTH 128
+ int numRead;
+ int result;
+
+ result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst);
+ if (numRead == LINE_LENGTH) {
+ /* We ate a whole line. Pay the price of a strlen() */
+ result = TclParseBackslash(src, (int)strlen(src), &numRead, dst);
}
-
- count = 2;
- switch (*p) {
- /*
- * Note: in the conversions below, use absolute values (e.g.,
- * 0xa) rather than symbolic values (e.g. \n) that get converted
- * by the compiler. It's possible that compilers on some
- * platforms will do the symbolic conversions differently, which
- * could result in non-portable Tcl scripts.
- */
-
- case 'a':
- result = 0x7;
- break;
- case 'b':
- result = 0x8;
- break;
- case 'f':
- result = 0xc;
- break;
- case 'n':
- result = 0xa;
- break;
- case 'r':
- result = 0xd;
- break;
- case 't':
- result = 0x9;
- break;
- case 'v':
- result = 0xb;
- break;
- case 'x':
- if (isxdigit(UCHAR(p[1]))) { /* INTL: digit */
- char *end;
-
- result = (unsigned char) strtoul(p+1, &end, 16);
- count = end - src;
- } else {
- count = 2;
- result = 'x';
- }
- break;
- case 'u':
- result = 0;
- for (count = 0; count < 4; count++) {
- p++;
- if (!isxdigit(UCHAR(*p))) { /* INTL: digit */
- break;
- }
- n = *p - '0';
- if (n > 9) {
- n = n + '0' + 10 - 'A';
- }
- if (n > 16) {
- n = n + 'A' - 'a';
- }
- result = (result << 4) + n;
- }
- if (count == 0) {
- result = 'u';
- }
- count += 2;
- break;
-
- case '\n':
- do {
- p++;
- } while ((*p == ' ') || (*p == '\t'));
- result = ' ';
- count = p - src;
- break;
- case 0:
- result = '\\';
- count = 1;
- break;
- default:
- /*
- * Check for an octal number \oo?o?
- */
- if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */
- result = (unsigned char)(*p - '0');
- p++;
- if (!isdigit(UCHAR(*p)) || (UCHAR(*p) >= '8')) { /* INTL: digit */
- break;
- }
- count = 3;
- result = (unsigned char)((result << 3) + (*p - '0'));
- p++;
- if (!isdigit(UCHAR(*p)) || (UCHAR(*p) >= '8')) { /* INTL: digit */
- break;
- }
- count = 4;
- result = (unsigned char)((result << 3) + (*p - '0'));
- break;
- }
- if (UCHAR(*p) < UNICODE_SELF) {
- result = *p;
- count = 2;
- } else {
- /*
- * We have to convert here because the user has put a
- * backslash in front of a multi-byte utf-8 character.
- * While this means nothing special, we shouldn't break up
- * a correct utf-8 character. [Bug #217987] test subst-3.2
- */
- count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '\' */
- }
- break;
- }
-
if (readPtr != NULL) {
- *readPtr = count;
+ *readPtr = numRead;
}
- return Tcl_UniCharToUtf((int) result, dst);
+ return result;
}
/*
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index ff5e53a..683f752 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUtil.c,v 1.32 2002/06/25 08:59:36 dkf Exp $
+ * RCS: @(#) $Id: tclUtil.c,v 1.33 2002/08/05 03:24:41 dgp Exp $
*/
#include "tclInt.h"
@@ -947,7 +947,7 @@ Tcl_Backslash(src, readPtr)
*----------------------------------------------------------------------
*/
-char *
+CONST char *
Tcl_Concat(argc, argv)
int argc; /* Number of strings to concatenate. */
CONST char * CONST *argv; /* Array of strings to concatenate. */
@@ -1878,7 +1878,7 @@ char *
TclPrecTraceProc(clientData, interp, name1, name2, flags)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Interpreter containing variable. */
- char *name1; /* Name of variable. */
+ CONST char *name1; /* Name of variable. */
CONST char *name2; /* Second part of variable name. */
int flags; /* Information about what happened. */
{
@@ -2124,38 +2124,28 @@ TclLooksLikeInt(bytes, length)
* considered (if they may appear in an
* integer). */
{
- register CONST char *p, *end;
+ register CONST char *p;
+
+ if ((bytes == NULL) && (length > 0)) {
+ Tcl_Panic("TclLooksLikeInt: cannot scan %d bytes from NULL", length);
+ }
if (length < 0) {
- length = (bytes? strlen(bytes) : 0);
+ length = (bytes? strlen(bytes) : 0);
}
- end = (bytes + length);
p = bytes;
- while ((p < end) && isspace(UCHAR(*p))) { /* INTL: ISO space. */
- p++;
+ while (length && isspace(UCHAR(*p))) { /* INTL: ISO space. */
+ length--; p++;
}
- if (p == end) {
- return 0;
+ if (length == 0) {
+ return 0;
}
-
if ((*p == '+') || (*p == '-')) {
- p++;
- }
- if ((p == end) || !isdigit(UCHAR(*p))) { /* INTL: digit */
- return 0;
- }
- p++;
- while ((p < end) && isdigit(UCHAR(*p))) { /* INTL: digit */
- p++;
- }
- if (p == end) {
- return 1;
+ p++; length--;
}
- if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
- return 1;
- }
- return 0;
+
+ return (0 != TclParseInteger(p, length));
}
/*
diff --git a/generic/tclVar.c b/generic/tclVar.c
index b43778e..48cc6e1 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclVar.c,v 1.62 2002/07/27 01:44:24 msofer Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.63 2002/08/05 03:24:41 dgp Exp $
*/
#include "tclInt.h"
@@ -43,13 +43,13 @@ static CONST char *isArrayElement = "name refers to an element in an array";
*/
static int CallVarTraces _ANSI_ARGS_((Interp *iPtr, Var *arrayPtr,
- Var *varPtr, char *part1, CONST char *part2,
+ Var *varPtr, CONST char *part1, CONST char *part2,
int flags, CONST int leaveErrMsg));
static void CleanupVar _ANSI_ARGS_((Var *varPtr,
Var *arrayPtr));
static void DeleteSearches _ANSI_ARGS_((Var *arrayVarPtr));
static void DeleteArray _ANSI_ARGS_((Interp *iPtr,
- char *arrayName, Var *varPtr, int flags));
+ CONST char *arrayName, Var *varPtr, int flags));
static void DisposeTraceResult _ANSI_ARGS_((int flags,
char *result));
static int ObjMakeUpvar _ANSI_ARGS_((Tcl_Interp *interp,
@@ -182,7 +182,7 @@ Var *
TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
arrayPtrPtr)
Tcl_Interp *interp; /* Interpreter to use for lookup. */
- register char *part1; /* If part2 isn't NULL, this is the name of
+ CONST char *part1; /* If part2 isn't NULL, this is the name of
* an array. Otherwise, this
* is a full variable name that could
* include a parenthesized array element. */
@@ -206,19 +206,21 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
Var *varPtr;
CONST char *elName; /* Name of array element or NULL; may be
* same as part2, or may be openParen+1. */
- char *openParen, *closeParen;
+ int openParen, closeParen;
/* If this procedure parses a name into
- * array and index, these point to the
- * parens around the index. Otherwise they
- * are NULL. These are needed to restore
- * the parens after parsing the name. */
- register char *p;
+ * array and index, these are the offsets to
+ * the parens around the index. Otherwise
+ * they are -1. */
+ register CONST char *p;
CONST char *errMsg = NULL;
int index;
+#define VAR_NAME_BUF_SIZE 26
+ char buffer[VAR_NAME_BUF_SIZE];
+ char *newVarName = buffer;
varPtr = NULL;
*arrayPtrPtr = NULL;
- openParen = closeParen = NULL;
+ openParen = closeParen = -1;
/*
* Parse part1 into array name and index.
@@ -233,7 +235,7 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
elName = part2;
for (p = part1; *p ; p++) {
if (*p == '(') {
- openParen = p;
+ openParen = p - part1;
do {
p++;
} while (*p != '\0');
@@ -245,16 +247,23 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
}
return NULL;
}
- closeParen = p;
- *openParen = 0;
- *closeParen = 0;
- elName = openParen+1;
+ closeParen = p - part1;
} else {
- openParen = NULL;
+ openParen = -1;
}
break;
}
}
+ if (openParen != -1) {
+ if (closeParen >= VAR_NAME_BUF_SIZE) {
+ newVarName = ckalloc((unsigned int) (closeParen+1));
+ }
+ memcpy(newVarName, part1, (unsigned int) closeParen);
+ newVarName[openParen] = '\0';
+ newVarName[closeParen] = '\0';
+ part1 = newVarName;
+ elName = newVarName + openParen + 1;
+ }
varPtr = TclLookupSimpleVar(interp, part1, flags,
createPart1, &errMsg, &index);
@@ -272,12 +281,13 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2,
msg, createPart1, createPart2, varPtr);
}
}
-
- if (openParen != NULL) {
- *openParen = '(';
- *closeParen = ')';
+ if (newVarName != buffer) {
+ ckfree(newVarName);
}
+
return varPtr;
+
+#undef VAR_NAME_BUF_SIZE
}
/*
@@ -969,7 +979,7 @@ CONST char *
Tcl_GetVar(interp, varName, flags)
Tcl_Interp *interp; /* Command interpreter in which varName is
* to be looked up. */
- char *varName; /* Name of a variable in interp. */
+ CONST char *varName; /* Name of a variable in interp. */
int flags; /* OR-ed combination of TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG
* bits. */
@@ -1004,7 +1014,7 @@ CONST char *
Tcl_GetVar2(interp, part1, part2, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be looked up. */
- char *part1; /* Name of an array (if part2 is non-NULL)
+ CONST char *part1; /* Name of an array (if part2 is non-NULL)
* or the name of a variable. */
CONST char *part2; /* If non-NULL, gives the name of an element
* in the array part1. */
@@ -1048,7 +1058,7 @@ Tcl_Obj *
Tcl_GetVar2Ex(interp, part1, part2, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be looked up. */
- char *part1; /* Name of an array (if part2 is non-NULL)
+ CONST char *part1; /* Name of an array (if part2 is non-NULL)
* or the name of a variable. */
CONST char *part2; /* If non-NULL, gives the name of an element
* in the array part1. */
@@ -1159,7 +1169,7 @@ TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags)
register Var *varPtr; /* The variable to be read.*/
Var *arrayPtr; /* NULL for scalar variables, pointer to
* the containing array otherwise. */
- char *part1; /* Name of an array (if part2 is non-NULL)
+ CONST char *part1; /* Name of an array (if part2 is non-NULL)
* or the name of a variable. */
CONST char *part2; /* If non-NULL, gives the name of an element
* in the array part1. */
@@ -1291,7 +1301,7 @@ CONST char *
Tcl_SetVar(interp, varName, newValue, flags)
Tcl_Interp *interp; /* Command interpreter in which varName is
* to be looked up. */
- char *varName; /* Name of a variable in interp. */
+ CONST char *varName; /* Name of a variable in interp. */
CONST char *newValue; /* New value for varName. */
int flags; /* Various flags that tell how to set value:
* any of TCL_GLOBAL_ONLY,
@@ -1332,7 +1342,7 @@ CONST char *
Tcl_SetVar2(interp, part1, part2, newValue, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be looked up. */
- char *part1; /* If part2 is NULL, this is name of scalar
+ CONST char *part1; /* If part2 is NULL, this is name of scalar
* variable. Otherwise it is the name of
* an array. */
CONST char *part2; /* Name of an element within an array, or
@@ -1405,7 +1415,7 @@ Tcl_Obj *
Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags)
Tcl_Interp *interp; /* Command interpreter in which variable is
* to be found. */
- char *part1; /* Name of an array (if part2 is non-NULL)
+ CONST char *part1; /* Name of an array (if part2 is non-NULL)
* or the name of a variable. */
CONST char *part2; /* If non-NULL, gives the name of an element
* in the array part1. */
@@ -1516,7 +1526,7 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
* to be looked up. */
register Var *varPtr;
Var *arrayPtr;
- char *part1; /* Name of an array (if part2 is non-NULL)
+ CONST char *part1; /* Name of an array (if part2 is non-NULL)
* or the name of a variable. */
CONST char *part2; /* If non-NULL, gives the name of an element
* in the array part1. */
@@ -1772,7 +1782,7 @@ TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags)
* to be found. */
Var *varPtr;
Var *arrayPtr;
- char *part1; /* Points to an object holding the name of
+ CONST char *part1; /* Points to an object holding the name of
* an array (if part2 is non-NULL) or the
* name of a variable. */
CONST char *part2; /* If non-null, points to an object holding
@@ -1877,7 +1887,7 @@ int
Tcl_UnsetVar(interp, varName, flags)
Tcl_Interp *interp; /* Command interpreter in which varName is
* to be looked up. */
- char *varName; /* Name of a variable in interp. May be
+ CONST char *varName; /* Name of a variable in interp. May be
* either a scalar name or an array name
* or an element in an array. */
int flags; /* OR-ed combination of any of
@@ -1912,7 +1922,7 @@ int
Tcl_UnsetVar2(interp, part1, part2, flags)
Tcl_Interp *interp; /* Command interpreter in which varName is
* to be looked up. */
- char *part1; /* Name of variable or array. */
+ CONST char *part1; /* Name of variable or array. */
CONST char *part2; /* Name of element within array or NULL. */
int flags; /* OR-ed combination of any of
* TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
@@ -2124,7 +2134,7 @@ int
Tcl_TraceVar(interp, varName, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter in which variable is
* to be traced. */
- char *varName; /* Name of variable; may end with "(index)"
+ CONST char *varName; /* Name of variable; may end with "(index)"
* to signify an array reference. */
int flags; /* OR-ed collection of bits, including any
* of TCL_TRACE_READS, TCL_TRACE_WRITES,
@@ -2163,7 +2173,7 @@ int
Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter in which variable is
* to be traced. */
- char *part1; /* Name of scalar variable or array. */
+ CONST char *part1; /* Name of scalar variable or array. */
CONST char *part2; /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
@@ -2241,7 +2251,7 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData)
void
Tcl_UntraceVar(interp, varName, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
- char *varName; /* Name of variable; may end with "(index)"
+ CONST char *varName; /* Name of variable; may end with "(index)"
* to signify an array reference. */
int flags; /* OR-ed collection of bits describing
* current trace, including any of
@@ -2275,7 +2285,7 @@ Tcl_UntraceVar(interp, varName, flags, proc, clientData)
void
Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
- char *part1; /* Name of variable or array. */
+ CONST char *part1; /* Name of variable or array. */
CONST char *part2; /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
@@ -2386,7 +2396,7 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData)
ClientData
Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
- char *varName; /* Name of variable; may end with "(index)"
+ CONST char *varName; /* Name of variable; may end with "(index)"
* to signify an array reference. */
int flags; /* OR-ed combo or TCL_GLOBAL_ONLY,
* TCL_NAMESPACE_ONLY (can be 0). */
@@ -2421,7 +2431,7 @@ Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData)
ClientData
Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData)
Tcl_Interp *interp; /* Interpreter containing variable. */
- char *part1; /* Name of variable or array. */
+ CONST char *part1; /* Name of variable or array. */
CONST char *part2; /* Name of element within array; NULL means
* trace applies to scalar variable or array
* as-a-whole. */
@@ -3581,7 +3591,7 @@ Tcl_UpVar(interp, frameName, varName, localName, flags)
* to be looked up. */
CONST char *frameName; /* Name of the frame containing the source
* variable, such as "1" or "#0". */
- char *varName; /* Name of a variable in interp to link to.
+ CONST char *varName; /* Name of a variable in interp to link to.
* May be either a scalar name or an
* element in an array. */
CONST char *localName; /* Name of link variable. */
@@ -3618,7 +3628,7 @@ Tcl_UpVar2(interp, frameName, part1, part2, localName, flags)
* for error messages too. */
CONST char *frameName; /* Name of the frame containing the source
* variable, such as "1" or "#0". */
- char *part1;
+ CONST char *part1;
CONST char *part2; /* Two parts of source variable name to
* link to. */
CONST char *localName; /* Name of link variable. */
@@ -4058,7 +4068,7 @@ CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
* isn't an element of an array. */
Var *varPtr; /* Variable whose traces are to be
* invoked. */
- char *part1;
+ CONST char *part1;
CONST char *part2; /* Variable's two-part name. */
int flags; /* Flags passed to trace procedures:
* indicates what's happening to variable,
@@ -4071,7 +4081,8 @@ CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
{
register VarTrace *tracePtr;
ActiveVarTrace active;
- char *result, *openParen, *p;
+ char *result;
+ CONST char *openParen, *p;
Tcl_DString nameCopy;
int copiedName;
int code = TCL_OK;
@@ -4111,11 +4122,13 @@ CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg)
p--;
if (*p == ')') {
int offset = (openParen - part1);
+ char *newPart1;
Tcl_DStringInit(&nameCopy);
Tcl_DStringAppend(&nameCopy, part1, (p-part1));
- part2 = Tcl_DStringValue(&nameCopy) + offset + 1;
- part1 = Tcl_DStringValue(&nameCopy);
- part1[offset] = 0;
+ newPart1 = Tcl_DStringValue(&nameCopy);
+ newPart1[offset] = 0;
+ part1 = newPart1;
+ part2 = newPart1 + offset + 1;
copiedName = 1;
}
break;
@@ -4727,7 +4740,7 @@ TclDeleteCompiledLocalVars(iPtr, framePtr)
static void
DeleteArray(iPtr, arrayName, varPtr, flags)
Interp *iPtr; /* Interpreter containing array. */
- char *arrayName; /* Name of array (used for trace
+ CONST char *arrayName; /* Name of array (used for trace
* callbacks). */
Var *varPtr; /* Pointer to variable structure. */
int flags; /* Flags to pass to CallVarTraces:
@@ -4886,7 +4899,7 @@ VarErrMsg(interp, part1, part2, operation, reason)
Var *
TclVarTraceExists(interp, varName)
Tcl_Interp *interp; /* The interpreter */
- char *varName; /* The variable name */
+ CONST char *varName; /* The variable name */
{
Var *varPtr;
Var *arrayPtr;
generated by cgit v0.12 at 2024-11-06 21:04:20 (GMT)