diff options
Diffstat (limited to 'generic/tclCmdIL.c')
| -rw-r--r-- | generic/tclCmdIL.c | 1452 |
1 files changed, 871 insertions, 581 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 35a48d3..41c1eb6 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -3,7 +3,7 @@ * * This file contains the top-level command routines for most of the Tcl * built-in commands whose names begin with the letters I through L. It - * contains only commands in the generic core (i.e. those that don't + * 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,8 +15,6 @@ * * 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.137.2.9 2010/06/22 12:12:48 dkf Exp $ */ #include "tclInt.h" @@ -29,13 +27,16 @@ */ typedef struct SortElement { - union { - char *strValuePtr; - long intValue; + union { /* The value that we sorting by. */ + const char *strValuePtr; + long intValue; double doubleValue; Tcl_Obj *objValuePtr; - } index; - Tcl_Obj *objPtr; /* Object being sorted, or its index. */ + } collationKey; + union { /* Object being sorted, or its index. */ + Tcl_Obj *objPtr; + int index; + } payload; struct SortElement *nextPtr;/* Next element in the list, or NULL for end * of list. */ } SortElement; @@ -103,46 +104,51 @@ typedef struct SortInfo { * Forward declarations for procedures defined in this file: */ -static int DictionaryCompare(char *left, char *right); +static int DictionaryCompare(const char *left, const char *right); +static int IfConditionCallback(ClientData data[], + Tcl_Interp *interp, int result); static int InfoArgsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int InfoBodyCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int InfoCmdCountCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int InfoCommandsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int InfoCompleteCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int InfoDefaultCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); +/* TIP #348 - New 'info' subcommand 'errorstack' */ +static int InfoErrorStackCmd(ClientData dummy, Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[]); /* TIP #280 - New 'info' subcommand 'frame' */ static int InfoFrameCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int InfoFunctionsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int InfoHostnameCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int InfoLevelCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int InfoLibraryCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int InfoLoadedCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int InfoNameOfExecutableCmd(ClientData dummy, Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[]); + Tcl_Obj *const objv[]); static int InfoPatchLevelCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int InfoProcsCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int InfoScriptCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); + int objc, Tcl_Obj *const objv[]); static int InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[]); -static SortElement * MergeLists(SortElement *leftPtr, SortElement *rightPtr, + int objc, Tcl_Obj *const objv[]); +static SortElement * MergeLists(SortElement *leftPtr, SortElement *rightPtr, SortInfo *infoPtr); static int SortCompare(SortElement *firstPtr, SortElement *second, SortInfo *infoPtr); @@ -155,29 +161,31 @@ static Tcl_Obj * SelectObjFromSublist(Tcl_Obj *firstPtr, */ static const EnsembleImplMap defaultInfoMap[] = { - {"args", InfoArgsCmd, NULL}, - {"body", InfoBodyCmd, NULL}, - {"cmdcount", InfoCmdCountCmd, NULL}, - {"commands", InfoCommandsCmd, NULL}, - {"complete", InfoCompleteCmd, NULL}, - {"default", InfoDefaultCmd, NULL}, - {"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd}, - {"frame", InfoFrameCmd, NULL}, - {"functions", InfoFunctionsCmd, NULL}, - {"globals", TclInfoGlobalsCmd, NULL}, - {"hostname", InfoHostnameCmd, NULL}, - {"level", InfoLevelCmd, NULL}, - {"library", InfoLibraryCmd, NULL}, - {"loaded", InfoLoadedCmd, NULL}, - {"locals", TclInfoLocalsCmd, NULL}, - {"nameofexecutable", InfoNameOfExecutableCmd, NULL}, - {"patchlevel", InfoPatchLevelCmd, NULL}, - {"procs", InfoProcsCmd, NULL}, - {"script", InfoScriptCmd, NULL}, - {"sharedlibextension", InfoSharedlibCmd, NULL}, - {"tclversion", InfoTclVersionCmd, NULL}, - {"vars", TclInfoVarsCmd, NULL}, - {NULL, NULL, NULL} + {"args", InfoArgsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"body", InfoBodyCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"cmdcount", InfoCmdCountCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"commands", InfoCommandsCmd, TclCompileInfoCommandsCmd, NULL, NULL, 0}, + {"complete", InfoCompleteCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"coroutine", TclInfoCoroutineCmd, TclCompileInfoCoroutineCmd, NULL, NULL, 0}, + {"default", InfoDefaultCmd, TclCompileBasic3ArgCmd, NULL, NULL, 0}, + {"errorstack", InfoErrorStackCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"exists", TclInfoExistsCmd, TclCompileInfoExistsCmd, NULL, NULL, 0}, + {"frame", InfoFrameCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"functions", InfoFunctionsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"globals", TclInfoGlobalsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"hostname", InfoHostnameCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"level", InfoLevelCmd, TclCompileInfoLevelCmd, NULL, NULL, 0}, + {"library", InfoLibraryCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"loaded", InfoLoadedCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"locals", TclInfoLocalsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"nameofexecutable", InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"patchlevel", InfoPatchLevelCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"procs", InfoProcsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"script", InfoScriptCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"sharedlibextension", InfoSharedlibCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"tclversion", InfoTclVersionCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"vars", TclInfoVarsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {NULL, NULL, NULL, NULL, NULL, 0} }; /* @@ -206,42 +214,68 @@ Tcl_IfObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + return Tcl_NRCallObjProc(interp, TclNRIfObjCmd, dummy, objc, objv); +} + +int +TclNRIfObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Tcl_Obj *boolObj; + + if (objc <= 1) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: no expression after \"%s\" argument", + TclGetString(objv[0]))); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); + return TCL_ERROR; + } + + /* + * At this point, objv[1] refers to the main expression to test. The + * arguments after the expression must be "then" (optional) and a script + * to execute if the expression is true. + */ + + TclNewObj(boolObj); + Tcl_NRAddCallback(interp, IfConditionCallback, INT2PTR(objc), + (ClientData) objv, INT2PTR(1), boolObj); + return Tcl_NRExprObj(interp, objv[1], boolObj); +} + +static int +IfConditionCallback( + ClientData data[], + Tcl_Interp *interp, + int result) { - int thenScriptIndex = 0; /* "then" script to be evaled after syntax - * check. */ Interp *iPtr = (Interp *) interp; - int i, result, value; - char *clause; + int objc = PTR2INT(data[0]); + Tcl_Obj *const *objv = data[1]; + int i = PTR2INT(data[2]); + Tcl_Obj *boolObj = data[3]; + int value, thenScriptIndex = 0; + const char *clause; - i = 1; - while (1) { - /* - * 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" - * (optional) and a script to execute if the expression is true. - */ + if (result != TCL_OK) { + TclDecrRefCount(boolObj); + return result; + } + if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) { + TclDecrRefCount(boolObj); + return TCL_ERROR; + } + TclDecrRefCount(boolObj); - if (i >= objc) { - clause = TclGetString(objv[i-1]); - Tcl_AppendResult(interp, "wrong # args: ", - "no expression after \"", clause, "\" argument", NULL); - return TCL_ERROR; - } - if (!thenScriptIndex) { - result = Tcl_ExprBooleanObj(interp, objv[i], &value); - if (result != TCL_OK) { - return result; - } - } + while (1) { i++; if (i >= objc) { - missingScript: - clause = TclGetString(objv[i-1]); - Tcl_AppendResult(interp, "wrong # args: ", - "no script following \"", clause, "\" argument", NULL); - return TCL_ERROR; + goto missingScript; } clause = TclGetString(objv[i]); if ((i < objc) && (strcmp(clause, "then") == 0)) { @@ -267,17 +301,37 @@ Tcl_IfObjCmd( * TIP #280. Make invoking context available to branch. */ - return TclEvalObjEx(interp, objv[thenScriptIndex], 0, + return TclNREvalObjEx(interp, objv[thenScriptIndex], 0, iPtr->cmdFramePtr, thenScriptIndex); } return TCL_OK; } clause = TclGetString(objv[i]); - if ((clause[0] == 'e') && (strcmp(clause, "elseif") == 0)) { - i++; - continue; + if ((clause[0] != 'e') || (strcmp(clause, "elseif") != 0)) { + break; + } + i++; + + /* + * 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" + * (optional) and a script to execute if the expression is true. + */ + + if (i >= objc) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: no expression after \"%s\" argument", + clause)); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); + return TCL_ERROR; + } + if (!thenScriptIndex) { + TclNewObj(boolObj); + Tcl_NRAddCallback(interp, IfConditionCallback, data[0], data[1], + INT2PTR(i), boolObj); + return Tcl_NRExprObj(interp, objv[i], boolObj); } - break; } /* @@ -289,14 +343,14 @@ Tcl_IfObjCmd( if (strcmp(clause, "else") == 0) { i++; if (i >= objc) { - Tcl_AppendResult(interp, "wrong # args: ", - "no script following \"else\" argument", NULL); - return TCL_ERROR; + goto missingScript; } } if (i < objc - 1) { - Tcl_AppendResult(interp, "wrong # args: ", - "extra words after \"else\" clause in \"if\" command", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "wrong # args: extra words after \"else\" clause in \"if\" command", + -1)); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); return TCL_ERROR; } if (thenScriptIndex) { @@ -304,10 +358,17 @@ Tcl_IfObjCmd( * TIP #280. Make invoking context available to branch/else. */ - return TclEvalObjEx(interp, objv[thenScriptIndex], 0, + return TclNREvalObjEx(interp, objv[thenScriptIndex], 0, iPtr->cmdFramePtr, thenScriptIndex); } - return TclEvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i); + return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i); + + missingScript: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "wrong # args: no script following \"%s\" argument", + TclGetString(objv[i-1]))); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); + return TCL_ERROR; } /* @@ -336,7 +397,7 @@ Tcl_IncrObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *newValuePtr, *incrPtr; @@ -377,7 +438,7 @@ Tcl_IncrObjCmd( * documentation for details on what it does. * * Results: - * FIXME + * Handle for the info command, or NULL on failure. * * Side effects: * none @@ -417,10 +478,10 @@ InfoArgsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register Interp *iPtr = (Interp *) interp; - char *name; + const char *name; Proc *procPtr; CompiledLocal *localPtr; Tcl_Obj *listObjPtr; @@ -433,7 +494,9 @@ InfoArgsCmd( name = TclGetString(objv[1]); procPtr = TclFindProc(iPtr, name); if (procPtr == NULL) { - Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" isn't a procedure", name)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL); return TCL_ERROR; } @@ -478,10 +541,10 @@ InfoBodyCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register Interp *iPtr = (Interp *) interp; - char *name; + const char *name; Proc *procPtr; Tcl_Obj *bodyPtr, *resultPtr; @@ -493,7 +556,9 @@ InfoBodyCmd( name = TclGetString(objv[1]); procPtr = TclFindProc(iPtr, name); if (procPtr == NULL) { - Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" isn't a procedure", name)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL); return TCL_ERROR; } @@ -513,7 +578,7 @@ InfoBodyCmd( * run before. [Bug #545644] */ - (void) TclGetString(bodyPtr); + TclGetString(bodyPtr); } resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length); @@ -547,7 +612,7 @@ InfoCmdCountCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -589,10 +654,10 @@ InfoCommandsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - char *cmdName, *pattern; - CONST char *simplePattern; + const char *cmdName, *pattern; + const char *simplePattern; register Tcl_HashEntry *entryPtr; Tcl_HashSearch search; Namespace *nsPtr; @@ -624,8 +689,8 @@ InfoCommandsCmd( Namespace *dummy1NsPtr, *dummy2NsPtr; pattern = TclGetString(objv[1]); - TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL, 0, - &nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern); + TclGetNamespaceForQualName(interp, pattern, NULL, 0, &nsPtr, + &dummy1NsPtr, &dummy2NsPtr, &simplePattern); if (nsPtr != NULL) { /* We successfully found the pattern's ns. */ specificNsInPattern = (strcmp(simplePattern, pattern) != 0); @@ -661,7 +726,7 @@ InfoCommandsCmd( entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern); if (entryPtr != NULL) { if (specificNsInPattern) { - cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr); + cmd = Tcl_GetHashValue(entryPtr); elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, cmd, elemObjPtr); } else { @@ -712,7 +777,7 @@ InfoCommandsCmd( if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { if (specificNsInPattern) { - cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr); + cmd = Tcl_GetHashValue(entryPtr); elemObjPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, cmd, elemObjPtr); } else { @@ -771,7 +836,7 @@ InfoCommandsCmd( elemObjPtr = Tcl_NewStringObj(cmdName, -1); Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); (void) Tcl_CreateHashEntry(&addedCommandsTable, - (char *)elemObjPtr, &isNew); + elemObjPtr, &isNew); } entryPtr = Tcl_NextHashEntry(&search); } @@ -796,7 +861,7 @@ InfoCommandsCmd( || Tcl_StringMatch(cmdName, simplePattern)) { elemObjPtr = Tcl_NewStringObj(cmdName, -1); (void) Tcl_CreateHashEntry(&addedCommandsTable, - (char *) elemObjPtr, &isNew); + elemObjPtr, &isNew); if (isNew) { Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr); } else { @@ -866,7 +931,7 @@ InfoCompleteCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "command"); @@ -903,10 +968,10 @@ InfoDefaultCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; - char *procName, *argName, *varName; + const char *procName, *argName; Proc *procPtr; CompiledLocal *localPtr; Tcl_Obj *valueObjPtr; @@ -921,7 +986,10 @@ InfoDefaultCmd( procPtr = TclFindProc(iPtr, procName); if (procPtr == NULL) { - Tcl_AppendResult(interp, "\"", procName, "\" isn't a procedure",NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" isn't a procedure", procName)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", procName, + NULL); return TCL_ERROR; } @@ -931,17 +999,18 @@ InfoDefaultCmd( && (strcmp(argName, localPtr->name) == 0)) { if (localPtr->defValuePtr != NULL) { valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL, - localPtr->defValuePtr, 0); + localPtr->defValuePtr, TCL_LEAVE_ERR_MSG); if (valueObjPtr == NULL) { - goto defStoreError; + return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); } else { Tcl_Obj *nullObjPtr = Tcl_NewObj(); + valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL, - nullObjPtr, 0); + nullObjPtr, TCL_LEAVE_ERR_MSG); if (valueObjPtr == NULL) { - goto defStoreError; + return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(0)); } @@ -949,15 +1018,60 @@ InfoDefaultCmd( } } - Tcl_AppendResult(interp, "procedure \"", procName, - "\" doesn't have an argument \"", argName, "\"", NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "procedure \"%s\" doesn't have an argument \"%s\"", + procName, argName)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARGUMENT", argName, NULL); return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * InfoErrorStackCmd -- + * + * Called to implement the "info errorstack" command that returns information + * about the last error's call stack. Handles the following syntax: + * + * info errorstack ?interp? + * + * Results: + * Returns TCL_OK if successful and TCL_ERROR if there is an error. + * + * Side effects: + * Returns a result in the interpreter's result object. If there is an + * error, the result is an error message. + * + *---------------------------------------------------------------------- + */ - defStoreError: - varName = TclGetString(objv[3]); - Tcl_AppendResult(interp, "couldn't store default value in variable \"", - varName, "\"", NULL); - return TCL_ERROR; +static int +InfoErrorStackCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ +{ + Tcl_Interp *target; + Interp *iPtr; + + if ((objc != 1) && (objc != 2)) { + Tcl_WrongNumArgs(interp, 1, objv, "?interp?"); + return TCL_ERROR; + } + + target = interp; + if (objc == 2) { + target = Tcl_GetSlave(interp, Tcl_GetString(objv[1])); + if (target == NULL) { + return TCL_ERROR; + } + } + + iPtr = (Interp *) target; + Tcl_SetObjResult(interp, iPtr->errorStack); + + return TCL_OK; } /* @@ -985,9 +1099,9 @@ TclInfoExistsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - char *varName; + const char *varName; Var *varPtr; if (objc != 2) { @@ -1030,25 +1144,50 @@ InfoFrameCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; - int level; - CmdFrame *framePtr; + int level, code = TCL_OK; + CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr; + CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; + int topLevel = 0; + + if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?number?"); + return TCL_ERROR; + } + + while (corPtr) { + while (*cmdFramePtrPtr) { + topLevel++; + cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr); + } + if (corPtr->caller.cmdFramePtr) { + *cmdFramePtrPtr = corPtr->caller.cmdFramePtr; + } + corPtr = corPtr->callerEEPtr->corPtr; + } + topLevel += (*cmdFramePtrPtr)->level; + + if (topLevel != iPtr->cmdFramePtr->level) { + framePtr = iPtr->cmdFramePtr; + while (framePtr) { + framePtr->level = topLevel--; + framePtr = framePtr->nextPtr; + } + if (topLevel) { + Tcl_Panic("Broken frame level calculation"); + } + topLevel = iPtr->cmdFramePtr->level; + } if (objc == 1) { /* * Just "info frame". */ - int levels = - (iPtr->cmdFramePtr == NULL ? 0 : iPtr->cmdFramePtr->level); - - Tcl_SetObjResult(interp, Tcl_NewIntObj (levels)); - return TCL_OK; - } else if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "?number?"); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewIntObj(topLevel)); + goto done; } /* @@ -1056,40 +1195,62 @@ InfoFrameCmd( */ if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) { - return TCL_ERROR; + code = TCL_ERROR; + goto done; } - if (level <= 0) { - /* - * Negative levels are adressing relative to the current frame's - * depth. - */ - if (iPtr->cmdFramePtr == NULL) { - levelError: - Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad level \"", - TclGetString(objv[1]), "\"", NULL); - return TCL_ERROR; - } + if ((level > topLevel) || (level <= - topLevel)) { + levelError: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad level \"%s\"", TclGetString(objv[1]))); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_FRAME", + TclGetString(objv[1]), NULL); + code = TCL_ERROR; + goto done; + } - /* - * Convert to absolute. - */ + /* + * Let us convert to relative so that we know how many levels to go back + */ - level += iPtr->cmdFramePtr->level; + if (level > 0) { + level -= topLevel; } - for (framePtr = iPtr->cmdFramePtr; framePtr != NULL; - framePtr = framePtr->nextPtr) { - if (framePtr->level == level) { - break; + framePtr = iPtr->cmdFramePtr; + while (++level <= 0) { + framePtr = framePtr->nextPtr; + if (!framePtr) { + goto levelError; } } - if (framePtr == NULL) { - goto levelError; - } Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr)); - return TCL_OK; + + done: + cmdFramePtrPtr = &iPtr->cmdFramePtr; + corPtr = iPtr->execEnvPtr->corPtr; + while (corPtr) { + CmdFrame *endPtr = corPtr->caller.cmdFramePtr; + + if (endPtr) { + if (*cmdFramePtrPtr == endPtr) { + *cmdFramePtrPtr = NULL; + } else { + CmdFrame *runPtr = *cmdFramePtrPtr; + + while (runPtr->nextPtr != endPtr) { + runPtr->level -= endPtr->level; + runPtr = runPtr->nextPtr; + } + runPtr->level = 1; + runPtr->nextPtr = NULL; + } + cmdFramePtrPtr = &corPtr->caller.cmdFramePtr; + } + corPtr = corPtr->callerEEPtr->corPtr; + } + return code; } /* @@ -1114,6 +1275,7 @@ TclInfoFrame( CmdFrame *framePtr) /* Frame to get info for. */ { Interp *iPtr = (Interp *) interp; + Tcl_Obj *tmpObj; Tcl_Obj *lv[20]; /* Keep uptodate when more keys are added to * the dict. */ int lc = 0; @@ -1121,14 +1283,12 @@ TclInfoFrame( * This array is indexed by the TCL_LOCATION_... values, except * for _LAST. */ - static CONST char *typeString[TCL_LOCATION_LAST] = { + static const char *const typeString[TCL_LOCATION_LAST] = { "eval", "eval", "eval", "precompiled", "source", "proc" }; - Tcl_Obj *tmpObj; - Proc *procPtr = - framePtr->framePtr ? framePtr->framePtr->procPtr : NULL; + Proc *procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL; - /* + /* * Pull the information and construct the dictionary to return, as list. * Regarding use of the CmdFrame fields see tclInt.h, and its definition. */ @@ -1146,28 +1306,12 @@ TclInfoFrame( */ ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); - ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0])); - ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd, - framePtr->cmd.str.len)); - break; - - case TCL_LOCATION_EVAL_LIST: - /* - * List optimized evaluation. Type, line, cmd, the latter through - * listPtr, possibly a frame. - */ - - ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1)); - ADD_PAIR("line", Tcl_NewIntObj(1)); - - /* - * We put a duplicate of the command list obj into the result to - * ensure that the 'pure List'-property of the command itself is not - * destroyed. Otherwise the query here would disable the list - * optimization path in Tcl_EvalObjEx. - */ - - ADD_PAIR("cmd", Tcl_DuplicateObj(framePtr->cmd.listPtr)); + if (framePtr->line) { + ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0])); + } else { + ADD_PAIR("line", Tcl_NewIntObj(1)); + } + ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL)); break; case TCL_LOCATION_PREBC: @@ -1183,9 +1327,8 @@ TclInfoFrame( * Execution of bytecode. Talk to the BC engine to fill out the frame. */ - CmdFrame *fPtr; + CmdFrame *fPtr = TclStackAlloc(interp, sizeof(CmdFrame)); - fPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame)); *fPtr = *framePtr; /* @@ -1216,8 +1359,7 @@ TclInfoFrame( Tcl_DecrRefCount(fPtr->data.eval.path); } - ADD_PAIR("cmd", - Tcl_NewStringObj(fPtr->cmd.str.cmd, fPtr->cmd.str.len)); + ADD_PAIR("cmd", TclGetSourceFromFrame(fPtr, 0, NULL)); TclStackFree(interp, fPtr); break; } @@ -1236,8 +1378,7 @@ TclInfoFrame( * the result list object. */ - ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd, - framePtr->cmd.str.len)); + ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL)); break; case TCL_LOCATION_PROC: @@ -1254,19 +1395,16 @@ TclInfoFrame( Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr; if (namePtr) { + Tcl_Obj *procNameObj; + /* * This is a regular command. */ - char *procName = Tcl_GetHashKey(namePtr->tablePtr, namePtr); - char *nsName = procPtr->cmdPtr->nsPtr->fullName; - - ADD_PAIR("proc", Tcl_NewStringObj(nsName, -1)); - - if (strcmp(nsName, "::") != 0) { - Tcl_AppendToObj(lv[lc-1], "::", -1); - } - Tcl_AppendToObj(lv[lc-1], procName, -1); + TclNewObj(procNameObj); + Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr, + procNameObj); + ADD_PAIR("proc", procNameObj); } else if (procPtr->cmdPtr->clientData) { ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData; int i; @@ -1338,21 +1476,44 @@ InfoFunctionsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - char *pattern; + Tcl_Obj *script; + int code; - if (objc == 1) { - pattern = NULL; - } else if (objc == 2) { - pattern = TclGetString(objv[1]); - } else { + if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?pattern?"); return TCL_ERROR; } - Tcl_SetObjResult(interp, Tcl_ListMathFuncs(interp, pattern)); - return TCL_OK; + script = Tcl_NewStringObj( +" ::apply [::list {{pattern *}} {\n" +" ::set cmds {}\n" +" ::foreach cmd [::info commands ::tcl::mathfunc::$pattern] {\n" +" ::lappend cmds [::namespace tail $cmd]\n" +" }\n" +" ::foreach cmd [::info commands tcl::mathfunc::$pattern] {\n" +" ::set cmd [::namespace tail $cmd]\n" +" ::if {$cmd ni $cmds} {\n" +" ::lappend cmds $cmd\n" +" }\n" +" }\n" +" ::return $cmds\n" +" } [::namespace current]] ", -1); + + if (objc == 2) { + Tcl_Obj *arg = Tcl_NewListObj(1, &(objv[1])); + + Tcl_AppendObjToObj(script, arg); + Tcl_DecrRefCount(arg); + } + + Tcl_IncrRefCount(script); + code = Tcl_EvalObjEx(interp, script, 0); + + Tcl_DecrRefCount(script); + + return code; } /* @@ -1380,9 +1541,9 @@ InfoHostnameCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - CONST char *name; + const char *name; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); @@ -1394,7 +1555,10 @@ InfoHostnameCmd( Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1)); return TCL_OK; } - Tcl_SetResult(interp, "unable to determine name of host", TCL_STATIC); + + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unable to determine name of host", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", NULL); return TCL_ERROR; } @@ -1423,7 +1587,7 @@ InfoLevelCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -1464,8 +1628,10 @@ InfoLevelCmd( return TCL_ERROR; levelError: - Tcl_AppendResult(interp, "bad level \"", TclGetString(objv[1]), "\"", - NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad level \"%s\"", TclGetString(objv[1]))); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL", + TclGetString(objv[1]), NULL); return TCL_ERROR; } @@ -1495,9 +1661,9 @@ InfoLibraryCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - CONST char *libDirName; + const char *libDirName; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); @@ -1509,7 +1675,10 @@ InfoLibraryCmd( Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1)); return TCL_OK; } - Tcl_SetResult(interp, "no library has been specified for Tcl",TCL_STATIC); + + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "no library has been specified for Tcl", -1)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", "tcl_library",NULL); return TCL_ERROR; } @@ -1539,10 +1708,9 @@ InfoLoadedCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - char *interpName; - int result; + const char *interpName; if ((objc != 1) && (objc != 2)) { Tcl_WrongNumArgs(interp, 1, objv, "?interp?"); @@ -1554,8 +1722,7 @@ InfoLoadedCmd( } else { /* Get pkgs just in specified interp. */ interpName = TclGetString(objv[1]); } - result = TclGetLoadedPackages(interp, interpName); - return result; + return TclGetLoadedPackages(interp, interpName); } /* @@ -1584,7 +1751,7 @@ InfoNameOfExecutableCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); @@ -1620,9 +1787,9 @@ InfoPatchLevelCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - CONST char *patchlevel; + const char *patchlevel; if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); @@ -1667,10 +1834,10 @@ InfoProcsCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { - char *cmdName, *pattern; - CONST char *simplePattern; + const char *cmdName, *pattern; + const char *simplePattern; Namespace *nsPtr; #ifdef INFO_PROCS_SEARCH_GLOBAL_NS Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); @@ -1703,9 +1870,8 @@ InfoProcsCmd( Namespace *dummy1NsPtr, *dummy2NsPtr; pattern = TclGetString(objv[1]); - TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL, - /*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr, - &simplePattern); + TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0, &nsPtr, + &dummy1NsPtr, &dummy2NsPtr, &simplePattern); if (nsPtr != NULL) { /* We successfully found the pattern's ns. */ specificNsInPattern = (strcmp(simplePattern, pattern) != 0); @@ -1731,7 +1897,7 @@ InfoProcsCmd( if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) { entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern); if (entryPtr != NULL) { - cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); + cmdPtr = Tcl_GetHashValue(entryPtr); if (!TclIsProc(cmdPtr)) { realCmdPtr = (Command *) @@ -1759,7 +1925,7 @@ InfoProcsCmd( cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr); if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { - cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); + cmdPtr = Tcl_GetHashValue(entryPtr); if (!TclIsProc(cmdPtr)) { realCmdPtr = (Command *) @@ -1806,7 +1972,7 @@ InfoProcsCmd( if ((simplePattern == NULL) || Tcl_StringMatch(cmdName, simplePattern)) { if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) { - cmdPtr = (Command *) Tcl_GetHashValue(entryPtr); + cmdPtr = Tcl_GetHashValue(entryPtr); realCmdPtr = (Command *) TclGetOriginalCommand( (Tcl_Command) cmdPtr); @@ -1855,7 +2021,7 @@ InfoScriptCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; if ((objc != 1) && (objc != 2)) { @@ -1902,7 +2068,7 @@ InfoSharedlibCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc != 1) { Tcl_WrongNumArgs(interp, 1, objv, NULL); @@ -1940,7 +2106,7 @@ InfoTclVersionCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *version; @@ -1980,7 +2146,7 @@ Tcl_JoinObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* The argument objects. */ + Tcl_Obj *const objv[]) /* The argument objects. */ { int listLen, i; Tcl_Obj *resObjPtr, *joinObjPtr, **elemPtrs; @@ -2037,15 +2203,15 @@ Tcl_LassignObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listCopyPtr; Tcl_Obj **listObjv; /* The contents of the list. */ int listObjc; /* The length of the list. */ int code = TCL_OK; - if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, "list varName ?varName ...?"); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?"); return TCL_ERROR; } @@ -2059,20 +2225,22 @@ Tcl_LassignObjCmd( objc -= 2; objv += 2; while (code == TCL_OK && objc > 0 && listObjc > 0) { - if (NULL == Tcl_ObjSetVar2(interp, *objv++, NULL, - *listObjv++, TCL_LEAVE_ERR_MSG)) { + if (Tcl_ObjSetVar2(interp, *objv++, NULL, *listObjv++, + TCL_LEAVE_ERR_MSG) == NULL) { code = TCL_ERROR; } - objc--; listObjc--; + objc--; + listObjc--; } if (code == TCL_OK && objc > 0) { Tcl_Obj *emptyObj; + TclNewObj(emptyObj); Tcl_IncrRefCount(emptyObj); while (code == TCL_OK && objc-- > 0) { - if (NULL == Tcl_ObjSetVar2(interp, *objv++, NULL, - emptyObj, TCL_LEAVE_ERR_MSG)) { + if (Tcl_ObjSetVar2(interp, *objv++, NULL, emptyObj, + TCL_LEAVE_ERR_MSG) == NULL) { code = TCL_ERROR; } } @@ -2109,13 +2277,13 @@ Tcl_LindexObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *elemPtr; /* Pointer to the element being extracted. */ if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "list ?index...?"); + Tcl_WrongNumArgs(interp, 1, objv, "list ?index ...?"); return TCL_ERROR; } @@ -2138,11 +2306,11 @@ Tcl_LindexObjCmd( if (elemPtr == NULL) { return TCL_ERROR; - } else { - Tcl_SetObjResult(interp, elemPtr); - Tcl_DecrRefCount(elemPtr); - return TCL_OK; } + + Tcl_SetObjResult(interp, elemPtr); + Tcl_DecrRefCount(elemPtr); + return TCL_OK; } /* @@ -2168,13 +2336,13 @@ Tcl_LinsertObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ register int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { Tcl_Obj *listPtr; int index, len, result; - if (objc < 4) { - Tcl_WrongNumArgs(interp, 1, objv, "list index element ?element ...?"); + if (objc < 3) { + Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?"); return TCL_ERROR; } @@ -2247,7 +2415,7 @@ Tcl_ListObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ register int objc, /* Number of arguments. */ - register Tcl_Obj *CONST objv[]) + register Tcl_Obj *const objv[]) /* The argument objects. */ { /* @@ -2256,7 +2424,7 @@ Tcl_ListObjCmd( */ if (objc > 1) { - Tcl_SetObjResult(interp, Tcl_NewListObj((objc-1), &(objv[1]))); + Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, &objv[1])); } return TCL_OK; } @@ -2283,7 +2451,7 @@ Tcl_LlengthObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - register Tcl_Obj *CONST objv[]) + register Tcl_Obj *const objv[]) /* Argument objects. */ { int listLen, result; @@ -2329,55 +2497,77 @@ Tcl_LrangeObjCmd( ClientData notUsed, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - register Tcl_Obj *CONST objv[]) + register Tcl_Obj *const objv[]) /* Argument objects. */ { - Tcl_Obj *listPtr, **elemPtrs; - int listLen, first, result; + Tcl_Obj **elemPtrs; + int listLen, first, last, result; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last"); return TCL_ERROR; } - /* - * Make sure the list argument is a list object and get its length and a - * pointer to its array of element pointers. - */ - - listPtr = TclListObjCopy(interp, objv[1]); - if (listPtr == NULL) { - return TCL_ERROR; + result = TclListObjLength(interp, objv[1], &listLen); + if (result != TCL_OK) { + return result; } - TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs); result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1, &first); - if (result == TCL_OK) { - int last; + if (result != TCL_OK) { + return result; + } + if (first < 0) { + first = 0; + } - if (first < 0) { - first = 0; - } + result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1, + &last); + if (result != TCL_OK) { + return result; + } + if (last >= listLen) { + last = listLen - 1; + } - result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1, - &last); - if (result == TCL_OK) { - if (last >= listLen) { - last = (listLen - 1); - } + if (first > last) { + /* + * Returning an empty list is easy. + */ - if (first <= last) { - int numElems = (last - first + 1); + return TCL_OK; + } - Tcl_SetObjResult(interp, - Tcl_NewListObj(numElems, &(elemPtrs[first]))); - } + result = TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs); + if (result != TCL_OK) { + return result; + } + + if (Tcl_IsShared(objv[1]) || + ((ListRepPtr(objv[1])->refCount > 1))) { + Tcl_SetObjResult(interp, Tcl_NewListObj(last - first + 1, + &elemPtrs[first])); + } else { + /* + * In-place is possible. + */ + + if (last < (listLen - 1)) { + Tcl_ListObjReplace(interp, objv[1], last + 1, listLen - 1 - last, + 0, NULL); } + + /* + * This one is not conditioned on (first > 0) in order to preserve the + * string-canonizing effect of [lrange 0 end]. + */ + + Tcl_ListObjReplace(interp, objv[1], 0, first, 0, NULL); + Tcl_SetObjResult(interp, objv[1]); } - Tcl_DecrRefCount(listPtr); - return result; + return TCL_OK; } /* @@ -2402,28 +2592,29 @@ Tcl_LrepeatObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ register int objc, /* Number of arguments. */ - register Tcl_Obj *CONST objv[]) + register Tcl_Obj *const objv[]) /* The argument objects. */ { - int elementCount, i, result, totalElems; - Tcl_Obj *listPtr, **dataArray; - List *listRepPtr; + int elementCount, i, totalElems; + Tcl_Obj *listPtr, **dataArray = NULL; /* * Check arguments for legality: - * lrepeat posInt value ?value ...? + * lrepeat count ?value ...? */ - if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, "positiveCount value ?value ...?"); + if (objc < 2) { + Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?"); return TCL_ERROR; } - result = TclGetIntFromObj(interp, objv[1], &elementCount); - if (result == TCL_ERROR) { + if (TCL_OK != TclGetIntFromObj(interp, objv[1], &elementCount)) { return TCL_ERROR; } - if (elementCount < 1) { - Tcl_AppendResult(interp, "must have a count of at least 1", NULL); + if (elementCount < 0) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "bad count \"%d\": must be integer >= 0", elementCount)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG", + NULL); return TCL_ERROR; } @@ -2434,21 +2625,15 @@ Tcl_LrepeatObjCmd( objc -= 2; objv += 2; - /* - * Final sanity check. Total number of elements must fit in a signed - * integer. We also limit the number of elements to 512M-1 so allocations - * on 32-bit machines are guaranteed to be less than 2GB! [Bug 2130992] - */ + /* Final sanity check. Do not exceed limits on max list length. */ - totalElems = objc * elementCount; - if (totalElems/objc != elementCount || totalElems/elementCount != objc) { - Tcl_AppendResult(interp, "too many elements in result list", NULL); - return TCL_ERROR; - } - if (totalElems >= 0x20000000) { - Tcl_AppendResult(interp, "too many elements in result list", NULL); + if (elementCount && objc > LIST_MAX/elementCount) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "max length of a Tcl list (%d elements) exceeded", LIST_MAX)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); return TCL_ERROR; } + totalElems = objc * elementCount; /* * Get an empty list object that is allocated large enough to hold each @@ -2456,9 +2641,12 @@ Tcl_LrepeatObjCmd( */ listPtr = Tcl_NewListObj(totalElems, NULL); - listRepPtr = (List *) listPtr->internalRep.twoPtrValue.ptr1; - listRepPtr->elemCount = elementCount*objc; - dataArray = &listRepPtr->elements; + if (totalElems) { + List *listRepPtr = ListRepPtr(listPtr); + + listRepPtr->elemCount = elementCount*objc; + dataArray = &listRepPtr->elements; + } /* * Set the elements. Note that we handle the common degenerate case of a @@ -2467,6 +2655,7 @@ Tcl_LrepeatObjCmd( * number of times. */ + CLANG_ASSERT(dataArray); if (objc == 1) { register Tcl_Obj *tmpPtr = objv[0]; @@ -2512,14 +2701,14 @@ Tcl_LreplaceObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument objects. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { register Tcl_Obj *listPtr; int first, last, listLen, numToDelete, result; if (objc < 4) { Tcl_WrongNumArgs(interp, 1, objv, - "list first last ?element element ...?"); + "list first last ?element ...?"); return TCL_ERROR; } @@ -2545,7 +2734,7 @@ Tcl_LreplaceObjCmd( } if (first < 0) { - first = 0; + first = 0; } /* @@ -2556,15 +2745,17 @@ Tcl_LreplaceObjCmd( */ if ((first >= listLen) && (listLen > 0)) { - Tcl_AppendResult(interp, "list doesn't contain element ", - TclGetString(objv[2]), NULL); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "list doesn't contain element %s", TclGetString(objv[2]))); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX", + NULL); return TCL_ERROR; } if (last >= listLen) { - last = (listLen - 1); + last = listLen - 1; } if (first <= last) { - numToDelete = (last - first + 1); + numToDelete = last - first + 1; } else { numToDelete = 0; } @@ -2587,7 +2778,7 @@ Tcl_LreplaceObjCmd( * optimize this case away. */ - Tcl_ListObjReplace(NULL, listPtr, first, numToDelete, objc-4, &(objv[4])); + Tcl_ListObjReplace(NULL, listPtr, first, numToDelete, objc-4, objv+4); /* * Set the interpreter's object result. @@ -2619,7 +2810,7 @@ Tcl_LreverseObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument values. */ + Tcl_Obj *const objv[]) /* Argument values. */ { Tcl_Obj **elemv; int elemc, i, j; @@ -2633,7 +2824,7 @@ Tcl_LreverseObjCmd( } /* - * If the list is empty, just return it [Bug 1876793] + * If the list is empty, just return it. [Bug 1876793] */ if (!elemc) { @@ -2641,15 +2832,15 @@ Tcl_LreverseObjCmd( return TCL_OK; } - if (Tcl_IsShared(objv[1])) { + if (Tcl_IsShared(objv[1]) + || (ListRepPtr(objv[1])->refCount > 1)) { /* Bug 1675044 */ Tcl_Obj *resultObj, **dataArray; - List *listPtr; + List *listRepPtr; - makeNewReversedList: resultObj = Tcl_NewListObj(elemc, NULL); - listPtr = (List *) resultObj->internalRep.twoPtrValue.ptr1; - listPtr->elemCount = elemc; - dataArray = &listPtr->elements; + listRepPtr = ListRepPtr(resultObj); + listRepPtr->elemCount = elemc; + dataArray = &listRepPtr->elements; for (i=0,j=elemc-1 ; i<elemc ; i++,j--) { dataArray[j] = elemv[i]; @@ -2658,15 +2849,6 @@ Tcl_LreverseObjCmd( Tcl_SetObjResult(interp, resultObj); } else { - /* - * It is theoretically possible for a list object to have a shared - * internal representation, but be an unshared object. Check for this - * and use the "shared" code if we have that problem. [Bug 1675044] - */ - - if (((List *) objv[1]->internalRep.twoPtrValue.ptr1)->refCount > 1) { - goto makeNewReversedList; - } /* * Not shared, so swap "in place". This relies on Tcl_LOGE above @@ -2707,10 +2889,10 @@ Tcl_LsearchObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument values. */ + Tcl_Obj *const objv[]) /* Argument values. */ { - char *bytes, *patternBytes; - int i, match, mode, index, result, listc, length, elemLen; + const char *bytes, *patternBytes; + int i, match, index, result, listc, length, elemLen, bisect; int dataType, isIncreasing, lower, upper, patInt, objInt, offset; int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase; double patDouble, objDouble; @@ -2718,19 +2900,19 @@ Tcl_LsearchObjCmd( Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr; SortStrCmpFn_t strCmpFn = strcmp; Tcl_RegExp regexp = NULL; - static CONST char *options[] = { - "-all", "-ascii", "-decreasing", "-dictionary", + static const char *const options[] = { + "-all", "-ascii", "-bisect", "-decreasing", "-dictionary", "-exact", "-glob", "-increasing", "-index", "-inline", "-integer", "-nocase", "-not", "-real", "-regexp", "-sorted", "-start", "-subindices", NULL }; enum options { - LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_DECREASING, LSEARCH_DICTIONARY, - LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, LSEARCH_INDEX, - LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE, LSEARCH_NOT, - LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED, LSEARCH_START, - LSEARCH_SUBINDICES + LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_BISECT, LSEARCH_DECREASING, + LSEARCH_DICTIONARY, LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, + LSEARCH_INDEX, LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE, + LSEARCH_NOT, LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED, + LSEARCH_START, LSEARCH_SUBINDICES }; enum datatypes { ASCII, DICTIONARY, INTEGER, REAL @@ -2738,6 +2920,7 @@ Tcl_LsearchObjCmd( enum modes { EXACT, GLOB, REGEXP, SORTED }; + enum modes mode; mode = GLOB; dataType = ASCII; @@ -2746,6 +2929,7 @@ Tcl_LsearchObjCmd( inlineReturn = 0; returnSubindices = 0; negatedMatch = 0; + bisect = 0; listPtr = NULL; startPtr = NULL; offset = 0; @@ -2759,7 +2943,7 @@ Tcl_LsearchObjCmd( sortInfo.indexc = 0; if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, "?options? list pattern"); + Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list pattern"); return TCL_ERROR; } @@ -2769,10 +2953,8 @@ Tcl_LsearchObjCmd( if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); } - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - return TCL_ERROR; + result = TCL_ERROR; + goto done; } switch ((enum options) index) { case LSEARCH_ALL: /* -all */ @@ -2781,6 +2963,10 @@ Tcl_LsearchObjCmd( case LSEARCH_ASCII: /* -ascii */ dataType = ASCII; break; + case LSEARCH_BISECT: /* -bisect */ + mode = SORTED; + bisect = 1; + break; case LSEARCH_DECREASING: /* -decreasing */ isIncreasing = 0; sortInfo.isIncreasing = 0; @@ -2805,7 +2991,7 @@ Tcl_LsearchObjCmd( dataType = INTEGER; break; case LSEARCH_NOCASE: /* -nocase */ - strCmpFn = strcasecmp; + strCmpFn = TclUtfCasecmp; noCase = 1; break; case LSEARCH_NOT: /* -not */ @@ -2833,11 +3019,11 @@ Tcl_LsearchObjCmd( Tcl_DecrRefCount(startPtr); } if (i > objc-4) { - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - Tcl_AppendResult(interp, "missing starting index", NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "missing starting index", -1)); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); + result = TCL_ERROR; + goto done; } i++; if (objv[i] == objv[objc - 2]) { @@ -2859,15 +3045,16 @@ Tcl_LsearchObjCmd( int j; if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); + TclStackFree(interp, sortInfo.indexv); } if (i > objc-4) { if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); } - Tcl_AppendResult(interp, + Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-index\" option must be followed by list index", - NULL); + -1)); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); return TCL_ERROR; } @@ -2893,8 +3080,8 @@ Tcl_LsearchObjCmd( sortInfo.indexv = &sortInfo.singleIndex; break; default: - sortInfo.indexv = (int *) - ckalloc(sizeof(int) * sortInfo.indexc); + sortInfo.indexv = + TclStackAlloc(interp, sizeof(int) * sortInfo.indexc); } /* @@ -2906,12 +3093,10 @@ Tcl_LsearchObjCmd( for (j=0 ; j<sortInfo.indexc ; j++) { if (TclGetIntForIndexM(interp, indices[j], SORTIDX_END, &sortInfo.indexv[j]) != TCL_OK) { - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (-index option item number %d)", j)); - return TCL_ERROR; + result = TCL_ERROR; + goto done; } } break; @@ -2927,12 +3112,22 @@ Tcl_LsearchObjCmd( if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); } - Tcl_AppendResult(interp, - "-subindices cannot be used without -index option", NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "-subindices cannot be used without -index option", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", + "BAD_OPTION_MIX", NULL); + return TCL_ERROR; + } + + if (bisect && (allMatches || negatedMatch)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "-bisect is not compatible with -all or -not", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", + "BAD_OPTION_MIX", NULL); return TCL_ERROR; } - if ((enum modes) mode == REGEXP) { + if (mode == REGEXP) { /* * We can shimmer regexp/list if listv[i] == pattern, so get the * regexp rep before the list rep. First time round, omit the interp @@ -2958,10 +3153,8 @@ Tcl_LsearchObjCmd( if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); } - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - return TCL_ERROR; + result = TCL_ERROR; + goto done; } } @@ -2975,10 +3168,7 @@ Tcl_LsearchObjCmd( if (startPtr != NULL) { Tcl_DecrRefCount(startPtr); } - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - return result; + goto done; } /* @@ -2989,10 +3179,7 @@ Tcl_LsearchObjCmd( result = TclGetIntForIndexM(interp, startPtr, listc-1, &offset); Tcl_DecrRefCount(startPtr); if (result != TCL_OK) { - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - return result; + goto done; } if (offset < 0) { offset = 0; @@ -3005,7 +3192,7 @@ Tcl_LsearchObjCmd( if (offset > listc-1) { if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); + TclStackFree(interp, sortInfo.indexv); } if (allMatches || inlineReturn) { Tcl_ResetResult(interp); @@ -3018,7 +3205,7 @@ Tcl_LsearchObjCmd( patObj = objv[objc - 1]; patternBytes = NULL; - if ((enum modes) mode == EXACT || (enum modes) mode == SORTED) { + if (mode == EXACT || mode == SORTED) { switch ((enum datatypes) dataType) { case ASCII: case DICTIONARY: @@ -3027,10 +3214,7 @@ Tcl_LsearchObjCmd( case INTEGER: result = TclGetIntFromObj(interp, patObj, &patInt); if (result != TCL_OK) { - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - return result; + goto done; } /* @@ -3043,10 +3227,7 @@ Tcl_LsearchObjCmd( case REAL: result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble); if (result != TCL_OK) { - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - return result; + goto done; } /* @@ -3069,7 +3250,7 @@ Tcl_LsearchObjCmd( index = -1; match = 0; - if ((enum modes) mode == SORTED && !allMatches && !negatedMatch) { + if (mode == SORTED && !allMatches && !negatedMatch) { /* * 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 @@ -3084,10 +3265,8 @@ Tcl_LsearchObjCmd( if (sortInfo.indexc != 0) { itemPtr = SelectObjFromSublist(listv[i], &sortInfo); if (sortInfo.resultCode != TCL_OK) { - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - return sortInfo.resultCode; + result = sortInfo.resultCode; + goto done; } } else { itemPtr = listv[i]; @@ -3104,10 +3283,7 @@ Tcl_LsearchObjCmd( case INTEGER: result = TclGetIntFromObj(interp, itemPtr, &objInt); if (result != TCL_OK) { - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - return result; + goto done; } if (patInt == objInt) { match = 0; @@ -3120,10 +3296,7 @@ Tcl_LsearchObjCmd( case REAL: result = Tcl_GetDoubleFromObj(interp, itemPtr, &objDouble); if (result != TCL_OK) { - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - return result; + goto done; } if (patDouble == objDouble) { match = 0; @@ -3147,10 +3320,16 @@ Tcl_LsearchObjCmd( * variation means that a search always makes log n * comparisons (normal binary search might "get lucky" with an * early comparison). + * + * In bisect mode though, we want the last of equals. */ index = i; - upper = i; + if (bisect) { + lower = i; + } else { + upper = i; + } } else if (match > 0) { if (isIncreasing) { lower = i; @@ -3165,7 +3344,9 @@ Tcl_LsearchObjCmd( } } } - + if (bisect && index < 0) { + index = lower; + } } else { /* * We need to do a linear search, because (at least one) of: @@ -3179,22 +3360,20 @@ Tcl_LsearchObjCmd( } for (i = offset; i < listc; i++) { match = 0; - if (sortInfo.indexc != 0) { + if (sortInfo.indexc != 0) { itemPtr = SelectObjFromSublist(listv[i], &sortInfo); if (sortInfo.resultCode != TCL_OK) { if (listPtr != NULL) { Tcl_DecrRefCount(listPtr); } - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - return sortInfo.resultCode; + result = sortInfo.resultCode; + goto done; } } else { itemPtr = listv[i]; } - - switch ((enum modes) mode) { + + switch (mode) { case SORTED: case EXACT: switch ((enum datatypes) dataType) { @@ -3207,7 +3386,7 @@ Tcl_LsearchObjCmd( */ if (noCase) { - match = (strcasecmp(bytes, patternBytes) == 0); + match = (TclUtfCasecmp(bytes, patternBytes) == 0); } else { match = (memcmp(bytes, patternBytes, (size_t) length) == 0); @@ -3226,10 +3405,7 @@ Tcl_LsearchObjCmd( if (listPtr != NULL) { Tcl_DecrRefCount(listPtr); } - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - return result; + goto done; } match = (objInt == patInt); break; @@ -3240,10 +3416,7 @@ Tcl_LsearchObjCmd( if (listPtr) { Tcl_DecrRefCount(listPtr); } - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - return result; + goto done; } match = (objDouble == patDouble); break; @@ -3262,10 +3435,8 @@ Tcl_LsearchObjCmd( if (listPtr != NULL) { Tcl_DecrRefCount(listPtr); } - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - return TCL_ERROR; + result = TCL_ERROR; + goto done; } break; } @@ -3338,15 +3509,17 @@ Tcl_LsearchObjCmd( } else { Tcl_SetObjResult(interp, listv[index]); } + result = TCL_OK; /* * Cleanup the index list array. */ + done: if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); + TclStackFree(interp, sortInfo.indexv); } - return TCL_OK; + return result; } /* @@ -3371,7 +3544,7 @@ Tcl_LsetObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument values. */ + Tcl_Obj *const objv[]) /* Argument values. */ { Tcl_Obj *listPtr; /* Pointer to the list being altered. */ Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */ @@ -3381,7 +3554,8 @@ Tcl_LsetObjCmd( */ if (objc < 3) { - Tcl_WrongNumArgs(interp, 1, objv, "listVar ?index? ?index...? value"); + Tcl_WrongNumArgs(interp, 1, objv, + "listVar ?index? ?index ...? value"); return TCL_ERROR; } @@ -3389,8 +3563,7 @@ Tcl_LsetObjCmd( * Look up the list variable's value. */ - listPtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL, - TCL_LEAVE_ERR_MSG); + listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); if (listPtr == NULL) { return TCL_ERROR; } @@ -3456,32 +3629,34 @@ Tcl_LsortObjCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ - Tcl_Obj *CONST objv[]) /* Argument values. */ + Tcl_Obj *const objv[]) /* Argument values. */ { - int i, j, index, indices, length, nocase = 0, sortMode, indexc; + int i, j, index, indices, length, nocase = 0, indexc; + int sortMode = SORTMODE_ASCII; + int group, groupSize, groupOffset, idx, allocatedIndexVector = 0; Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr; SortElement *elementArray, *elementPtr; SortInfo sortInfo; /* Information about this sort that needs to * be passed to the comparison function. */ - static CONST char *switches[] = { +# define NUM_LISTS 30 + SortElement *subList[NUM_LISTS+1]; + /* This array holds pointers to temporary + * lists built during the merge sort. Element + * i of the array holds a list of length + * 2**i. */ + static const char *const switches[] = { "-ascii", "-command", "-decreasing", "-dictionary", "-increasing", - "-index", "-indices", "-integer", "-nocase", "-real", "-unique", NULL + "-index", "-indices", "-integer", "-nocase", "-real", "-stride", + "-unique", NULL }; enum Lsort_Switches { LSORT_ASCII, LSORT_COMMAND, LSORT_DECREASING, LSORT_DICTIONARY, LSORT_INCREASING, LSORT_INDEX, LSORT_INDICES, LSORT_INTEGER, - LSORT_NOCASE, LSORT_REAL, LSORT_UNIQUE + LSORT_NOCASE, LSORT_REAL, LSORT_STRIDE, LSORT_UNIQUE }; - /* - * 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. - */ -# define NUM_LISTS 30 - SortElement *subList[NUM_LISTS+1]; - if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "?options? list"); + Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list"); return TCL_ERROR; } @@ -3495,30 +3670,31 @@ Tcl_LsortObjCmd( sortInfo.indexc = 0; sortInfo.unique = 0; sortInfo.interp = interp; - sortInfo.resultCode = TCL_OK; + sortInfo.resultCode = TCL_OK; cmdPtr = NULL; indices = 0; + group = 0; + groupSize = 1; + groupOffset = 0; + indexPtr = NULL; for (i = 1; i < objc-1; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index) != TCL_OK) { - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - return TCL_ERROR; + sortInfo.resultCode = TCL_ERROR; + goto done2; } switch ((enum Lsort_Switches) index) { case LSORT_ASCII: sortInfo.sortMode = SORTMODE_ASCII; break; case LSORT_COMMAND: - if (i == (objc-2)) { - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - Tcl_AppendResult(interp, + if (i == objc-2) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-command\" option must be followed " - "by comparison command", NULL); - return TCL_ERROR; + "by comparison command", -1)); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); + sortInfo.resultCode = TCL_ERROR; + goto done2; } sortInfo.sortMode = SORTMODE_COMMAND; cmdPtr = objv[i+1]; @@ -3534,54 +3710,41 @@ Tcl_LsortObjCmd( sortInfo.isIncreasing = 1; break; case LSORT_INDEX: { - Tcl_Obj **indices; + int indexc, dummy; + Tcl_Obj **indexv; - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - if (i == (objc-2)) { - Tcl_AppendResult(interp, "\"-index\" option must be " - "followed by list index", NULL); - return TCL_ERROR; - } - - /* - * Take copy to prevent shimmering problems. - */ - - if (TclListObjGetElements(interp, objv[i+1], &sortInfo.indexc, - &indices) != TCL_OK) { - return TCL_ERROR; + if (i == objc-2) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "\"-index\" option must be followed by list index", + -1)); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); + sortInfo.resultCode = TCL_ERROR; + goto done2; } - switch (sortInfo.indexc) { - case 0: - sortInfo.indexv = NULL; - break; - case 1: - sortInfo.indexv = &sortInfo.singleIndex; - break; - default: - sortInfo.indexv = (int *) - ckalloc(sizeof(int) * sortInfo.indexc); + if (TclListObjGetElements(interp, objv[i+1], &indexc, + &indexv) != TCL_OK) { + sortInfo.resultCode = TCL_ERROR; + goto done2; } /* - * 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. + * Check each of the indices for syntactic correctness. Note that + * we do not store the converted values here because we do not + * know if this is the only -index option yet and so we can't + * allocate any space; that happens after the scan through all the + * options is done. */ - for (j=0 ; j<sortInfo.indexc ; j++) { - if (TclGetIntForIndexM(interp, indices[j], SORTIDX_END, - &sortInfo.indexv[j]) != TCL_OK) { - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } + for (j=0 ; j<indexc ; j++) { + if (TclGetIntForIndexM(interp, indexv[j], SORTIDX_END, + &dummy) != TCL_OK) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (-index option item number %d)", j)); - return TCL_ERROR; + sortInfo.resultCode = TCL_ERROR; + goto done2; } } + indexPtr = objv[i+1]; i++; break; } @@ -3600,12 +3763,65 @@ Tcl_LsortObjCmd( case LSORT_INDICES: indices = 1; break; + case LSORT_STRIDE: + if (i == objc-2) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "\"-stride\" option must be " + "followed by stride length", -1)); + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); + sortInfo.resultCode = TCL_ERROR; + goto done2; + } + if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) { + sortInfo.resultCode = TCL_ERROR; + goto done2; + } + if (groupSize < 2) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "stride length must be at least 2", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", + "BADSTRIDE", NULL); + sortInfo.resultCode = TCL_ERROR; + goto done2; + } + group = 1; + i++; + break; } } if (nocase && (sortInfo.sortMode == SORTMODE_ASCII)) { sortInfo.sortMode = SORTMODE_ASCII_NC; } + /* + * Now extract the -index list for real, if present. No failures are + * expected here; the values are all of the right type or convertible to + * it. + */ + + if (indexPtr) { + Tcl_Obj **indexv; + + TclListObjGetElements(interp, indexPtr, &sortInfo.indexc, &indexv); + switch (sortInfo.indexc) { + case 0: + sortInfo.indexv = NULL; + break; + case 1: + sortInfo.indexv = &sortInfo.singleIndex; + break; + default: + sortInfo.indexv = + TclStackAlloc(interp, sizeof(int) * sortInfo.indexc); + allocatedIndexVector = 1; /* Cannot use indexc field, as it + * might be decreased by 1 later. */ + } + for (j=0 ; j<sortInfo.indexc ; j++) { + TclGetIntForIndexM(interp, indexv[j], SORTIDX_END, + &sortInfo.indexv[j]); + } + } + listObj = objv[objc-1]; if (sortInfo.sortMode == SORTMODE_COMMAND) { @@ -3620,10 +3836,8 @@ Tcl_LsortObjCmd( listObj = TclListObjCopy(interp, listObj); if (listObj == NULL) { - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - return TCL_ERROR; + sortInfo.resultCode = TCL_ERROR; + goto done2; } /* @@ -3640,10 +3854,8 @@ Tcl_LsortObjCmd( TclDecrRefCount(listObj); Tcl_IncrRefCount(newObjPtr); TclDecrRefCount(newObjPtr); - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); - } - return TCL_ERROR; + sortInfo.resultCode = TCL_ERROR; + goto done2; } Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj()); sortInfo.compareCmdPtr = newCommandPtr; @@ -3654,8 +3866,62 @@ Tcl_LsortObjCmd( if (sortInfo.resultCode != TCL_OK || length <= 0) { goto done; } + + /* + * Check for sanity when grouping elements of the overall list together + * because of the -stride option. [TIP #326] + */ + + if (group) { + if (length % groupSize) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "list size must be a multiple of the stride length", + -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADSTRIDE", + NULL); + sortInfo.resultCode = TCL_ERROR; + goto done; + } + length = length / groupSize; + if (sortInfo.indexc > 0) { + /* + * Use the first value in the list supplied to -index as the + * offset of the element within each group by which to sort. + */ + + groupOffset = sortInfo.indexv[0]; + if (groupOffset <= SORTIDX_END) { + groupOffset = (groupOffset - SORTIDX_END) + groupSize - 1; + } + if (groupOffset < 0 || groupOffset >= groupSize) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "when used with \"-stride\", the leading \"-index\"" + " value must be within the group", -1)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", + "BADINDEX", NULL); + sortInfo.resultCode = TCL_ERROR; + goto done; + } + if (sortInfo.indexc == 1) { + sortInfo.indexc = 0; + sortInfo.indexv = NULL; + } else { + sortInfo.indexc--; + + /* + * Do not shrink the actual memory block used; that doesn't + * work with TclStackAlloc-allocated memory. [Bug 2918962] + */ + + for (i = 0; i < sortInfo.indexc; i++) { + sortInfo.indexv[i] = sortInfo.indexv[i+1]; + } + } + } + } + sortInfo.numElements = length; - + indexc = sortInfo.indexc; sortMode = sortInfo.sortMode; if ((sortMode == SORTMODE_ASCII_NC) @@ -3663,7 +3929,7 @@ Tcl_LsortObjCmd( /* * For this function's purpose all string-based modes are equivalent */ - + sortMode = SORTMODE_ASCII; } @@ -3672,7 +3938,7 @@ Tcl_LsortObjCmd( * contain a sorted sublist of length 2**i. Use one extra subList at the * end, always at NULL, to indicate the end of the lists. */ - + for (j=0 ; j<=NUM_LISTS ; j++) { subList[j] = NULL; } @@ -3682,57 +3948,65 @@ Tcl_LsortObjCmd( * begins sorting it into the sublists as it appears. */ - elementArray = (SortElement *) ckalloc( length * sizeof(SortElement)); + elementArray = TclStackAlloc(interp, length * sizeof(SortElement)); for (i=0; i < length; i++){ + idx = groupSize * i + groupOffset; if (indexc) { /* * If this is an indexed sort, retrieve the corresponding element */ - indexPtr = SelectObjFromSublist(listObjPtrs[i], &sortInfo); + indexPtr = SelectObjFromSublist(listObjPtrs[idx], &sortInfo); if (sortInfo.resultCode != TCL_OK) { goto done1; } } else { - indexPtr = listObjPtrs[i]; + indexPtr = listObjPtrs[idx]; } /* * Determine the "value" of this object for sorting purposes */ - + if (sortMode == SORTMODE_ASCII) { - elementArray[i].index.strValuePtr = TclGetString(indexPtr); + elementArray[i].collationKey.strValuePtr = TclGetString(indexPtr); } else if (sortMode == SORTMODE_INTEGER) { long a; + if (TclGetLongFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done1; } - elementArray[i].index.intValue = a; - } else if (sortInfo.sortMode == SORTMODE_REAL) { + elementArray[i].collationKey.intValue = a; + } else if (sortMode == SORTMODE_REAL) { double a; - if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) { + + if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr, + &a) != TCL_OK) { sortInfo.resultCode = TCL_ERROR; goto done1; } - elementArray[i].index.doubleValue = a; + elementArray[i].collationKey.doubleValue = a; } else { - elementArray[i].index.objValuePtr = indexPtr; + elementArray[i].collationKey.objValuePtr = indexPtr; } /* * Determine the representation of this element in the result: either * the objPtr itself, or its index in the original list. */ - - elementArray[i].objPtr = (indices ? INT2PTR(i) : listObjPtrs[i]); + + if (indices || group) { + elementArray[i].payload.index = idx; + } else { + elementArray[i].payload.objPtr = listObjPtrs[idx]; + } /* * Merge this element in the pre-existing sublists (and merge together * sublists when we have two of the same size). */ - + elementArray[i].nextPtr = NULL; elementPtr = &elementArray[i]; for (j=0 ; subList[j] ; j++) { @@ -3748,34 +4022,47 @@ Tcl_LsortObjCmd( /* * Merge all sublists */ - + elementPtr = subList[0]; for (j=1 ; j<NUM_LISTS ; j++) { elementPtr = MergeLists(subList[j], elementPtr, &sortInfo); } - /* * Now store the sorted elements in the result list. */ - + if (sortInfo.resultCode == TCL_OK) { List *listRepPtr; Tcl_Obj **newArray, *objPtr; - int i; - - resultPtr = Tcl_NewListObj(sortInfo.numElements, NULL); - listRepPtr = (List *) resultPtr->internalRep.twoPtrValue.ptr1; + + resultPtr = Tcl_NewListObj(sortInfo.numElements * groupSize, NULL); + listRepPtr = ListRepPtr(resultPtr); newArray = &listRepPtr->elements; - if (indices) { - for (i = 0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr){ - objPtr = Tcl_NewIntObj(PTR2INT(elementPtr->objPtr)); + if (group) { + for (i=0; elementPtr!=NULL ; elementPtr=elementPtr->nextPtr) { + idx = elementPtr->payload.index; + for (j = 0; j < groupSize; j++) { + if (indices) { + objPtr = Tcl_NewIntObj(idx + j - groupOffset); + newArray[i++] = objPtr; + Tcl_IncrRefCount(objPtr); + } else { + objPtr = listObjPtrs[idx + j - groupOffset]; + newArray[i++] = objPtr; + Tcl_IncrRefCount(objPtr); + } + } + } + } else if (indices) { + for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) { + objPtr = Tcl_NewIntObj(elementPtr->payload.index); newArray[i++] = objPtr; Tcl_IncrRefCount(objPtr); } } else { - for (i = 0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr){ - objPtr = elementPtr->objPtr; + for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) { + objPtr = elementPtr->payload.objPtr; newArray[i++] = objPtr; Tcl_IncrRefCount(objPtr); } @@ -3785,16 +4072,17 @@ Tcl_LsortObjCmd( } done1: - ckfree((char *)elementArray); + TclStackFree(interp, elementArray); done: - if (sortInfo.sortMode == SORTMODE_COMMAND) { + if (sortMode == SORTMODE_COMMAND) { TclDecrRefCount(sortInfo.compareCmdPtr); TclDecrRefCount(listObj); sortInfo.compareCmdPtr = NULL; } - if (sortInfo.indexc > 1) { - ckfree((char *) sortInfo.indexv); + done2: + if (allocatedIndexVector) { + TclStackFree(interp, sortInfo.indexv); } return sortInfo.resultCode; } @@ -3811,21 +4099,23 @@ Tcl_LsortObjCmd( * The unified list of SortElement structures. * * Side effects: - * If infoPtr->unique is set then infoPtr->numElements may be updated. + * If infoPtr->unique is set then infoPtr->numElements may be updated. * Possibly others, if a user-defined comparison command does something - * weird. + * weird. * * Note: - * If infoPtr->unique is set, the merge assumes that there are no + * If infoPtr->unique is set, the merge assumes that there are no * "repeated" elements in each of the left and right lists. In that case, * if any element of the left list is equivalent to one in the right list * it is omitted from the merged list. - * This simplified mechanism works because of the special way - * our MergeSort creates the sublists to be merged and will fail to - * eliminate all repeats in the general case where they are already - * present in either the left or right list. A general code would need to - * skip adjacent initial repeats in the left and right lists before - * comparing their initial elements, at each step. + * + * This simplified mechanism works because of the special way our + * MergeSort creates the sublists to be merged and will fail to eliminate + * all repeats in the general case where they are already present in + * either the left or right list. A general code would need to skip + * adjacent initial repeats in the left and right lists before comparing + * their initial elements, at each step. + * *---------------------------------------------------------------------- */ @@ -3927,25 +4217,25 @@ SortCompare( int order = 0; if (infoPtr->sortMode == SORTMODE_ASCII) { - order = strcmp(elemPtr1->index.strValuePtr, - elemPtr2->index.strValuePtr); + order = strcmp(elemPtr1->collationKey.strValuePtr, + elemPtr2->collationKey.strValuePtr); } else if (infoPtr->sortMode == SORTMODE_ASCII_NC) { - order = strcasecmp(elemPtr1->index.strValuePtr, - elemPtr2->index.strValuePtr); + order = TclUtfCasecmp(elemPtr1->collationKey.strValuePtr, + elemPtr2->collationKey.strValuePtr); } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) { - order = DictionaryCompare(elemPtr1->index.strValuePtr, - elemPtr2->index.strValuePtr); + order = DictionaryCompare(elemPtr1->collationKey.strValuePtr, + elemPtr2->collationKey.strValuePtr); } else if (infoPtr->sortMode == SORTMODE_INTEGER) { long a, b; - a = elemPtr1->index.intValue; - b = elemPtr2->index.intValue; + a = elemPtr1->collationKey.intValue; + b = elemPtr2->collationKey.intValue; order = ((a >= b) - (a <= b)); } else if (infoPtr->sortMode == SORTMODE_REAL) { double a, b; - a = elemPtr1->index.doubleValue; - b = elemPtr2->index.doubleValue; + a = elemPtr1->collationKey.doubleValue; + b = elemPtr2->collationKey.doubleValue; order = ((a >= b) - (a <= b)); } else { Tcl_Obj **objv, *paramObjv[2]; @@ -3957,14 +4247,14 @@ SortCompare( * Once an error has occurred, skip any future comparisons so as * to preserve the error message in sortInterp->result. */ - + return 0; } - objPtr1 = elemPtr1->index.objValuePtr; - objPtr2 = elemPtr2->index.objValuePtr; - + objPtr1 = elemPtr1->collationKey.objValuePtr; + objPtr2 = elemPtr2->collationKey.objValuePtr; + paramObjv[0] = objPtr1; paramObjv[1] = objPtr2; @@ -3982,8 +4272,7 @@ SortCompare( infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0); if (infoPtr->resultCode != TCL_OK) { - Tcl_AddErrorInfo(infoPtr->interp, - "\n (-compare command)"); + Tcl_AddErrorInfo(infoPtr->interp, "\n (-compare command)"); return 0; } @@ -3993,9 +4282,10 @@ SortCompare( if (TclGetIntFromObj(infoPtr->interp, Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) { - Tcl_ResetResult(infoPtr->interp); - Tcl_AppendResult(infoPtr->interp, - "-compare command returned non-integer result", NULL); + Tcl_SetObjResult(infoPtr->interp, Tcl_NewStringObj( + "-compare command returned non-integer result", -1)); + Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT", + "COMPARISONFAILED", NULL); infoPtr->resultCode = TCL_ERROR; return 0; } @@ -4032,7 +4322,7 @@ SortCompare( static int DictionaryCompare( - char *left, char *right) /* The strings to compare. */ + const char *left, const char *right) /* The strings to compare. */ { Tcl_UniChar uniLeft, uniRight, uniLeftLower, uniRightLower; int diff, zeros; @@ -4049,11 +4339,11 @@ DictionaryCompare( */ zeros = 0; - while ((*right == '0') && (isdigit(UCHAR(right[1])))) { + while ((*right == '0') && isdigit(UCHAR(right[1]))) { right++; zeros--; } - while ((*left == '0') && (isdigit(UCHAR(left[1])))) { + while ((*left == '0') && isdigit(UCHAR(left[1]))) { left++; zeros++; } @@ -4206,12 +4496,11 @@ SelectObjFromSublist( return NULL; } if (currentObj == NULL) { - char buffer[TCL_INTEGER_SPACE]; - - TclFormatInt(buffer, index); - Tcl_AppendResult(infoPtr->interp, "element ", buffer, - " missing from sublist \"", TclGetString(objPtr), "\"", - NULL); + Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf( + "element %d missing from sublist \"%s\"", + index, TclGetString(objPtr))); + Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT", + "INDEXFAILED", NULL); infoPtr->resultCode = TCL_ERROR; return NULL; } @@ -4225,5 +4514,6 @@ SelectObjFromSublist( * mode: c * c-basic-offset: 4 * fill-column: 78 + * tab-width: 8 * End: */ |