diff options
author | dgp <dgp@users.sourceforge.net> | 2002-08-05 03:24:39 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2002-08-05 03:24:39 (GMT) |
commit | b3debf8fa6252ac20fea32f74530a37a1b013ba3 (patch) | |
tree | 55bc26f8f6a88258d08fd90ff9a8943937349574 /generic | |
parent | a96927be11c81e5e49d42cb7d0574729840d8f17 (diff) | |
download | tcl-b3debf8fa6252ac20fea32f74530a37a1b013ba3.zip tcl-b3debf8fa6252ac20fea32f74530a37a1b013ba3.tar.gz tcl-b3debf8fa6252ac20fea32f74530a37a1b013ba3.tar.bz2 |
* doc/CmdCmplt.3: Applied Patch 585105 to fully CONST-ify
* doc/Concat.3: all remaining public interfaces of Tcl.
* doc/CrtCommand.3: Notably, the parser no longer writes on
* doc/CrtSlave.3: the string it is parsing, so it is no
* doc/CrtTrace.3: longer necessary for Tcl_Eval() to be
* doc/Eval.3: given a writable string. Also, the
* doc/ExprLong.3: refactoring of the Tcl_*Var* routines
* doc/LinkVar.3: by Miguel Sofer is included, so that the
* doc/ParseCmd.3: "part1" argument for them no longer needs
* doc/SetVar.3: to be writable either.
* doc/TraceVar.3:
* doc/UpVar.3: Compatibility support has been enhanced so
* generic/tcl.decls that a #define of USE_NON_CONST will remove
* generic/tcl.h all possible source incompatibilities with
* generic/tclBasic.c the 8.3 version of the header file(s).
* generic/tclCmdMZ.c The new #define of USE_COMPAT_CONST now does
* generic/tclCompCmds.c what USE_NON_CONST used to do -- disable
* generic/tclCompExpr.c only those new CONST's that introduce
* generic/tclCompile.c irreconcilable incompatibilities.
* generic/tclCompile.h
* generic/tclDecls.h Several bugs are also fixed by this patch.
* generic/tclEnv.c [Bugs 584051,580433] [Patches 585105,582429]
* generic/tclEvent.c
* generic/tclInt.decls
* generic/tclInt.h
* generic/tclIntDecls.h
* generic/tclInterp.c
* generic/tclLink.c
* generic/tclObj.c
* generic/tclParse.c
* generic/tclParseExpr.c
* generic/tclProc.c
* generic/tclTest.c
* generic/tclUtf.c
* generic/tclUtil.c
* generic/tclVar.c
* mac/tclMacTest.c
* tests/expr-old.test
* tests/parseExpr.test
* unix/tclUnixTest.c
* unix/tclXtTest.c
* win/tclWinTest.c
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tcl.decls | 133 | ||||
-rw-r--r-- | generic/tcl.h | 36 | ||||
-rw-r--r-- | generic/tclBasic.c | 36 | ||||
-rw-r--r-- | generic/tclCmdMZ.c | 16 | ||||
-rw-r--r-- | generic/tclCompCmds.c | 271 | ||||
-rw-r--r-- | generic/tclCompExpr.c | 57 | ||||
-rw-r--r-- | generic/tclCompile.c | 33 | ||||
-rw-r--r-- | generic/tclCompile.h | 17 | ||||
-rw-r--r-- | generic/tclDecls.h | 258 | ||||
-rw-r--r-- | generic/tclEnv.c | 8 | ||||
-rw-r--r-- | generic/tclEvent.c | 10 | ||||
-rw-r--r-- | generic/tclInt.decls | 26 | ||||
-rw-r--r-- | generic/tclInt.h | 24 | ||||
-rw-r--r-- | generic/tclIntDecls.h | 53 | ||||
-rw-r--r-- | generic/tclInterp.c | 9 | ||||
-rw-r--r-- | generic/tclLink.c | 14 | ||||
-rw-r--r-- | generic/tclObj.c | 4 | ||||
-rw-r--r-- | generic/tclParse.c | 984 | ||||
-rw-r--r-- | generic/tclParseExpr.c | 428 | ||||
-rw-r--r-- | generic/tclProc.c | 4 | ||||
-rw-r--r-- | generic/tclTest.c | 188 | ||||
-rw-r--r-- | generic/tclUtf.c | 132 | ||||
-rw-r--r-- | generic/tclUtil.c | 42 | ||||
-rw-r--r-- | generic/tclVar.c | 107 |
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(©); /* * 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(©, "\"", 1); + Tcl_DStringAppend(©, elName, elNameChars); + Tcl_DStringAppend(©, "\"", 1); + code = Tcl_ParseCommand(interp, Tcl_DStringValue(©), + 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(©); *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; |