From edc81d994ec2f31a92dec97ec8dd28d5de990c93 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 25 Jun 2013 15:01:03 +0000 Subject: Make more use of the CompileTokens() macro. --- generic/tclCompExpr.c | 3 +-- generic/tclCompile.c | 8 +++----- 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index efdc2b0..2a48117 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2486,8 +2486,7 @@ CompileExprTree( break; } case OT_TOKENS: - TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, - envPtr); + CompileTokens(envPtr, tokenPtr, interp); tokenPtr += tokenPtr->numComponents + 1; break; default: diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 8cb53f5..ccf8938 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1936,8 +1936,7 @@ TclCompileScript( * The word is not a simple string of characters. */ - TclCompileTokens(interp, tokenPtr+1, - tokenPtr->numComponents, envPtr); + CompileTokens(envPtr, tokenPtr, interp); if (expand && tokenPtr->type == TCL_TOKEN_EXPAND_WORD) { TclEmitInstInt4(INST_EXPAND_STKTOP, envPtr->currStackDepth, envPtr); @@ -2578,7 +2577,7 @@ TclCompileExprWords( wordPtr = tokenPtr; for (i = 0; i < numWords; i++) { - TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents, envPtr); + CompileTokens(envPtr, wordPtr, interp); if (i < (numWords - 1)) { PushStringLiteral(envPtr, " "); } @@ -2630,8 +2629,7 @@ TclCompileNoOp( tokenPtr = tokenPtr + tokenPtr->numComponents + 1; if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents, - envPtr); + CompileTokens(envPtr, tokenPtr, interp); TclEmitOpcode(INST_POP, envPtr); } } -- cgit v0.12 From 6ed69603db59ee390437a9eb54685869393a243c Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 25 Jun 2013 19:23:24 +0000 Subject: Replace always true test with assertion. --- generic/tclCompile.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index ccf8938..633966e 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -2098,6 +2098,7 @@ TclCompileScript( * Emit an invoke instruction for the command. We skip this if a * compile procedure was found for the command. */ + assert(wordIdx > 0); if (expand) { /* @@ -2119,7 +2120,7 @@ TclCompileScript( TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr); envPtr->expandCount--; TclAdjustStackDepth(1 - wordIdx, envPtr); - } else if (wordIdx > 0) { + } else { /* * Save PC -> command map for the TclArgumentBC* functions. */ -- cgit v0.12 From b7baefb37be1711dc8aefbbed9e9670b0926e1be Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 26 Jun 2013 07:42:53 +0000 Subject: Proposed solution for [9b2e636361] --- generic/tclConfig.c | 44 +++++++++++++++++++------------------------- generic/tclMain.c | 5 +++-- 2 files changed, 22 insertions(+), 27 deletions(-) diff --git a/generic/tclConfig.c b/generic/tclConfig.c index 28549ed..ffed6f2 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -26,14 +26,15 @@ #define ASSOC_KEY "tclPackageAboutDict" /* - * A ClientData struct for the QueryConfig command. Store the two bits + * A ClientData struct for the QueryConfig command. Store the three bits * of data we need; the package name for which we store a config dict, - * and the (Tcl_Interp *) in which it is stored. + * the (Tcl_Interp *) in which it is stored, and the encoding. */ typedef struct QCCD { Tcl_Obj *pkg; Tcl_Interp *interp; + CONST char *encoding; } QCCD; /* @@ -78,10 +79,10 @@ Tcl_RegisterConfig( Tcl_Obj *pDB, *pkgDict; Tcl_DString cmdName; Tcl_Config *cfg; - Tcl_Encoding venc = Tcl_GetEncoding(NULL, valEncoding); QCCD *cdPtr = (QCCD *)ckalloc(sizeof(QCCD)); cdPtr->interp = interp; + cdPtr->encoding = valEncoding; cdPtr->pkg = Tcl_NewStringObj(pkgName, -1); /* @@ -104,7 +105,6 @@ Tcl_RegisterConfig( * dictionaries visible at Tcl level. I.e. they are not filled */ - if (venc != NULL) { /* * Retrieve package specific configuration... */ @@ -123,32 +123,15 @@ Tcl_RegisterConfig( */ for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) { - Tcl_DString conv; - CONST char *convValue = - Tcl_ExternalToUtfDString(venc, cfg->value, -1, &conv); - - /* - * We know that the keys are in ASCII/UTF-8, so for them is no - * conversion required. - */ - Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1), - Tcl_NewStringObj(convValue, -1)); - Tcl_DStringFree(&conv); + Tcl_NewStringObj(cfg->value, -1)); } /* - * We're now done with the encoding, so drop it. - */ - - Tcl_FreeEncoding(venc); - - /* * Write the changes back into the overall database. */ Tcl_DictObjPut(interp, pDB, cdPtr->pkg, pkgDict); - } /* * Now create the interface command for retrieval of the package @@ -219,6 +202,9 @@ QueryConfigObjCmd( enum subcmds { CFG_GET, CFG_LIST }; + Tcl_DString conv; + Tcl_Encoding venc = NULL; + CONST char *value; if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument?"); @@ -237,7 +223,7 @@ QueryConfigObjCmd( * present. */ - Tcl_SetResult(interp, "package not known", TCL_STATIC); + Tcl_SetResult(interp, "package not known", TCL_STATIC); return TCL_ERROR; } @@ -254,7 +240,15 @@ QueryConfigObjCmd( return TCL_ERROR; } - Tcl_SetObjResult(interp, val); + if (cdPtr->encoding) { + venc = Tcl_GetEncoding(interp, cdPtr->encoding); + if (!venc) { + return TCL_ERROR; + } + } + value = Tcl_ExternalToUtfDString(venc, Tcl_GetString(val), -1, &conv); + Tcl_SetObjResult(interp, Tcl_NewStringObj(value, -1)); + Tcl_DStringFree(&conv); return TCL_OK; case CFG_LIST: @@ -361,7 +355,7 @@ GetConfigDict( * * This function is associated with the "Package About dict" assoc data * for an interpreter; it is invoked when the interpreter is deleted in - * order to free the information assoicated with any pending error + * order to free the information associated with any pending error * reports. * * Results: diff --git a/generic/tclMain.c b/generic/tclMain.c index 7a19a38..5e5109b 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -342,9 +342,10 @@ Tcl_Main( Tcl_Interp *interp; Tcl_DString appName; - Tcl_FindExecutable(argv[0]); - interp = Tcl_CreateInterp(); + TclpSetInitialEncodings(); + TclpFindExecutable(argv[0]); + Tcl_InitMemory(interp); /* -- cgit v0.12 From e0e8990257bc75fdafa895f309145353c400923e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 26 Jun 2013 08:10:36 +0000 Subject: Allocate encoding name, so caller of Tcl_RegisterConfig() doesn't need to keep it forever. Fix some comments. --- generic/tclConfig.c | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/generic/tclConfig.c b/generic/tclConfig.c index ffed6f2..702ab82 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -34,7 +34,7 @@ typedef struct QCCD { Tcl_Obj *pkg; Tcl_Interp *interp; - CONST char *encoding; + char *encoding; } QCCD; /* @@ -82,15 +82,20 @@ Tcl_RegisterConfig( QCCD *cdPtr = (QCCD *)ckalloc(sizeof(QCCD)); cdPtr->interp = interp; - cdPtr->encoding = valEncoding; + if (valEncoding) { + cdPtr->encoding = ckalloc(strlen(valEncoding)+1); + strcpy(cdPtr->encoding, valEncoding); + } else { + cdPtr->encoding = NULL; + } cdPtr->pkg = Tcl_NewStringObj(pkgName, -1); /* * Phase I: Adding the provided information to the internal database of - * package meta data. Only if we have an ok encoding. + * package meta data. * * Phase II: Create a command for querying this database, specific to the - * package registerting its configuration. This is the approved interface + * package registering its configuration. This is the approved interface * in TIP 59. In the future a more general interface should be done, as * followup to TIP 59. Simply because our database is now general across * packages, and not a structure tied to one package. @@ -313,6 +318,9 @@ QueryConfigDelete( Tcl_Obj *pDB = GetConfigDict(cdPtr->interp); Tcl_DictObjRemove(NULL, pDB, pkgName); Tcl_DecrRefCount(pkgName); + if (cdPtr->encoding) { + ckfree((char *)cdPtr->encoding); + } ckfree((char *)cdPtr); } -- cgit v0.12 From 75b009d2316ab41a1ff6bd841da8fd207aba7b9d Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 26 Jun 2013 14:20:26 +0000 Subject: formatting, typo --- generic/tclConfig.c | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/generic/tclConfig.c b/generic/tclConfig.c index 28549ed..c6baa2f 100644 --- a/generic/tclConfig.c +++ b/generic/tclConfig.c @@ -75,7 +75,6 @@ Tcl_RegisterConfig( CONST char *valEncoding) /* Name of the encoding used to store the * configuration values, ASCII, thus UTF-8. */ { - Tcl_Obj *pDB, *pkgDict; Tcl_DString cmdName; Tcl_Config *cfg; Tcl_Encoding venc = Tcl_GetEncoding(NULL, valEncoding); @@ -89,9 +88,9 @@ Tcl_RegisterConfig( * package meta data. Only if we have an ok encoding. * * Phase II: Create a command for querying this database, specific to the - * package registerting its configuration. This is the approved interface + * package registering its configuration. This is the approved interface * in TIP 59. In the future a more general interface should be done, as - * followup to TIP 59. Simply because our database is now general across + * follow-up to TIP 59. Simply because our database is now general across * packages, and not a structure tied to one package. * * Note, the created command will have a reference through its clientdata. @@ -105,14 +104,14 @@ Tcl_RegisterConfig( */ if (venc != NULL) { + Tcl_Obj *pkgDict, *pDB = GetConfigDict(interp); + /* * Retrieve package specific configuration... */ - pDB = GetConfigDict(interp); - if (Tcl_DictObjGet(interp, pDB, cdPtr->pkg, &pkgDict) != TCL_OK - || (pkgDict == NULL)) { + || (pkgDict == NULL)) { pkgDict = Tcl_NewDictObj(); } else if (Tcl_IsShared(pkgDict)) { pkgDict = Tcl_DuplicateObj(pkgDict); @@ -125,7 +124,7 @@ Tcl_RegisterConfig( for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) { Tcl_DString conv; CONST char *convValue = - Tcl_ExternalToUtfDString(venc, cfg->value, -1, &conv); + Tcl_ExternalToUtfDString(venc, cfg->value, -1, &conv); /* * We know that the keys are in ASCII/UTF-8, so for them is no @@ -133,7 +132,7 @@ Tcl_RegisterConfig( */ Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1), - Tcl_NewStringObj(convValue, -1)); + Tcl_NewStringObj(convValue, -1)); Tcl_DStringFree(&conv); } @@ -178,7 +177,7 @@ Tcl_RegisterConfig( if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName), QueryConfigObjCmd, (ClientData) cdPtr, QueryConfigDelete) == NULL) { - Tcl_Panic("%s: %s", "Tcl_RegisterConfig", + Tcl_Panic("%s: %s", "Tcl_RegisterConfig", "Unable to create query command for package configuration"); } @@ -213,7 +212,7 @@ QueryConfigObjCmd( Tcl_Obj *pkgName = cdPtr->pkg; Tcl_Obj *pDB, *pkgDict, *val, *listPtr; int n, index; - static const char *subcmdStrings[] = { + static CONST char *subcmdStrings[] = { "get", "list", NULL }; enum subcmds { @@ -232,12 +231,12 @@ QueryConfigObjCmd( pDB = GetConfigDict(interp); if (Tcl_DictObjGet(interp, pDB, pkgName, &pkgDict) != TCL_OK || pkgDict == NULL) { - /* + /* * Maybe a Tcl_Panic is better, because the package data has to be * present. */ - Tcl_SetResult(interp, "package not known", TCL_STATIC); + Tcl_SetResult(interp, "package not known", TCL_STATIC); return TCL_ERROR; } @@ -248,7 +247,7 @@ QueryConfigObjCmd( return TCL_ERROR; } - if (Tcl_DictObjGet(interp, pkgDict, objv [2], &val) != TCL_OK + if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK || val == NULL) { Tcl_SetResult(interp, "key not known", TCL_STATIC); return TCL_ERROR; @@ -317,6 +316,7 @@ QueryConfigDelete( QCCD *cdPtr = (QCCD *) clientData; Tcl_Obj *pkgName = cdPtr->pkg; Tcl_Obj *pDB = GetConfigDict(cdPtr->interp); + Tcl_DictObjRemove(NULL, pDB, pkgName); Tcl_DecrRefCount(pkgName); ckfree((char *)cdPtr); -- cgit v0.12 From d586d955ce5e6ebbd9b670d848ef7c4f4935f9f3 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 26 Jun 2013 17:26:16 +0000 Subject: Correct typo detected by valgrind. --- generic/tclExecute.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 98f1ed8..d3a0d32 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2766,7 +2766,7 @@ TEBCresume( */ auxObjList->length += objc - 1; - if ((objc > 1) && (auxObjList-length > 0)) { + if ((objc > 1) && (auxObjList->length > 0)) { length = auxObjList->length /* Total expansion room we need */ + codePtr->maxStackDepth /* Beyond the original max */ - CURR_DEPTH; /* Relative to where we are */ -- cgit v0.12 From d8e108cc4748d02d928366cc07447b2e738e796b Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 26 Jun 2013 20:13:57 +0000 Subject: Stop buffer overrun into undefined values detected by valgrind. --- generic/tclOptimize.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c index cd37a6a..b7f4173 100644 --- a/generic/tclOptimize.c +++ b/generic/tclOptimize.c @@ -212,7 +212,8 @@ ConvertZeroEffectToNOP( int blank = 0, i, nextInst; size = AddrLength(currentInstPtr); - while (*(currentInstPtr+size) == INST_NOP) { + while ((currentInstPtr + size < envPtr->codeNext) + && *(currentInstPtr+size) == INST_NOP) { if (IsTargetAddress(&targets, currentInstPtr + size)) { break; } -- cgit v0.12