diff options
| -rw-r--r-- | generic/tclCmdAH.c | 318 | ||||
| -rw-r--r-- | generic/tclCmdIL.c | 358 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 291 |
3 files changed, 445 insertions, 522 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index e2e64e1..9e9ab9c 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -1,17 +1,16 @@ /* * tclCmdAH.c -- * - * This file contains the top-level command routines for most of - * the Tcl built-in commands whose names begin with the letters - * A to H. + * This file contains the top-level command routines for most of the Tcl + * built-in commands whose names begin with the letters A to H. * * Copyright (c) 1987-1993 The Regents of the University of California. * Copyright (c) 1994-1997 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdAH.c,v 1.65 2005/07/17 21:46:31 dkf Exp $ + * RCS: @(#) $Id: tclCmdAH.c,v 1.66 2005/08/26 13:26:55 dkf Exp $ */ #include "tclInt.h" @@ -21,21 +20,20 @@ * Prototypes for local procedures defined in this file: */ -static int CheckAccess _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *pathPtr, int mode)); -static int GetStatBuf _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *pathPtr, Tcl_FSStatProc *statProc, - Tcl_StatBuf *statPtr)); -static char * GetTypeFromMode _ANSI_ARGS_((int mode)); -static int StoreStatData _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *varName, Tcl_StatBuf *statPtr)); +static int CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr, + int mode); +static int GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr, + Tcl_FSStatProc *statProc, Tcl_StatBuf *statPtr); +static char * GetTypeFromMode(int mode); +static int StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName, + Tcl_StatBuf *statPtr); /* *---------------------------------------------------------------------- * * Tcl_BreakObjCmd -- * - * This procedure is invoked to process the "break" Tcl command. See the + * This procedure is invoked to process the "break" Tcl command. See the * user documentation for details on what it does. * * With the bytecode compiler, this procedure is only called when a @@ -54,10 +52,10 @@ static int StoreStatData _ANSI_ARGS_((Tcl_Interp *interp, /* ARGSUSED */ int Tcl_BreakObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); @@ -71,7 +69,7 @@ Tcl_BreakObjCmd(dummy, interp, objc, objv) * * Tcl_CaseObjCmd -- * - * This procedure is invoked to process the "case" Tcl command. See the + * This procedure is invoked to process the "case" Tcl command. See the * user documentation for details on what it does. * * Results: @@ -291,7 +289,7 @@ Tcl_CatchObjCmd(dummy, interp, objc, objv) * * Tcl_CdObjCmd -- * - * This procedure is invoked to process the "cd" Tcl command. See the + * This procedure is invoked to process the "cd" Tcl command. See the * user documentation for details on what it does. * * Results: @@ -377,7 +375,7 @@ Tcl_ConcatObjCmd(dummy, interp, objc, objv) * * Tcl_ContinueObjCmd -- * - * This procedure is invoked to process the "continue" Tcl command. See + * This procedure is invoked to process the "continue" Tcl command. See * the user documentation for details on what it does. * * With the bytecode compiler, this procedure is only called when a @@ -572,7 +570,7 @@ TclEncodingDirsObjCmd(dummy, interp, objc, objv) * * Tcl_ErrorObjCmd -- * - * This procedure is invoked to process the "error" Tcl command. See the + * This procedure is invoked to process the "error" Tcl command. See the * user documentation for details on what it does. * * Results: @@ -655,9 +653,10 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv) } else { /* * More than one argument: concatenate them together with spaces - * between, then evaluate the result. Tcl_EvalObjEx will delete the + * between, then evaluate the result. Tcl_EvalObjEx will delete the * object when it decrements its refcount after eval'ing it. */ + objPtr = Tcl_ConcatObj(objc-1, objv+1); result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT); } @@ -675,7 +674,7 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv) * * Tcl_ExitObjCmd -- * - * This procedure is invoked to process the "exit" Tcl command. See the + * This procedure is invoked to process the "exit" Tcl command. See the * user documentation for details on what it does. * * Results: @@ -760,7 +759,7 @@ Tcl_ExprObjCmd(dummy, interp, objc, objv) if (result == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); - Tcl_DecrRefCount(resultPtr); /* done with the result object */ + Tcl_DecrRefCount(resultPtr); /* done with the result object */ } return result; @@ -836,10 +835,12 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) } switch ((enum options) index) { - case FCMD_ATIME: { + { Tcl_StatBuf buf; struct utimbuf tval; + case FCMD_ATIME: + case FCMD_MTIME: if ((objc < 3) || (objc > 4)) { Tcl_WrongNumArgs(interp, 2, objv, "name ?time?"); return TCL_ERROR; @@ -859,27 +860,35 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } - tval.actime = newTime; - tval.modtime = buf.st_mtime; + if (index == FCMD_ATIME) { + tval.actime = newTime; + tval.modtime = buf.st_mtime; + } else { /* index == FCMD_MTIME */ + tval.actime = buf.st_atime; + tval.modtime = newTime; + } + if (Tcl_FSUtime(objv[2], &tval) != 0) { - Tcl_AppendResult(interp, - "could not set access time for file \"", - TclGetString(objv[2]), "\": ", Tcl_PosixError(interp), - (char *) NULL); + Tcl_AppendResult(interp, "could not set ", + (index == FCMD_ATIME ? "access" : "modification"), + " time for file \"", TclGetString(objv[2]), "\": ", + Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } /* * Do another stat to ensure that the we return the new recognized - * atime - hopefully the same as the one we sent in. However, - * fs's like FAT don't even know what atime is. + * atime - hopefully the same as the one we sent in. However, fs's + * like FAT don't even know what atime is. */ if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } } - Tcl_SetObjResult(interp, Tcl_NewLongObj((long) buf.st_atime)); + + Tcl_SetObjResult(interp, Tcl_NewLongObj((long) + (index == FCMD_ATIME ? buf.st_atime : buf.st_mtime))); return TCL_OK; } case FCMD_ATTRIBUTES: @@ -935,10 +944,11 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } } - case FCMD_ISDIRECTORY: { + { int value; Tcl_StatBuf buf; + case FCMD_ISDIRECTORY: if (objc != 3) { goto only3Args; } @@ -948,11 +958,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value)); return TCL_OK; - } - case FCMD_ISFILE: { - int value; - Tcl_StatBuf buf; - + case FCMD_ISFILE: if (objc != 3) { goto only3Args; } @@ -962,6 +968,25 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value)); return TCL_OK; + case FCMD_OWNED: + if (objc != 3) { + goto only3Args; + } + value = 0; + if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) { + /* + * For Windows, there are no user ids associated with a file, so + * we always return 1. + */ + +#if defined(__WIN32__) + value = 1; +#else + value = (geteuid() == buf.st_uid); +#endif + } + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value)); + return TCL_OK; } case FCMD_JOIN: { Tcl_Obj *resObj; @@ -1100,9 +1125,10 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) } return TCL_OK; } - case FCMD_LSTAT: { + { Tcl_StatBuf buf; + case FCMD_LSTAT: if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "name varName"); return TCL_ERROR; @@ -1111,51 +1137,34 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) return TCL_ERROR; } return StoreStatData(interp, objv[3], &buf); - } - case FCMD_MTIME: { - Tcl_StatBuf buf; - struct utimbuf tval; - - if ((objc < 3) || (objc > 4)) { - Tcl_WrongNumArgs(interp, 2, objv, "name ?time?"); + case FCMD_STAT: + if (objc != 4) { + Tcl_WrongNumArgs(interp, 2, objv, "name varName"); return TCL_ERROR; } if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } - if (objc == 4) { - /* - * Need separate variable for reading longs from an object on - * 64-bit platforms. [Bug #698146] - */ - - long newTime; - - if (Tcl_GetLongFromObj(interp, objv[3], &newTime) != TCL_OK) { - return TCL_ERROR; - } - - tval.actime = buf.st_atime; - tval.modtime = newTime; - if (Tcl_FSUtime(objv[2], &tval) != 0) { - Tcl_AppendResult(interp, - "could not set modification time for file \"", - TclGetString(objv[2]), "\": ", Tcl_PosixError(interp), - (char *) NULL); - return TCL_ERROR; - } - - /* - * Do another stat to ensure that the we return the new recognized - * atime - hopefully the same as the one we sent in. However, fs's - * like FAT don't even know what atime is. - */ - - if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) { - return TCL_ERROR; - } + return StoreStatData(interp, objv[3], &buf); + case FCMD_SIZE: + if (objc != 3) { + goto only3Args; + } + if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) { + return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_NewLongObj((long) buf.st_mtime)); + Tcl_SetObjResult(interp, + Tcl_NewWideIntObj((Tcl_WideInt) buf.st_size)); + return TCL_OK; + case FCMD_TYPE: + if (objc != 3) { + goto only3Args; + } + if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) { + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewStringObj( + GetTypeFromMode((unsigned short) buf.st_mode), -1)); return TCL_OK; } case FCMD_MKDIR: @@ -1196,29 +1205,6 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) Tcl_SetObjResult(interp, fileName); return TCL_OK; } - case FCMD_OWNED: { - int value; - Tcl_StatBuf buf; - - if (objc != 3) { - goto only3Args; - } - value = 0; - if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) { - /* - * For Windows, there are no user ids associated with a file, so - * we always return 1. - */ - -#if defined(__WIN32__) - value = 1; -#else - value = (geteuid() == buf.st_uid); -#endif - } - Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value)); - return TCL_OK; - } case FCMD_PATHTYPE: if (objc != 3) { goto only3Args; @@ -1308,19 +1294,6 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) } } return TCL_OK; - case FCMD_SIZE: { - Tcl_StatBuf buf; - - if (objc != 3) { - goto only3Args; - } - if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) { - return TCL_ERROR; - } - Tcl_SetObjResult(interp, - Tcl_NewWideIntObj((Tcl_WideInt) buf.st_size)); - return TCL_OK; - } case FCMD_SPLIT: { Tcl_Obj *res; @@ -1340,18 +1313,6 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) return TCL_OK; } } - case FCMD_STAT: { - Tcl_StatBuf buf; - - if (objc != 4) { - Tcl_WrongNumArgs(interp, 1, objv, "stat name varName"); - return TCL_ERROR; - } - if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) { - return TCL_ERROR; - } - return StoreStatData(interp, objv[3], &buf); - } case FCMD_SYSTEM: { Tcl_Obj* fsInfo; @@ -1382,19 +1343,6 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) return TCL_OK; } } - case FCMD_TYPE: { - Tcl_StatBuf buf; - - if (objc != 3) { - goto only3Args; - } - if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) { - return TCL_ERROR; - } - Tcl_SetObjResult(interp, Tcl_NewStringObj( - GetTypeFromMode((unsigned short) buf.st_mode), -1)); - return TCL_OK; - } case FCMD_VOLUMES: if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); @@ -1423,7 +1371,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv) * available through the access() system call. * * Results: - * Always returns TCL_OK. Sets interp's result to boolean true or false + * Always returns TCL_OK. Sets interp's result to boolean true or false * depending on whether the file has the specified attribute. * * Side effects: @@ -1462,9 +1410,9 @@ CheckAccess(interp, pathPtr, mode) * * Results: * The return value is TCL_OK if the specified file exists and can be - * stat'ed, TCL_ERROR otherwise. If TCL_ERROR is returned, an error - * message is left in interp's result. If TCL_OK is returned, *statPtr - * is filled with information about the specified file. + * stat'ed, TCL_ERROR otherwise. If TCL_ERROR is returned, an error + * message is left in interp's result. If TCL_OK is returned, *statPtr is + * filled with information about the specified file. * * Side effects: * None. @@ -1474,7 +1422,7 @@ CheckAccess(interp, pathPtr, mode) static int GetStatBuf(interp, pathPtr, statProc, statPtr) - Tcl_Interp *interp; /* Interp for error return. May be NULL. */ + Tcl_Interp *interp; /* Interp for error return. May be NULL. */ Tcl_Obj *pathPtr; /* Path name to examine. */ Tcl_FSStatProc *statProc; /* Either stat() or lstat() depending on * desired behavior. */ @@ -1510,8 +1458,8 @@ GetStatBuf(interp, pathPtr, statProc, statPtr) * associative array. * * Results: - * Returns a standard Tcl return value. If an error occurs then a - * message is left in interp's result. + * Returns a standard Tcl return value. If an error occurs then a message + * is left in interp's result. * * Side effects: * Elements of the associative array given by "varName" are modified. @@ -1521,11 +1469,11 @@ GetStatBuf(interp, pathPtr, statProc, statPtr) static int StoreStatData(interp, varName, statPtr) - Tcl_Interp *interp; /* Interpreter for error reports. */ - Tcl_Obj *varName; /* Name of associative array variable - * in which to store stat results. */ - Tcl_StatBuf *statPtr; /* Pointer to buffer containing stat - * data to store in varName. */ + Tcl_Interp *interp; /* Interpreter for error reports. */ + Tcl_Obj *varName; /* Name of associative array variable in which + * to store stat results. */ + Tcl_StatBuf *statPtr; /* Pointer to buffer containing stat data to + * store in varName. */ { Tcl_Obj *field = Tcl_NewObj(); Tcl_Obj *value; @@ -1622,7 +1570,7 @@ GetTypeFromMode(mode) * * Tcl_ForObjCmd -- * - * This procedure is invoked to process the "for" Tcl command. See the + * This procedure is invoked to process the "for" Tcl command. See the * user documentation for details on what it does. * * With the bytecode compiler, this procedure is only called when a @@ -1642,10 +1590,10 @@ GetTypeFromMode(mode) /* ARGSUSED */ int Tcl_ForObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { int result, value; @@ -1664,7 +1612,7 @@ Tcl_ForObjCmd(dummy, interp, objc, objv) while (1) { /* * We need to reset the result before passing it off to - * Tcl_ExprBooleanObj. Otherwise, any error message will be appended + * Tcl_ExprBooleanObj. Otherwise, any error message will be appended * to the result of the last evaluation. */ @@ -1711,7 +1659,7 @@ Tcl_ForObjCmd(dummy, interp, objc, objv) * Tcl_ForeachObjCmd -- * * This object-based procedure is invoked to process the "foreach" Tcl - * command. See the user documentation for details on what it does. + * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result. @@ -1755,11 +1703,11 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv) int argcListArray[STATIC_LIST_SIZE]; Tcl_Obj **argvListArray[STATIC_LIST_SIZE]; - int *index = indexArray; /* Array of value list indices */ - int *varcList = varcListArray; /* # loop variables per list */ - Tcl_Obj ***varvList = varvListArray; /* Array of var name lists */ - int *argcList = argcListArray; /* Array of value list sizes */ - Tcl_Obj ***argvList = argvListArray; /* Array of value lists */ + int *index = indexArray; /* Array of value list indices */ + int *varcList = varcListArray; /* # loop variables per list */ + Tcl_Obj ***varvList = varvListArray;/* Array of var name lists */ + int *argcList = argcListArray; /* Array of value list sizes */ + Tcl_Obj ***argvList = argvListArray;/* Array of value lists */ if (objc < 4 || (objc%2 != 0)) { Tcl_WrongNumArgs(interp, 1, objv, @@ -1932,7 +1880,7 @@ Tcl_ForeachObjCmd(dummy, interp, objc, objv) * * Tcl_FormatObjCmd -- * - * This procedure is invoked to process the "format" Tcl command. See + * This procedure is invoked to process the "format" Tcl command. See * the user documentation for details on what it does. * * Results: @@ -1976,13 +1924,13 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) * doubleValue has the value to pass to * sprintf, according to the following * definitions: */ -# define INT_VALUE 0 -# define CHAR_VALUE 1 -# define PTR_VALUE 2 -# define DOUBLE_VALUE 3 -# define STRING_VALUE 4 -# define WIDE_VALUE 5 -# define MAX_FLOAT_SIZE 320 +#define INT_VALUE 0 +#define CHAR_VALUE 1 +#define PTR_VALUE 2 +#define DOUBLE_VALUE 3 +#define STRING_VALUE 4 +#define WIDE_VALUE 5 +#define MAX_FLOAT_SIZE 320 Tcl_Obj *resultPtr; /* Where result is stored finally. */ char staticBuf[MAX_FLOAT_SIZE + 1]; @@ -2003,8 +1951,8 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) * seen. */ int useShort; /* Value to be printed is short (half word). */ char *end; /* Used to locate end of numerical fields. */ - int stringLen = 0; /* Length of string in characters rather - * than bytes. Used for %s substitution. */ + int stringLen = 0; /* Length of string in characters rather than + * bytes. Used for %s substitution. */ int gotMinus; /* Non-zero indicates that a minus flag has * been seen in the current field. */ int gotPrecision; /* Non-zero indicates that a precision has @@ -2014,13 +1962,13 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) int useWide; /* Value to be printed is Tcl_WideInt. */ /* - * This procedure is a bit nasty. The goal is to use sprintf to do most - * of the dirty work. There are several problems: + * This procedure is a bit nasty. The goal is to use sprintf to do most of + * the dirty work. There are several problems: * 1. this procedure can't trust its arguments. * 2. we must be able to provide a large enough result area to hold - * whatever's generated. This is hard to estimate. + * whatever's generated. This is hard to estimate. * 3. there's no way to move the arguments from objv to the call to - * sprintf in a reasonable way. This is particularly nasty because + * sprintf in a reasonable way. This is particularly nasty because * some of the arguments may be two-word values (doubles and * wide-ints). * So, what happens here is to scan the format string one % group at a @@ -2167,7 +2115,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) gotPrecision = 1; } if (isdigit(UCHAR(*format))) { /* INTL: Tcl source. */ - precision = strtoul(format, &end, 10); /* INTL: "C" locale. */ + precision = strtoul(format, &end, 10); /* INTL: "C" locale. */ format = end; } else if (*format == '*') { if (objIndex >= objc) { @@ -2191,7 +2139,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) /* * Only add a 'll' modifier for integer values as it makes some - * libc's go into spasm otherwise. [Bug #702622] + * libc's go into spasm otherwise. [Bug #702622] */ switch (format[1]) { @@ -2247,7 +2195,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) * * Do not add this if we're going to pass in a short (i.e. if * we've got an 'h' modifier already in the string); some libc - * implementations of sprintf() do not like it at all. [Bug + * implementations of sprintf() do not like it at all. [Bug * 1154163] */ @@ -2263,7 +2211,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv) case 's': /* * Compute the length of the string in characters and add any - * additional space required by the field width. All of the extra + * additional space required by the field width. All of the extra * characters will be spaces, so one byte per character is * adequate. */ diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 558f206..bbcab68 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.79 2005/07/29 14:47:46 dkf Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.80 2005/08/26 13:26:55 dkf Exp $ */ #include "tclInt.h" @@ -29,10 +29,10 @@ */ typedef struct SortElement { - Tcl_Obj *objPtr; /* Object being sorted. */ - int count; /* number of same elements in list */ - struct SortElement *nextPtr; /* Next element in the list, or NULL - * for end of list. */ + Tcl_Obj *objPtr; /* Object being sorted. */ + int count; /* number of same elements in list */ + struct SortElement *nextPtr;/* Next element in the list, or NULL for end + * of list. */ } SortElement; /* @@ -40,9 +40,8 @@ typedef struct SortElement { * commands to facilitate the "-nocase" option. */ -typedef int (*SortStrCmpFn_t) _ANSI_ARGS_((const char *, const char *)); -typedef int (*SortMemCmpFn_t) _ANSI_ARGS_((const void *, const void *, - size_t)); +typedef int (*SortStrCmpFn_t) (const char *, const char *); +typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t); /* * The "lsort" command needs to pass certain information down to the function @@ -53,12 +52,12 @@ typedef int (*SortMemCmpFn_t) _ANSI_ARGS_((const void *, const void *, typedef struct SortInfo { int isIncreasing; /* Nonzero means sort in increasing order. */ - int sortMode; /* The sort mode. One of SORTMODE_* values + int sortMode; /* The sort mode. One of SORTMODE_* values * defined below */ SortStrCmpFn_t strCmpFn; /* Basic string compare command (used with * ASCII mode). */ Tcl_Obj *compareCmdPtr; /* The Tcl comparison command when sortMode is - * SORTMODE_COMMAND. Pre-initialized to hold + * SORTMODE_COMMAND. Pre-initialized to hold * base of command.*/ int *indexv; /* If the -index option was specified, this * holds the indexes contained in the list @@ -70,7 +69,7 @@ typedef struct SortInfo { int singleIndex; /* Static space for common index case. */ Tcl_Interp *interp; /* The interpreter in which the sort is being * done. */ - int resultCode; /* Completion code for the lsort command. If + int resultCode; /* Completion code for the lsort command. If * an error occurs during the sort this is * changed from TCL_OK to TCL_ERROR. */ } SortInfo; @@ -87,101 +86,77 @@ typedef struct SortInfo { #define SORTMODE_DICTIONARY 4 /* - * Magic values for the index field of the SortInfo structure. Note that the + * Magic values for the index field of the SortInfo structure. Note that the * index "end-1" will be translated to SORTIDX_END-1, etc. */ -#define SORTIDX_NONE -1 /* Not indexed; use whole value. */ -#define SORTIDX_END -2 /* Indexed from end. */ +#define SORTIDX_NONE -1 /* Not indexed; use whole value. */ +#define SORTIDX_END -2 /* Indexed from end. */ /* * Forward declarations for procedures defined in this file: */ -static void AppendLocals _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Obj *listPtr, CONST char *pattern, - int includeLinks)); -static int DictionaryCompare _ANSI_ARGS_((char *left, - char *right)); -static int InfoArgsCmd _ANSI_ARGS_((ClientData dummy, +static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr, + CONST char *pattern, int includeLinks); +static int DictionaryCompare(char *left, char *right); +static int InfoArgsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoBodyCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoCmdCountCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoCommandsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoCompleteCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoDefaultCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoExistsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoFunctionsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoHostnameCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoLevelCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoLibraryCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoLoadedCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoLocalsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoNameOfExecutableCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoBodyCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoCmdCountCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoCommandsCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoCompleteCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoDefaultCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoExistsCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoFunctionsCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoGlobalsCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoHostnameCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoLevelCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoLibraryCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoLoadedCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoLocalsCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoNameOfExecutableCmd _ANSI_ARGS_(( - ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoPatchLevelCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoProcsCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoScriptCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoSharedlibCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoTclVersionCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static int InfoVarsCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[])); -static SortElement * MergeSort _ANSI_ARGS_((SortElement *headPt, - SortInfo *infoPtr)); -static SortElement * MergeLists _ANSI_ARGS_((SortElement *leftPtr, - SortElement *rightPtr, SortInfo *infoPtr)); -static int SortCompare _ANSI_ARGS_((Tcl_Obj *firstPtr, - Tcl_Obj *second, SortInfo *infoPtr)); -static Tcl_Obj * SelectObjFromSublist _ANSI_ARGS_((Tcl_Obj *firstPtr, - SortInfo *infoPtr)); - + Tcl_Obj *CONST objv[]); +static int InfoPatchLevelCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoProcsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoScriptCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static int InfoVarsCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *CONST objv[]); +static SortElement * MergeSort(SortElement *headPt, SortInfo *infoPtr); +static SortElement * MergeLists(SortElement *leftPtr, SortElement *rightPtr, + SortInfo *infoPtr); +static int SortCompare(Tcl_Obj *firstPtr, Tcl_Obj *second, + SortInfo *infoPtr); +static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr, + SortInfo *infoPtr); /* *---------------------------------------------------------------------- * * Tcl_IfObjCmd -- * - * This procedure is invoked to process the "if" Tcl command. See the + * This procedure is invoked to process the "if" Tcl command. See the * user documentation for details on what it does. * * With the bytecode compiler, this procedure is only called when a @@ -214,7 +189,7 @@ Tcl_IfObjCmd(dummy, interp, objc, objv) /* * At this point in the loop, objv and objc refer to an expression to * test, either for the main expression or an expression following an - * "elseif". The arguments after the expression must be "then" + * "elseif". The arguments after the expression must be "then" * (optional) and a script to execute if the expression is true. */ @@ -251,7 +226,7 @@ Tcl_IfObjCmd(dummy, interp, objc, objv) } /* - * The expression evaluated to false. Skip the command, then see if + * The expression evaluated to false. Skip the command, then see if * there is an "else" or "elseif" clause. */ @@ -271,8 +246,8 @@ Tcl_IfObjCmd(dummy, interp, objc, objv) } /* - * Couldn't find a "then" or "elseif" clause to execute. Check now for an - * "else" clause. We know that there's at least one more argument when we + * Couldn't find a "then" or "elseif" clause to execute. Check now for an + * "else" clause. We know that there's at least one more argument when we * get here. */ @@ -302,7 +277,7 @@ Tcl_IfObjCmd(dummy, interp, objc, objv) * * Tcl_IncrObjCmd -- * - * This procedure is invoked to process the "incr" Tcl command. See the + * This procedure is invoked to process the "incr" Tcl command. See the * user documentation for details on what it does. * * With the bytecode compiler, this procedure is only called when a @@ -400,7 +375,7 @@ Tcl_IncrObjCmd(dummy, interp, objc, objv) * * Tcl_InfoObjCmd -- * - * This procedure is invoked to process the "info" Tcl command. See the + * This procedure is invoked to process the "info" Tcl command. See the * user documentation for details on what it does. * * Results: @@ -635,7 +610,7 @@ InfoBodyCmd(dummy, interp, objc, objv) if (bodyPtr->bytes == NULL) { /* * The string rep might not be valid if the procedure has never been - * run before. [Bug #545644] + * run before. [Bug #545644] */ (void) Tcl_GetString(bodyPtr); @@ -691,10 +666,10 @@ InfoCmdCountCmd(dummy, interp, objc, objv) * InfoCommandsCmd -- * * Called to implement the "info commands" command that returns the list - * of commands in the interpreter that match an optional pattern. The + * of commands in the interpreter that match an optional pattern. The * pattern, if any, consists of an optional sequence of namespace names * separated by "::" qualifiers, which is followed by a glob-style - * pattern that restricts which commands are returned. Handles the + * pattern that restricts which commands are returned. Handles the * following syntax: * * info commands ?pattern? @@ -722,9 +697,9 @@ InfoCommandsCmd(dummy, interp, objc, objv) Tcl_HashSearch search; Namespace *nsPtr; Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); - Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; - int specificNsInPattern = 0; /* Init. to avoid compiler warning. */ + int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ Tcl_Command cmd; int i; @@ -1718,10 +1693,10 @@ InfoPatchLevelCmd(dummy, interp, objc, objv) * InfoProcsCmd -- * * Called to implement the "info procs" command that returns the list of - * procedures in the interpreter that match an optional pattern. The + * procedures in the interpreter that match an optional pattern. The * pattern, if any, consists of an optional sequence of namespace names * separated by "::" qualifiers, which is followed by a glob-style - * pattern that restricts which commands are returned. Handles the + * pattern that restricts which commands are returned. Handles the * following syntax: * * info procs ?pattern? @@ -1749,9 +1724,9 @@ InfoProcsCmd(dummy, interp, objc, objv) #ifdef INFO_PROCS_SEARCH_GLOBAL_NS Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); #endif - Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; - int specificNsInPattern = 0; /* Init. to avoid compiler warning. */ + int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ register Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Command *cmdPtr, *realCmdPtr; @@ -1842,7 +1817,7 @@ InfoProcsCmd(dummy, interp, objc, objv) goto procOK; } } else { - procOK: + procOK: if (specificNsInPattern) { elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, @@ -1868,7 +1843,7 @@ InfoProcsCmd(dummy, interp, objc, objv) /* * If "info procs" worked like "info commands", returning the commands * also seen in the global namespace, then you would include this - * code. As this could break backwards compatibilty with 8.0-8.2, we + * code. As this could break backwards compatibilty with 8.0-8.2, we * decided not to "fix" it in 8.3, leaving the behavior slightly * different. */ @@ -1918,7 +1893,7 @@ InfoProcsCmd(dummy, interp, objc, objv) * * Side effects: * Returns a result in the interpreter's result object. If there is an - * error, the result is an error message. It may change the internal + * error, the result is an error message. It may change the internal * script filename. * *---------------------------------------------------------------------- @@ -2024,7 +1999,7 @@ InfoTclVersionCmd(dummy, interp, objc, objv) } version = Tcl_GetVar2Ex(interp, "tcl_version", NULL, - (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)); + (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG)); if (version != NULL) { Tcl_SetObjResult(interp, version); return TCL_OK; @@ -2038,10 +2013,10 @@ InfoTclVersionCmd(dummy, interp, objc, objv) * InfoVarsCmd -- * * Called to implement the "info vars" command that returns the list of - * variables in the interpreter that match an optional pattern. The + * variables in the interpreter that match an optional pattern. The * pattern, if any, consists of an optional sequence of namespace names * separated by "::" qualifiers, which is followed by a glob-style - * pattern that restricts which variables are returned. Handles the + * pattern that restricts which variables are returned. Handles the * following syntax: * * info vars ?pattern? @@ -2071,9 +2046,9 @@ InfoVarsCmd(dummy, interp, objc, objv) Var *varPtr; Namespace *nsPtr; Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); - Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); Tcl_Obj *listPtr, *elemObjPtr; - int specificNsInPattern = 0; /* Init. to avoid compiler warning. */ + int specificNsInPattern = 0;/* Init. to avoid compiler warning. */ /* * Get the pattern and find the "effective namespace" in which to list @@ -2101,7 +2076,7 @@ InfoVarsCmd(dummy, interp, objc, objv) /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern); - if (nsPtr != NULL) { /* we successfully found the pattern's ns */ + if (nsPtr != NULL) { /* We successfully found the pattern's ns */ specificNsInPattern = (strcmp(simplePattern, pattern) != 0); } } else { @@ -2175,7 +2150,8 @@ InfoVarsCmd(dummy, interp, objc, objv) || Tcl_StringMatch(varName, simplePattern)) { if (specificNsInPattern) { elemObjPtr = Tcl_NewObj(); - Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, elemObjPtr); + Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, + elemObjPtr); } else { elemObjPtr = Tcl_NewStringObj(varName, -1); } @@ -2228,7 +2204,7 @@ InfoVarsCmd(dummy, interp, objc, objv) * * Tcl_JoinObjCmd -- * - * This procedure is invoked to process the "join" Tcl command. See the + * This procedure is invoked to process the "join" Tcl command. See the * user documentation for details on what it does. * * Results: @@ -2375,7 +2351,7 @@ Tcl_LassignObjCmd(dummy, interp, objc, objv) * Now place a list of any values left over into the interpreter result. * * First, figure out how many values were not assigned by getting the - * length of the list. Note that I do not expect this operation to fail. + * length of the list. Note that I do not expect this operation to fail. */ if (Tcl_ListObjGetElements(interp, objv[1], @@ -2385,7 +2361,7 @@ Tcl_LassignObjCmd(dummy, interp, objc, objv) if (listObjc > objc-2) { /* - * OK, there were left-overs. Make a list of them and slap that back + * OK, there were left-overs. Make a list of them and slap that back * in the interpreter result. */ @@ -2431,7 +2407,7 @@ Tcl_LindexObjCmd(dummy, interp, objc, objv) /* * If objc==3, then objv[2] may be either a single index or a list of - * indices: go to TclLindexList to determine which. If objc>=4, or + * indices: go to TclLindexList to determine which. If objc>=4, or * objc==2, then objv[2 .. objc-2] are all single indices and processed as * such in TclLindexFlat. */ @@ -2471,11 +2447,11 @@ Tcl_LindexObjCmd(dummy, interp, objc, objv) * * Notes: * If objv[1] can be parsed as a list, TclLindexList handles extraction - * of the desired element locally. Otherwise, it invokes TclLindexFlat - * to treat objv[1] as a scalar. + * of the desired element locally. Otherwise, it invokes TclLindexFlat to + * treat objv[1] as a scalar. * * The reference count of the returned object includes one reference - * corresponding to the pointer returned. Thus, the calling code will + * corresponding to the pointer returned. Thus, the calling code will * usually do something like: * Tcl_SetObjResult(interp, result); * Tcl_DecrRefCount(result); @@ -2518,7 +2494,7 @@ TclLindexList(interp, listPtr, argPtr) if (Tcl_ListObjGetElements(NULL, argPtr, &indexCount, &indices) != TCL_OK){ /* * argPtr designates something that is neither an index nor a - * well-formed list. Report the error via TclLindexFlat. + * well-formed list. Report the error via TclLindexFlat. */ return TclLindexFlat(interp, listPtr, 1, &argPtr); @@ -2573,7 +2549,7 @@ TclLindexList(interp, listPtr, argPtr) } /* - * Make sure listPtr still refers to a list object. If it shared a + * Make sure listPtr still refers to a list object. If it shared a * Tcl_Obj structure with the arguments, then it might have just been * converted to something else. */ @@ -2598,7 +2574,7 @@ TclLindexList(interp, listPtr, argPtr) /* * The work we did above may have caused the internal rep of *argPtr - * to change to something else. Get it back. + * to change to something else. Get it back. */ result = Tcl_ListObjGetElements(interp, argPtr, &indexCount, &indices); @@ -2613,7 +2589,7 @@ TclLindexList(interp, listPtr, argPtr) } /* - * Return the last object extracted. Its reference count will include the + * Return the last object extracted. Its reference count will include the * reference being returned. */ @@ -2636,7 +2612,7 @@ TclLindexList(interp, listPtr, argPtr) * * Notes: * This procedure is called from either tclExecute.c or Tcl_LindexObjCmd - * whenever either is presented with objc==2 or objc>=4. It is also + * whenever either is presented with objc==2 or objc>=4. It is also * called from TclLindexList for the objc==3 case once it is determined * that objv[2] cannot be parsed as a list. * @@ -2659,7 +2635,7 @@ TclLindexFlat(interp, listPtr, indexCount, indexArray) Tcl_Obj** elemPtrs; /* Array of pointers to the elements of the * current list. */ int index; /* Parsed version of the current element of - * indexArray. */ + * indexArray. */ Tcl_Obj* oldListPtr; /* Temporary to hold listPtr so that its ref * count can be decremented. */ @@ -2707,9 +2683,9 @@ TclLindexFlat(interp, listPtr, indexCount, indexArray) } /* - * Make sure listPtr still refers to a list object. It might have - * been converted to something else above if objv[1] overlaps with one - * of the other parameters. + * Make sure listPtr still refers to a list object. It might have been + * converted to something else above if objv[1] overlaps with one of + * the other parameters. */ if (listPtr->typePtr != &tclListType) { @@ -2774,7 +2750,7 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv) } /* - * Get the index. "end" is interpreted to be the index after the last + * Get the index. "end" is interpreted to be the index after the last * element, such that using it will cause any inserted elements to be * appended to the list. */ @@ -2829,7 +2805,7 @@ Tcl_LinsertObjCmd(dummy, interp, objc, objv) * * Tcl_ListObjCmd -- * - * This procedure is invoked to process the "list" Tcl command. See the + * This procedure is invoked to process the "list" Tcl command. See the * user documentation for details on what it does. * * Results: @@ -2866,7 +2842,7 @@ Tcl_ListObjCmd(dummy, interp, objc, objv) * Tcl_LlengthObjCmd -- * * This object-based procedure is invoked to process the "llength" Tcl - * command. See the user documentation for details on what it does. + * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result. @@ -2911,8 +2887,8 @@ Tcl_LlengthObjCmd(dummy, interp, objc, objv) * * Tcl_LrangeObjCmd -- * - * This procedure is invoked to process the "lrange" Tcl command. See - * the user documentation for details on what it does. + * This procedure is invoked to process the "lrange" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl object result. @@ -3005,7 +2981,7 @@ Tcl_LrangeObjCmd(notUsed, interp, objc, objv) * * Tcl_LrepeatObjCmd -- * - * This procedure is invoked to process the "lrepeat" Tcl command. See + * This procedure is invoked to process the "lrepeat" Tcl command. See * the user documentation for details on what it does. * * Results: @@ -3020,10 +2996,11 @@ Tcl_LrangeObjCmd(notUsed, interp, objc, objv) /* ARGSUSED */ int Tcl_LrepeatObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - register int objc; /* Number of arguments. */ - register Tcl_Obj *CONST objv[]; /* The argument objects. */ + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + register int objc; /* Number of arguments. */ + register Tcl_Obj *CONST objv[]; + /* The argument objects. */ { int elementCount, i, result; Tcl_Obj *listPtr, **dataArray; @@ -3066,7 +3043,7 @@ Tcl_LrepeatObjCmd(dummy, interp, objc, objv) dataArray = &listRepPtr->elements; /* - * Set the elements. Note that we handle the common degenerate case of a + * Set the elements. Note that we handle the common degenerate case of a * single value being repeated separately to permit the compiler as much * room as possible to optimize a loop that might be run a very large * number of times. @@ -3135,7 +3112,7 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv) } /* - * Get the first and last indexes. "end" is interpreted to be the index + * Get the first and last indexes. "end" is interpreted to be the index * for the last element, such that using it will cause that element to be * included for deletion. */ @@ -3150,13 +3127,13 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv) return result; } - if (first < 0) { + if (first < 0) { first = 0; } /* * Complain if the user asked for a start element that is greater than the - * list length. This won't ever trigger for the "end*" case as that will + * list length. This won't ever trigger for the "end*" case as that will * be properly constrained by TclGetIntForIndex because we use listLen-1 * (to allow for replacing the last elem). */ @@ -3213,7 +3190,7 @@ Tcl_LreplaceObjCmd(dummy, interp, objc, objv) * * Tcl_LsearchObjCmd -- * - * This procedure is invoked to process the "lsearch" Tcl command. See + * This procedure is invoked to process the "lsearch" Tcl command. See * the user documentation for details on what it does. * * Results: @@ -3364,9 +3341,9 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) i++; if (objv[i] == objv[objc - 2]) { /* - * Take copy to prevent shimmering problems. Note that it + * Take copy to prevent shimmering problems. Note that it * does not matter if the index obj is also a component of the - * list being searched. We only need to copy where the list + * list being searched. We only need to copy where the list * and the index are one-and-the-same. */ @@ -3394,7 +3371,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) /* * Store the extracted indices for processing by sublist - * extraction. Note that we don't do this using objects because + * extraction. Note that we don't do this using objects because * that has shimmering problems. */ @@ -3419,7 +3396,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) } /* - * Fill the array by parsing each index. We don't know whether + * Fill the array by parsing each index. We don't know whether * their scale is sensible yet, but we at least perform the * syntactic check here. */ @@ -3556,7 +3533,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) if ((enum modes) mode == SORTED && !allMatches && !negatedMatch) { /* - * If the data is sorted, we can do a more intelligent search. Note + * If the data is sorted, we can do a more intelligent search. Note * that there is no point in being smart when -all was specified; in * that case, we have to look at all items anyway, and there is no * sense in doing this when the match sense is inverted. @@ -3618,13 +3595,13 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) if (match == 0) { /* * Normally, binary search is written to stop when it finds a - * match. If there are duplicates of an element in the list, + * match. If there are duplicates of an element in the list, * our first match might not be the first occurance. - * Consider: 0 0 0 1 1 1 2 2 2 + * Consider: 0 0 0 1 1 1 2 2 2 * * To maintain consistancy with standard lsearch semantics, we * must find the leftmost occurance of the pattern in the - * list. Thus we don't just stop searching here. This + * list. Thus we don't just stop searching here. This * variation means that a search always makes log n * comparisons (normal binary search might "get lucky" with an * early comparison). @@ -3802,7 +3779,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) } } else if (index < 0) { /* - * Is this superfluous? The result should be a blank object by + * Is this superfluous? The result should be a blank object by * default... */ @@ -3826,7 +3803,7 @@ Tcl_LsearchObjCmd(clientData, interp, objc, objv) * * Tcl_LsetObjCmd -- * - * This procedure is invoked to process the "lset" Tcl command. See the + * This procedure is invoked to process the "lset" Tcl command. See the * user documentation for details on what it does. * * Results: @@ -3868,7 +3845,7 @@ Tcl_LsetObjCmd(clientData, interp, objc, objv) } /* - * Substitute the value in the value. Return either the value or else an + * Substitute the value in the value. Return either the value or else an * unshared copy of it. */ @@ -3911,7 +3888,7 @@ Tcl_LsetObjCmd(clientData, interp, objc, objv) * * Tcl_LsortObjCmd -- * - * This procedure is invoked to process the "lsort" Tcl command. See the + * This procedure is invoked to process the "lsort" Tcl command. See the * user documentation for details on what it does. * * Results: @@ -4034,7 +4011,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv) } /* - * Fill the array by parsing each index. We don't know whether + * Fill the array by parsing each index. We don't know whether * their scale is sensible yet, but we at least perform the * syntactic check here. */ @@ -4178,13 +4155,13 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv) static SortElement * MergeSort(headPtr, infoPtr) - SortElement *headPtr; /* First element on the list. */ - SortInfo *infoPtr; /* Information needed by the - * comparison operator. */ + SortElement *headPtr; /* First element on the list. */ + SortInfo *infoPtr; /* Information needed by the comparison + * operator. */ { /* * The subList array below holds pointers to temporary lists built during - * the merge sort. Element i of the array holds a list of length 2**i. + * the merge sort. Element i of the array holds a list of length 2**i. */ # define NUM_LISTS 30 @@ -4234,12 +4211,10 @@ MergeSort(headPtr, infoPtr) static SortElement * MergeLists(leftPtr, rightPtr, infoPtr) - SortElement *leftPtr; /* First list to be merged; may be - * NULL. */ - SortElement *rightPtr; /* Second list to be merged; may be - * NULL. */ - SortInfo *infoPtr; /* Information needed by the - * comparison operator. */ + SortElement *leftPtr; /* First list to be merged; may be NULL. */ + SortElement *rightPtr; /* Second list to be merged; may be NULL. */ + SortInfo *infoPtr; /* Information needed by the comparison + * operator. */ { SortElement *headPtr; SortElement *tailPtr; @@ -4297,7 +4272,7 @@ MergeLists(leftPtr, rightPtr, infoPtr) * Results: * A negative results means the the first element comes before the * second, and a positive results means that the second element should - * come first. A result of zero means the two elements are equal and it + * come first. A result of zero means the two elements are equal and it * doesn't matter which comes first. * * Side effects: @@ -4308,9 +4283,9 @@ MergeLists(leftPtr, rightPtr, infoPtr) static int SortCompare(objPtr1, objPtr2, infoPtr) - Tcl_Obj *objPtr1, *objPtr2; /* Values to be compared. */ - SortInfo *infoPtr; /* Information passed from the - * top-level "lsort" command. */ + Tcl_Obj *objPtr1, *objPtr2; /* Values to be compared. */ + SortInfo *infoPtr; /* Information passed from the top-level + * "lsort" command. */ { int order; @@ -4372,7 +4347,7 @@ SortCompare(objPtr1, objPtr2, infoPtr) paramObjv[0] = objPtr1; paramObjv[1] = objPtr2; - /* + /* * We made space in the command list for the two things to compare. * Replace them and evaluate the result. */ @@ -4380,12 +4355,12 @@ SortCompare(objPtr1, objPtr2, infoPtr) Tcl_ListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc); Tcl_ListObjReplace(infoPtr->interp, infoPtr->compareCmdPtr, objc - 2, 2, 2, paramObjv); - Tcl_ListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr, + Tcl_ListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr, &objc, &objv); infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0); - if (infoPtr->resultCode != TCL_OK) { + if (infoPtr->resultCode != TCL_OK) { Tcl_AddErrorInfo(infoPtr->interp, "\n (-compare command)"); return order; @@ -4416,16 +4391,16 @@ SortCompare(objPtr1, objPtr2, infoPtr) * DictionaryCompare * * This function compares two strings as if they were being used in an - * index or card catalog. The case of alphabetic characters is ignored, - * except to break ties. Thus "B" comes before "b" but after "a". Also, - * integers embedded in the strings compare in numerical order. In other + * index or card catalog. The case of alphabetic characters is ignored, + * except to break ties. Thus "B" comes before "b" but after "a". Also, + * integers embedded in the strings compare in numerical order. In other * words, "x10y" comes after "x9y", not * before it as it would when * using strcmp(). * * Results: * A negative result means that the first element comes before the * second, and a positive result means that the second element should - * come first. A result of zero means the two elements are equal and it + * come first. A result of zero means the two elements are equal and it * doesn't matter which comes first. * * Side effects: @@ -4436,7 +4411,7 @@ SortCompare(objPtr1, objPtr2, infoPtr) static int DictionaryCompare(left, right) - char *left, *right; /* The strings to compare. */ + char *left, *right; /* The strings to compare. */ { Tcl_UniChar uniLeft, uniRight, uniLeftLower, uniRightLower; int diff, zeros; @@ -4446,8 +4421,8 @@ DictionaryCompare(left, right) if (isdigit(UCHAR(*right)) /* INTL: digit */ && isdigit(UCHAR(*left))) { /* INTL: digit */ /* - * There are decimal numbers embedded in the two strings. Compare - * them as numbers, rather than strings. If one number has more + * There are decimal numbers embedded in the two strings. Compare + * them as numbers, rather than strings. If one number has more * leading zeros than the other, the number with more leading * zeros sorts later, but only as a secondary choice. */ @@ -4467,7 +4442,7 @@ DictionaryCompare(left, right) /* * The code below compares the numbers in the two strings without - * ever converting them to integers. It does this by first + * ever converting them to integers. It does this by first * comparing the lengths of the numbers and then comparing the * digit values. */ @@ -4501,7 +4476,7 @@ DictionaryCompare(left, right) } /* - * Convert character to Unicode for comparison purposes. If either + * Convert character to Unicode for comparison purposes. If either * string is at the terminating null, do a byte-wise comparison and * bail out immediately. */ @@ -4512,7 +4487,7 @@ DictionaryCompare(left, right) /* * Convert both chars to lower for the comparison, because - * dictionary sorts are case insensitve. Covert to lower, not + * dictionary sorts are case insensitve. Covert to lower, not * upper, so chars between Z and a will sort before A (where most * other interesting punctuations occur) */ @@ -4547,7 +4522,7 @@ DictionaryCompare(left, right) * * SelectObjFromSublist -- * - * This procedure is invoked from lsearch and SortCompare. It is used + * This procedure is invoked from lsearch and SortCompare. It is used * for implementing the -index option, for the lsort and lsearch * commands. * @@ -4567,10 +4542,9 @@ DictionaryCompare(left, right) static Tcl_Obj* SelectObjFromSublist(objPtr, infoPtr) - Tcl_Obj *objPtr; /* Obj to select sublist from. */ - SortInfo *infoPtr; /* Information passed from the - * top-level "lsearch" or "lsort" - * command. */ + Tcl_Obj *objPtr; /* Obj to select sublist from. */ + SortInfo *infoPtr; /* Information passed from the top-level + * "lsearch" or "lsort" command. */ { int i; diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 094dcac..2a94eb8 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2,8 +2,8 @@ * tclCmdMZ.c -- * * This file contains the top-level command routines for most of the Tcl - * built-in commands whose names begin with the letters M to Z. It - * contains only commands in the generic core (i.e. those that don't + * built-in commands whose names begin with the letters M to Z. It + * contains only commands in the generic core (i.e. those that don't * depend much upon UNIX facilities). * * Copyright (c) 1987-1993 The Regents of the University of California. @@ -15,18 +15,18 @@ * 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.127 2005/07/17 21:17:37 dkf Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.128 2005/08/26 13:26:55 dkf Exp $ */ #include "tclInt.h" #include "tclRegexp.h" - + /* *---------------------------------------------------------------------- * * Tcl_PwdObjCmd -- * - * This procedure is invoked to process the "pwd" Tcl command. See the + * This procedure is invoked to process the "pwd" Tcl command. See the * user documentation for details on what it does. * * Results: @@ -41,10 +41,10 @@ /* ARGSUSED */ int Tcl_PwdObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { Tcl_Obj *retVal; @@ -67,7 +67,7 @@ Tcl_PwdObjCmd(dummy, interp, objc, objv) * * Tcl_RegexpObjCmd -- * - * This procedure is invoked to process the "regexp" Tcl command. See + * This procedure is invoked to process the "regexp" Tcl command. See * the user documentation for details on what it does. * * Results: @@ -82,10 +82,10 @@ Tcl_PwdObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int Tcl_RegexpObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { int i, indices, match, about, offset, all, doinline, numMatchesSaved; int cflags, eflags, stringLength; @@ -103,13 +103,13 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) REGEXP_NOCASE, REGEXP_START, REGEXP_LAST }; - indices = 0; - about = 0; - cflags = TCL_REG_ADVANCED; - eflags = 0; - offset = 0; - all = 0; - doinline = 0; + indices = 0; + about = 0; + cflags = TCL_REG_ADVANCED; + eflags = 0; + offset = 0; + all = 0; + doinline = 0; for (i = 1; i < objc; i++) { char *name; @@ -172,7 +172,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) } } - endOfForLoop: + endOfForLoop: if ((objc - i) < (2 - about)) { Tcl_WrongNumArgs(interp, 1, objv, "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"); @@ -199,7 +199,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) if (about) { regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags); if ((regExpr == NULL) || (TclRegAbout(interp, regExpr) < 0)) { - optionError: + optionError: if (startIndex) { Tcl_DecrRefCount(startIndex); } @@ -210,7 +210,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) /* * Get the length of the string that we are matching against so we can do - * the termination test for -all matches. Do this before getting the + * the termination test for -all matches. Do this before getting the * regexp to avoid shimmering problems. */ @@ -260,8 +260,8 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) /* * The following loop is to handle multiple matches within the same source - * string; each iteration handles one match. If "-all" hasn't been - * specified then the loop body only gets executed once. We terminate the + * string; each iteration handles one match. If "-all" hasn't been + * specified then the loop body only gets executed once. We terminate the * loop when the starting offset is past the end of the string. */ @@ -269,8 +269,8 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset /* offset */, numMatchesSaved, eflags | ((offset > 0 && - (Tcl_GetUniChar(objPtr,offset-1) != (Tcl_UniChar)'\n')) - ? TCL_REG_NOTBOL : 0)); + (Tcl_GetUniChar(objPtr,offset-1) != (Tcl_UniChar)'\n')) + ? TCL_REG_NOTBOL : 0)); if (match < 0) { return TCL_ERROR; @@ -323,12 +323,12 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) /* * Only adjust the match area if there was a match for that - * area. (Scriptics Bug 4391/SF Bug #219232) + * area. (Scriptics Bug 4391/SF Bug #219232) */ if (i <= info.nsubs && info.matches[i].start >= 0) { start = offset + info.matches[i].start; - end = offset + info.matches[i].end; + end = offset + info.matches[i].end; /* * Adjust index so it refers to the last character in the @@ -340,7 +340,7 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) } } else { start = -1; - end = -1; + end = -1; } objs[0] = Tcl_NewLongObj(start); @@ -382,8 +382,8 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) /* * Adjust the offset to the character just after the last one in the * matchVar and increment all to count how many times we are making a - * match. We always increment the offset by at least one to prevent - * endless looping (as in the case: regexp -all {a*} a). Otherwise, + * match. We always increment the offset by at least one to prevent + * endless looping (as in the case: regexp -all {a*} a). Otherwise, * when we match the NULL string at the end of the input string, we * will loop indefinately (because the length of the match is 0, so * offset never changes). @@ -419,8 +419,8 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) * * Tcl_RegsubObjCmd -- * - * This procedure is invoked to process the "regsub" Tcl command. See - * the user documentation for details on what it does. + * This procedure is invoked to process the "regsub" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -434,10 +434,10 @@ Tcl_RegexpObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int Tcl_RegsubObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { int idx, result, cflags, all, wlen, wsublen, numMatches, offset; int start, end, subStart, subEnd, match; @@ -542,28 +542,27 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) && (strpbrk(TclGetString(objv[2]), "&\\") == NULL) && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) { /* - * This is a simple one pair string map situation. We make use of a + * This is a simple one pair string map situation. We make use of a * slightly modified version of the one pair STR_MAP code. */ int slen, nocase; - int (*strCmpFn)_ANSI_ARGS_((CONST Tcl_UniChar *, CONST Tcl_UniChar *, - unsigned long)); + int (*strCmpFn)(CONST Tcl_UniChar*, CONST Tcl_UniChar*, unsigned long); Tcl_UniChar *p, wsrclc; numMatches = 0; - nocase = (cflags & TCL_REG_NOCASE); - strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp; + nocase = (cflags & TCL_REG_NOCASE); + strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp; - wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen); - wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen); + wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen); + wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen); wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen); - wend = wstring + wlen - (slen ? slen - 1 : 0); - result = TCL_OK; + wend = wstring + wlen - (slen ? slen - 1 : 0); + result = TCL_OK; if (slen == 0) { /* - * regsub behavior for "" matches between each character. 'string + * regsub behavior for "" matches between each character. 'string * map' skips the "" case. */ @@ -616,7 +615,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) } /* - * Make sure to avoid problems where the objects are shared. This can + * Make sure to avoid problems where the objects are shared. This can * cause RegExpObj <> UnicodeObj shimmering that causes data corruption. * [Bug #461322] */ @@ -639,8 +638,8 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) /* * The following loop is to handle multiple matches within the same source * string; each iteration handles one match and its corresponding - * substitution. If "-all" hasn't been specified then the loop body only - * gets executed once. We must use 'offset <= wlen' in particular for the + * substitution. If "-all" hasn't been specified then the loop body only + * gets executed once. We must use 'offset <= wlen' in particular for the * case where the regexp pattern can match the empty string - this is * useful when doing, say, 'regsub -- ^ $str ...' when $str might be * empty. @@ -656,8 +655,8 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset, 10 /* matches */, ((offset > 0 && - (wstring[offset-1] != (Tcl_UniChar)'\n')) - ? TCL_REG_NOTBOL : 0)); + (wstring[offset-1] != (Tcl_UniChar)'\n')) + ? TCL_REG_NOTBOL : 0)); if (match < 0) { result = TCL_ERROR; @@ -692,7 +691,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) /* * Append the subSpec argument to the variable, making appropriate - * substitutions. This code is a bit hairy because of the backslash + * substitutions. This code is a bit hairy because of the backslash * conventions and because the code saves up ranges of characters in * subSpec to reduce the number of calls to Tcl_SetVar. */ @@ -779,7 +778,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) * result variable. */ - regsubDone: + regsubDone: if (numMatches == 0) { /* * On zero matches, just ignore the offset, since it shouldn't matter @@ -812,7 +811,7 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) Tcl_SetObjResult(interp, resultPtr); } - done: + done: if (objPtr && (objv[1] == objv[0])) { Tcl_DecrRefCount(objPtr); } @@ -830,8 +829,8 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv) * * Tcl_RenameObjCmd -- * - * This procedure is invoked to process the "rename" Tcl command. See - * the user documentation for details on what it does. + * This procedure is invoked to process the "rename" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl object result. @@ -915,8 +914,8 @@ Tcl_ReturnObjCmd(dummy, interp, objc, objv) * * Tcl_SourceObjCmd -- * - * This procedure is invoked to process the "source" Tcl command. See - * the user documentation for details on what it does. + * This procedure is invoked to process the "source" Tcl command. See the + * user documentation for details on what it does. * * Results: * A standard Tcl object result. @@ -966,7 +965,7 @@ Tcl_SourceObjCmd(dummy, interp, objc, objv) * * Tcl_SplitObjCmd -- * - * This procedure is invoked to process the "split" Tcl command. See the + * This procedure is invoked to process the "split" Tcl command. See the * user documentation for details on what it does. * * Results: @@ -1019,7 +1018,7 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv) * Handle the special case of splitting on every character. * * Uses a hash table to ensure that each kind of character has only - * one Tcl_Obj instance (multiply-referenced) in the final list. This + * one Tcl_Obj instance (multiply-referenced) in the final list. This * is a *major* win when splitting on a long string (especially in the * megabyte range!) - DKF */ @@ -1053,9 +1052,9 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv) char *p; /* - * Handle the special case of splitting on a single character. This - * is only true for the one-char ASCII case, as one unicode char is > - * 1 byte in length. + * Handle the special case of splitting on a single character. This is + * only true for the one-char ASCII case, as one unicode char is > 1 + * byte in length. */ while (*stringPtr && (p=strchr(stringPtr,(int)*splitChars)) != NULL) { @@ -1071,7 +1070,7 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv) Tcl_UniChar splitChar; /* - * Normal case: split on any of a given set of characters. Discard + * Normal case: split on any of a given set of characters. Discard * instances of the split characters. */ @@ -1102,14 +1101,14 @@ Tcl_SplitObjCmd(dummy, interp, objc, objv) * * Tcl_StringObjCmd -- * - * This procedure is invoked to process the "string" Tcl command. See - * the user documentation for details on what it does. Note that this - * command only functions correctly on properly formed Tcl UTF strings. + * This procedure is invoked to process the "string" Tcl command. See the + * user documentation for details on what it does. Note that this command + * only functions correctly on properly formed Tcl UTF strings. * - * Note that the primary methods here (equal, compare, match, ...) have - * bytecode equivalents. You will find the code for those in - * tclExecute.c. The code here will only be used in the non-bc case - * (like in an 'eval'). + * Note that the primary methods here (equal, compare, match, ...) have + * bytecode equivalents. You will find the code for those in + * tclExecute.c. The code here will only be used in the non-bc case (like + * in an 'eval'). * * Results: * A standard Tcl result. @@ -1149,7 +1148,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) }; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?"); return TCL_ERROR; } @@ -1169,8 +1168,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) */ int i, match, length, nocase = 0, reqlength = -1; - typedef int (*strCmpFn_t) _ANSI_ARGS_((const char *, const char *, - unsigned int)); + typedef int (*strCmpFn_t)(const char *, const char *, unsigned int); strCmpFn_t strCmpFn; if (objc < 4 || objc > 7) { @@ -1220,7 +1218,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) objv[1]->typePtr == &tclByteArrayType) { /* * Use binary versions of comparisons since that won't cause undue - * type conversions and it is much faster. Only do this if we're + * type conversions and it is much faster. Only do this if we're * case-sensitive (which is all that really makes sense with byte * arrays anyway, and we have no memcasecmp() for some * reason... :^) @@ -1233,7 +1231,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) && (objv[1]->typePtr == &tclStringType)) { /* * Do a unicode-specific comparison if both of the args are of - * String type. In benchmark testing this proved the most + * String type. In benchmark testing this proved the most * efficient check between the unicode and string comparison * operations. */ @@ -1244,9 +1242,9 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) (nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp); } else { /* - * As a catch-all we will work with UTF-8. We cannot use memcmp() + * As a catch-all we will work with UTF-8. We cannot use memcmp() * as that is unsafe with any string containing NULL (\xC0\x80 in - * Tcl's utf rep). We can use the more efficient TclpUtfNcmp2 if + * Tcl's utf rep). We can use the more efficient TclpUtfNcmp2 if * we are case-sensitive and no specific length was requested. */ @@ -1315,7 +1313,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) if (objc == 5) { /* * If a startIndex is specified, we will need to fast forward to - * that point in the string before we think about a match + * that point in the string before we think about a match. */ if (TclGetIntForIndex(interp, objv[4], length2 - 1, @@ -1326,7 +1324,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) goto str_first_done; } else if (start > 0) { ustring2 += start; - length2 -= start; + length2 -= start; } else if (start < 0) { /* * Invalid start index mapped to string start; Bug #423581 @@ -1373,7 +1371,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) /* * If we have a ByteArray object, avoid indexing in the Utf string - * since the byte array contains one byte per character. Otherwise, + * since the byte array contains one byte per character. Otherwise, * use the Unicode string rep to get the index'th char. */ @@ -1418,7 +1416,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) * The UniChar comparison function */ - int (*chcomp)_ANSI_ARGS_((int)) = NULL; + int (*chcomp)(int) = NULL; int i, failat = 0, result = 1, strict = 0; Tcl_Obj *objPtr, *failVarObj = NULL; Tcl_WideInt w; @@ -1542,8 +1540,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) * * The danger in this function is that "12345678901234567890" is * an acceptable 'double', but will later be interp'd as an int by - * something like [expr]. Therefore, we check to see if it looks - * like an int, and if so we do a range check on it. If strtoul + * something like [expr]. Therefore, we check to see if it looks + * like an int, and if so we do a range check on it. If strtoul * gets to the end, we know we either received an acceptable int, * or over/underflow. */ @@ -1653,7 +1651,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) } /* - * Like STR_IS_DOUBLE, but we use strtoll. Since + * Like STR_IS_DOUBLE, but we use strtoll. Since * Tcl_GetWideIntFromObj already failed, we set result to 0. */ @@ -1767,7 +1765,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) } if (length1 > 0) { - for (; p >= ustring2; p--) { + for (; p >= ustring2; p--) { /* * Scan backwards to find the first character. */ @@ -1813,8 +1811,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) int mapElemc, nocase = 0, mapWithDict = 0, copySource = 0; Tcl_Obj **mapElemv, *sourceObj, *resultPtr; Tcl_UniChar *ustring1, *ustring2, *p, *end; - int (*strCmpFn)_ANSI_ARGS_((CONST Tcl_UniChar *, CONST Tcl_UniChar *, - unsigned long)); + int (*strCmpFn)(CONST Tcl_UniChar*, CONST Tcl_UniChar*, unsigned long); if (objc < 4 || objc > 5) { Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? charMap string"); @@ -1846,7 +1843,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) /* * We know the type exactly, so all dict operations will succeed - * for sure. This shortens this code quite a bit. + * for sure. This shortens this code quite a bit. */ Tcl_DictObjSize(interp, objv[objc-2], &mapElemc); @@ -1974,9 +1971,9 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) int *mapLens; /* - * Precompute pointers to the unicode string and length. This + * Precompute pointers to the unicode string and length. This * saves us repeated function calls later, significantly speeding - * up the algorithm. We only need the lowercase first char in the + * up the algorithm. We only need the lowercase first char in the * nocase case. */ @@ -2001,7 +1998,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) */ ustring2 = mapStrings[index]; - length2 = mapLens[index]; + length2 = mapLens[index]; if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase && (Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) && @@ -2094,7 +2091,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) /* * If we have a ByteArray object, avoid indexing in the Utf string - * since the byte array contains one byte per character. Otherwise, + * since the byte array contains one byte per character. Otherwise, * use the Unicode string rep to get the range. */ @@ -2151,16 +2148,18 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) string1 = Tcl_GetStringFromObj(objv[2], &length1); if (length1 > 0) { /* - * Only build up a string that has data. Instead of building + * Only build up a string that has data. Instead of building * it up with repeated appends, we just allocate the necessary - * space once and copy the string value in. Check for - * overflow with back-division. [Bug #714106] + * space once and copy the string value in. Check for overflow + * with back-division. [Bug #714106] */ Tcl_Obj *resultPtr; + length2 = length1 * count; if ((length2 / count) != length1) { char buf[TCL_INTEGER_SPACE+1]; + sprintf(buf, "%d", INT_MAX); Tcl_AppendResult(interp, "string size overflow, must be less than ", @@ -2361,8 +2360,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) end = string1; /* - * The outer loop iterates over the string. The inner loop - * iterates over the trim characters. The loops terminate as soon + * The outer loop iterates over the string. The inner loop + * iterates over the trim characters. The loops terminate as soon * as a non-trim character is discovered and length1 marks the * last non-trim character. */ @@ -2468,9 +2467,9 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) * * Tcl_SubstObjCmd -- * - * This procedure is invoked to process the "subst" Tcl command. See the - * user documentation for details on what it does. This command relies - * on Tcl_SubstObj() for its implementation. + * This procedure is invoked to process the "subst" Tcl command. See the + * user documentation for details on what it does. This command relies on + * Tcl_SubstObj() for its implementation. * * Results: * A standard Tcl result. @@ -2484,16 +2483,16 @@ Tcl_StringObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int Tcl_SubstObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { static CONST char *substOptions[] = { "-nobackslashes", "-nocommands", "-novariables", (char *) NULL }; enum substOptions { - SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS + SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS }; Tcl_Obj *resultPtr; int optionIndex, flags, i; @@ -2585,7 +2584,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_MATCHV, OPT_NOCASE, OPT_REGEXP, OPT_LAST }; - typedef int (*strCmpFn_t) _ANSI_ARGS_((const char *, const char *)); + typedef int (*strCmpFn_t)(const char *, const char *); strCmpFn_t strCmpFn = strcmp; mode = OPT_EXACT; @@ -2730,7 +2729,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) } /* - * Complain if the last body is a continuation. Note that this check + * Complain if the last body is a continuation. Note that this check * assumes that the list is non-empty! */ @@ -2754,7 +2753,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) /* * If either indexVarObj or matchVarObj are non-NULL, we're in - * REGEXP mode but have reached the default clause anyway. TIP#75 + * REGEXP mode but have reached the default clause anyway. TIP#75 * specifies that we set the variables to empty lists (== empty * objects) in that case. */ @@ -2865,10 +2864,10 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) Tcl_DecrRefCount(indicesObj); /* - * Careful! Check to see if we have allocated the list of + * Careful! Check to see if we have allocated the list of * matched strings; if so (but there was an error assigning * the indices list) we have a potential memory leak because - * the match list has not been written to a variable. Except + * the match list has not been written to a variable. Except * that we'll clean that up right now. */ @@ -2906,6 +2905,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) * This shouldn't happen since we've checked that the last body is * not a continuation... */ + Tcl_Panic("fall-out when searching for body to match pattern"); } if (strcmp(TclGetString(objv[j]), "-") != 0) { @@ -2922,6 +2922,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) if (result == TCL_ERROR) { Tcl_Obj *msg = Tcl_NewStringObj("\n (\"", -1); Tcl_Obj *errorLine = Tcl_NewIntObj(interp->errorLine); + Tcl_IncrRefCount(msg); Tcl_IncrRefCount(errorLine); TclAppendLimitedToObj(msg, pattern, -1, 50, ""); @@ -2941,7 +2942,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv) * Tcl_TimeObjCmd -- * * This object-based procedure is invoked to process the "time" Tcl - * command. See the user documentation for details on what it does. + * command. See the user documentation for details on what it does. * * Results: * A standard Tcl object result. @@ -3021,62 +3022,62 @@ Tcl_TimeObjCmd(dummy, interp, objc, objv) * * Tcl_WhileObjCmd -- * - * This procedure is invoked to process the "while" Tcl command. See the - * user documentation for details on what it does. + * This procedure is invoked to process the "while" Tcl command. See the + * user documentation for details on what it does. * * With the bytecode compiler, this procedure is only called when a * command name is computed at runtime, and is "while" or the name to * which "while" was renamed: e.g., "set z while; $z {$i<100} {}" * * Results: - * A standard Tcl result. + * A standard Tcl result. * * Side effects: - * See the user documentation. + * See the user documentation. * *---------------------------------------------------------------------- */ - /* ARGSUSED */ + /* ARGSUSED */ int Tcl_WhileObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ + ClientData dummy; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST objv[]; /* Argument objects. */ { int result, value; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "test command"); - return TCL_ERROR; + return TCL_ERROR; } while (1) { - result = Tcl_ExprBooleanObj(interp, objv[1], &value); - if (result != TCL_OK) { - return result; - } - if (!value) { - break; - } - result = Tcl_EvalObjEx(interp, objv[2], 0); - if ((result != TCL_OK) && (result != TCL_CONTINUE)) { - if (result == TCL_ERROR) { - char msg[32 + TCL_INTEGER_SPACE]; - - sprintf(msg, "\n (\"while\" body line %d)", - interp->errorLine); - Tcl_AddErrorInfo(interp, msg); - } - break; - } + result = Tcl_ExprBooleanObj(interp, objv[1], &value); + if (result != TCL_OK) { + return result; + } + if (!value) { + break; + } + result = Tcl_EvalObjEx(interp, objv[2], 0); + if ((result != TCL_OK) && (result != TCL_CONTINUE)) { + if (result == TCL_ERROR) { + char msg[32 + TCL_INTEGER_SPACE]; + + sprintf(msg, "\n (\"while\" body line %d)", + interp->errorLine); + Tcl_AddErrorInfo(interp, msg); + } + break; + } } if (result == TCL_BREAK) { - result = TCL_OK; + result = TCL_OK; } if (result == TCL_OK) { - Tcl_ResetResult(interp); + Tcl_ResetResult(interp); } return result; } |