Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | In some places, Tcl_UtfPrev()/Tcl_UtfNext() is used traversing the individual bytes of a string searching for '(', ')', '::' or other single bytes. It is overkill to use Tcl_UtfPrev/Tcl_UtfNext for that, since those characters can only appear as their ASCII byte, not as any other sequence. This effectively removes the last Tcl_UtfNext() call from the core, the only ones left are in tclTest.c for test commands. So the TclUtfNext() macro doesn't make sense any more. Remove "register" keyword from many files. |
|---|---|
| Timelines: | family | ancestors | descendants | both | core-8-6-branch |
| Files: | files | file ages | folders |
| SHA3-256: |
aa6cbf0a7fb3187a65b4034077050282 |
| User & Date: | jan.nijtmans 2020-05-14 09:46:54.223 |
Context
|
2020-05-18
| ||
| 20:23 | Tiny fix for TCL_UTF_MAX=4 build only: Since Tcl_UtfNext() verifies 4 bytes for lead bytes F0-F5, Tc... check-in: f299c3c546 user: jan.nijtmans tags: core-8-6-branch | |
|
2020-05-14
| ||
| 10:16 | Merge 8.6 check-in: 10e951f190 user: jan.nijtmans tags: core-8-branch | |
| 09:46 | In some places, Tcl_UtfPrev()/Tcl_UtfNext() is used traversing the individual bytes of a string sear... check-in: aa6cbf0a7f user: jan.nijtmans tags: core-8-6-branch | |
|
2020-05-13
| ||
| 17:24 | Merge-mark check-in: a558dbacdf user: jan.nijtmans tags: core-8-6-branch | |
| 15:23 | In some places, Tcl_UtfPrev()/Tcl_UtfNext() is used traversing the individual bytes of a string sear... Closed-Leaf check-in: 6b8770b300 user: jan.nijtmans tags: prev-next-cleanup | |
Changes
Changes to generic/tclCompCmds.c.
| ︙ | ︙ | |||
134 135 136 137 138 139 140 141 142 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
int isScalar, localIndex, numWords, i;
| > < | 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *valueTokenPtr;
int isScalar, localIndex, numWords, i;
/* TODO: Consider support for compiling expanded args. */
numWords = parsePtr->numWords;
if (numWords == 1) {
return TCL_ERROR;
} else if (numWords == 2) {
/*
|
| ︙ | ︙ | |||
583 584 585 586 587 588 589 590 591 592 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
JumpFixup jumpFixup;
Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
int resultIndex, optsIndex, range, dropScript = 0;
| > < | 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
JumpFixup jumpFixup;
Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
int resultIndex, optsIndex, range, dropScript = 0;
int depth = TclGetStackDepth(envPtr);
/*
* If syntax does not match what we expect for [catch], do not compile.
* Let runtime checks determine if syntax has changed.
*/
|
| ︙ | ︙ | |||
616 617 618 619 620 621 622 |
* refer to local scalars.
*/
resultIndex = optsIndex = -1;
cmdTokenPtr = TokenAfter(parsePtr->tokenPtr);
if (parsePtr->numWords >= 3) {
resultNameTokenPtr = TokenAfter(cmdTokenPtr);
| < < | 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 |
* refer to local scalars.
*/
resultIndex = optsIndex = -1;
cmdTokenPtr = TokenAfter(parsePtr->tokenPtr);
if (parsePtr->numWords >= 3) {
resultNameTokenPtr = TokenAfter(cmdTokenPtr);
resultIndex = LocalScalarFromToken(resultNameTokenPtr, envPtr);
if (resultIndex < 0) {
return TCL_ERROR;
}
if (parsePtr->numWords == 4) {
optsNameTokenPtr = TokenAfter(resultNameTokenPtr);
optsIndex = LocalScalarFromToken(optsNameTokenPtr, envPtr);
if (optsIndex < 0) {
return TCL_ERROR;
}
}
|
| ︙ | ︙ | |||
1018 1019 1020 1021 1022 1023 1024 |
Tcl_Interp *interp, /* Used for looking up stuff. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
| > | < < | 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 |
Tcl_Interp *interp, /* Used for looking up stuff. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr, *varTokenPtr;
int i, dictVarIndex;
/*
* There must be at least one argument after the command.
*/
if (parsePtr->numWords < 4) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
1144 1145 1146 1147 1148 1149 1150 1151 1152 |
Tcl_Interp *interp, /* Used for looking up stuff. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
int i;
| > < | 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 |
Tcl_Interp *interp, /* Used for looking up stuff. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
int i;
/*
* There must be at least two arguments after the command (the single-arg
* case is legal, but too special and magic for us to deal with here).
*/
/* TODO: Consider support for compiling expanded args. */
|
| ︙ | ︙ | |||
1181 1182 1183 1184 1185 1186 1187 1188 1189 |
Tcl_Interp *interp, /* Used for looking up stuff. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
int i;
| > < | 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 |
Tcl_Interp *interp, /* Used for looking up stuff. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
int i;
/*
* There must be at least two arguments after the command (the single-arg
* case is legal, but too special and magic for us to deal with here).
*/
/* TODO: Consider support for compiling expanded args. */
|
| ︙ | ︙ | |||
1218 1219 1220 1221 1222 1223 1224 |
Tcl_Interp *interp, /* Used for looking up stuff. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
| < > | 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 |
Tcl_Interp *interp, /* Used for looking up stuff. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
int i, dictVarIndex;
/*
* There must be at least one argument after the variable name for us to
* compile to bytecode.
*/
|
| ︙ | ︙ | |||
2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 |
Tcl_Interp *interp, /* Used for context. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
/*
* General syntax: [error message ?errorInfo? ?errorCode?]
*/
| > > > < < < | 2331 2332 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 |
Tcl_Interp *interp, /* Used for context. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
/*
* General syntax: [error message ?errorInfo? ?errorCode?]
*/
if (parsePtr->numWords < 2 || parsePtr->numWords > 4) {
return TCL_ERROR;
}
/*
* Handle the message.
*/
|
| ︙ | ︙ | |||
2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
JumpFixup jumpEvalCondFixup;
int bodyCodeOffset, nextCodeOffset, jumpDist;
int bodyRange, nextRange;
| > < | 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
JumpFixup jumpEvalCondFixup;
int bodyCodeOffset, nextCodeOffset, jumpDist;
int bodyRange, nextRange;
if (parsePtr->numWords != 5) {
return TCL_ERROR;
}
/*
* If the test expression requires substitutions, don't compile the for
|
| ︙ | ︙ | |||
2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 |
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr, /* Holds resulting instructions. */
int collect) /* Select collecting or accumulating mode
* (TCL_EACH_*) */
{
Proc *procPtr = envPtr->procPtr;
ForeachInfo *infoPtr=NULL; /* Points to the structure describing this
* foreach command. Stored in a AuxData
* record in the ByteCode. */
Tcl_Token *tokenPtr, *bodyTokenPtr;
int jumpBackOffset, infoIndex, range;
int numWords, numLists, i, j, code = TCL_OK;
Tcl_Obj *varListObj = NULL;
| > < | 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 |
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr, /* Holds resulting instructions. */
int collect) /* Select collecting or accumulating mode
* (TCL_EACH_*) */
{
DefineLineInformation; /* TIP #280 */
Proc *procPtr = envPtr->procPtr;
ForeachInfo *infoPtr=NULL; /* Points to the structure describing this
* foreach command. Stored in a AuxData
* record in the ByteCode. */
Tcl_Token *tokenPtr, *bodyTokenPtr;
int jumpBackOffset, infoIndex, range;
int numWords, numLists, i, j, code = TCL_OK;
Tcl_Obj *varListObj = NULL;
/*
* If the foreach command isn't in a procedure, don't compile it inline:
* the payoff is too small.
*/
if (procPtr == NULL) {
|
| ︙ | ︙ | |||
2876 2877 2878 2879 2880 2881 2882 |
*/
static ClientData
DupForeachInfo(
ClientData clientData) /* The foreach command's compilation auxiliary
* data to duplicate. */
{
| | | | 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 |
*/
static ClientData
DupForeachInfo(
ClientData clientData) /* The foreach command's compilation auxiliary
* data to duplicate. */
{
ForeachInfo *srcPtr = clientData;
ForeachInfo *dupPtr;
ForeachVarList *srcListPtr, *dupListPtr;
int numVars, i, j, numLists = srcPtr->numLists;
dupPtr = ckalloc(sizeof(ForeachInfo)
+ numLists * sizeof(ForeachVarList *));
dupPtr->numLists = numLists;
dupPtr->firstValueTemp = srcPtr->firstValueTemp;
dupPtr->loopCtTemp = srcPtr->loopCtTemp;
|
| ︙ | ︙ | |||
2925 2926 2927 2928 2929 2930 2931 |
*/
static void
FreeForeachInfo(
ClientData clientData) /* The foreach command's compilation auxiliary
* data to free. */
{
| | | | | 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 |
*/
static void
FreeForeachInfo(
ClientData clientData) /* The foreach command's compilation auxiliary
* data to free. */
{
ForeachInfo *infoPtr = clientData;
ForeachVarList *listPtr;
int numLists = infoPtr->numLists;
int i;
for (i = 0; i < numLists; i++) {
listPtr = infoPtr->varLists[i];
ckfree(listPtr);
}
ckfree(infoPtr);
}
|
| ︙ | ︙ | |||
2961 2962 2963 2964 2965 2966 2967 |
static void
PrintForeachInfo(
ClientData clientData,
Tcl_Obj *appendObj,
ByteCode *codePtr,
unsigned int pcOffset)
{
| | | | 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 |
static void
PrintForeachInfo(
ClientData clientData,
Tcl_Obj *appendObj,
ByteCode *codePtr,
unsigned int pcOffset)
{
ForeachInfo *infoPtr = clientData;
ForeachVarList *varsPtr;
int i, j;
Tcl_AppendToObj(appendObj, "data=[", -1);
for (i=0 ; i<infoPtr->numLists ; i++) {
if (i) {
Tcl_AppendToObj(appendObj, ", ", -1);
|
| ︙ | ︙ | |||
3001 3002 3003 3004 3005 3006 3007 |
static void
PrintNewForeachInfo(
ClientData clientData,
Tcl_Obj *appendObj,
ByteCode *codePtr,
unsigned int pcOffset)
{
| | | | 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 |
static void
PrintNewForeachInfo(
ClientData clientData,
Tcl_Obj *appendObj,
ByteCode *codePtr,
unsigned int pcOffset)
{
ForeachInfo *infoPtr = clientData;
ForeachVarList *varsPtr;
int i, j;
Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=",
infoPtr->loopCtTemp);
for (i=0 ; i<infoPtr->numLists ; i++) {
if (i) {
Tcl_AppendToObj(appendObj, ",", -1);
|
| ︙ | ︙ | |||
3031 3032 3033 3034 3035 3036 3037 |
static void
DisassembleForeachInfo(
ClientData clientData,
Tcl_Obj *dictObj,
ByteCode *codePtr,
unsigned int pcOffset)
{
| | | | 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 |
static void
DisassembleForeachInfo(
ClientData clientData,
Tcl_Obj *dictObj,
ByteCode *codePtr,
unsigned int pcOffset)
{
ForeachInfo *infoPtr = clientData;
ForeachVarList *varsPtr;
int i, j;
Tcl_Obj *objPtr, *innerPtr;
/*
* Data stores.
*/
|
| ︙ | ︙ | |||
3078 3079 3080 3081 3082 3083 3084 |
static void
DisassembleNewForeachInfo(
ClientData clientData,
Tcl_Obj *dictObj,
ByteCode *codePtr,
unsigned int pcOffset)
{
| | | | 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 |
static void
DisassembleNewForeachInfo(
ClientData clientData,
Tcl_Obj *dictObj,
ByteCode *codePtr,
unsigned int pcOffset)
{
ForeachInfo *infoPtr = clientData;
ForeachVarList *varsPtr;
int i, j;
Tcl_Obj *objPtr, *innerPtr;
/*
* Jump offset.
*/
|
| ︙ | ︙ | |||
3403 3404 3405 3406 3407 3408 3409 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Token *varTokenPtr, /* Points to a variable token. */
CompileEnv *envPtr, /* Holds resulting instructions. */
int flags, /* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */
int *localIndexPtr, /* Must not be NULL. */
int *isScalarPtr) /* Must not be NULL. */
{
| | | | 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Token *varTokenPtr, /* Points to a variable token. */
CompileEnv *envPtr, /* Holds resulting instructions. */
int flags, /* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */
int *localIndexPtr, /* Must not be NULL. */
int *isScalarPtr) /* Must not be NULL. */
{
const char *p;
const char *last, *name, *elName;
int n;
Tcl_Token *elemTokenPtr = NULL;
int nameLen, elNameLen, simpleVarName, localIndex;
int elemTokenCount = 0, allocedTokens = 0, removedParen = 0;
/*
* Decide if we can use a frame slot for the var/array name or if we need
* to emit code to compute and push the name at runtime. We use a frame
|
| ︙ | ︙ | |||
3437 3438 3439 3440 3441 3442 3443 |
name = varTokenPtr[1].start;
nameLen = varTokenPtr[1].size;
if (name[nameLen-1] == ')') {
/*
* last char is ')' => potential array reference.
*/
| | | | 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 |
name = varTokenPtr[1].start;
nameLen = varTokenPtr[1].size;
if (name[nameLen-1] == ')') {
/*
* last char is ')' => potential array reference.
*/
last = &name[nameLen-1];
if (*last == ')') {
for (p = name; p < last; p++) {
if (*p == '(') {
elName = p + 1;
elNameLen = last - elName;
nameLen = p - name;
break;
}
}
|
| ︙ | ︙ | |||
3468 3469 3470 3471 3472 3473 3474 |
elemTokenPtr->numComponents = 0;
elemTokenCount = 1;
}
}
} else if (interp && ((n = varTokenPtr->numComponents) > 1)
&& (varTokenPtr[1].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].type == TCL_TOKEN_TEXT)
| | < | | 3465 3466 3467 3468 3469 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 |
elemTokenPtr->numComponents = 0;
elemTokenCount = 1;
}
}
} else if (interp && ((n = varTokenPtr->numComponents) > 1)
&& (varTokenPtr[1].type == TCL_TOKEN_TEXT)
&& (varTokenPtr[n].type == TCL_TOKEN_TEXT)
&& (*(varTokenPtr[n].start + varTokenPtr[n].size - 1) == ')')) {
/*
* Check for parentheses inside first token.
*/
simpleVarName = 0;
for (p = varTokenPtr[1].start,
last = p + varTokenPtr[1].size; p < last; p++) {
if (*p == '(') {
simpleVarName = 1;
break;
}
}
if (simpleVarName) {
int remainingLen;
|
| ︙ | ︙ | |||
3544 3545 3546 3547 3548 3549 3550 |
if (simpleVarName) {
/*
* See whether name has any namespace separators (::'s).
*/
int hasNsQualifiers = 0;
| | | 3540 3541 3542 3543 3544 3545 3546 3547 3548 3549 3550 3551 3552 3553 3554 |
if (simpleVarName) {
/*
* See whether name has any namespace separators (::'s).
*/
int hasNsQualifiers = 0;
for (p = name, last = p + nameLen-1; p < last; p++) {
if ((*p == ':') && (*(p+1) == ':')) {
hasNsQualifiers = 1;
break;
}
}
/*
|
| ︙ | ︙ |
Changes to generic/tclCompCmdsGR.c.
| ︙ | ︙ | |||
87 88 89 90 91 92 93 94 95 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr;
int localIndex, numWords, i;
| > < | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr;
int localIndex, numWords, i;
/* TODO: Consider support for compiling expanded args. */
numWords = parsePtr->numWords;
if (numWords < 2) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
JumpFixupArray jumpFalseFixupArray;
/* Used to fix the ifFalse jump after each
* test when its target PC is determined. */
JumpFixupArray jumpEndFixupArray;
/* Used to fix the jump after each "then" body
* to the end of the "if" when that PC is
* determined. */
Tcl_Token *tokenPtr, *testTokenPtr;
int jumpIndex = 0; /* Avoid compiler warning. */
int jumpFalseDist, numWords, wordIdx, numBytes, j, code;
const char *word;
int realCond = 1; /* Set to 0 for static conditions:
* "if 0 {..}" */
int boolVal; /* Value of static condition. */
int compileScripts = 1;
| > < | 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
JumpFixupArray jumpFalseFixupArray;
/* Used to fix the ifFalse jump after each
* test when its target PC is determined. */
JumpFixupArray jumpEndFixupArray;
/* Used to fix the jump after each "then" body
* to the end of the "if" when that PC is
* determined. */
Tcl_Token *tokenPtr, *testTokenPtr;
int jumpIndex = 0; /* Avoid compiler warning. */
int jumpFalseDist, numWords, wordIdx, numBytes, j, code;
const char *word;
int realCond = 1; /* Set to 0 for static conditions:
* "if 0 {..}" */
int boolVal; /* Value of static condition. */
int compileScripts = 1;
/*
* Only compile the "if" command if all arguments are simple words, in
* order to insure correct substitution [Bug 219166]
*/
tokenPtr = parsePtr->tokenPtr;
|
| ︙ | ︙ | |||
469 470 471 472 473 474 475 476 477 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr, *incrTokenPtr;
int isScalar, localIndex, haveImmValue, immValue;
| > < | 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *incrTokenPtr;
int isScalar, localIndex, haveImmValue, immValue;
if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
return TCL_ERROR;
}
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
|
| ︙ | ︙ | |||
666 667 668 669 670 671 672 673 674 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
int isScalar, localIndex;
| > < | 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
int isScalar, localIndex;
if (parsePtr->numWords != 2) {
return TCL_ERROR;
}
/*
* Decide if we can use a frame slot for the var/array name or if we need
|
| ︙ | ︙ | |||
844 845 846 847 848 849 850 851 852 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
int isScalar, localIndex, numWords, i;
| > < | 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *valueTokenPtr;
int isScalar, localIndex, numWords, i;
/* TODO: Consider support for compiling expanded args. */
numWords = parsePtr->numWords;
if (numWords < 3) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
960 961 962 963 964 965 966 967 968 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr;
int isScalar, localIndex, numWords, idx;
| > < | 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
int isScalar, localIndex, numWords, idx;
numWords = parsePtr->numWords;
/*
* Check for command syntax error, but we'll punt that to runtime.
*/
|
| ︙ | ︙ | |||
1064 1065 1066 1067 1068 1069 1070 1071 1072 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *idxTokenPtr, *valTokenPtr;
int i, idx, numWords = parsePtr->numWords;
| > < | 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *idxTokenPtr, *valTokenPtr;
int i, idx, numWords = parsePtr->numWords;
/*
* Quit if too few args.
*/
/* TODO: Consider support for compiling expanded args. */
if (numWords <= 1) {
|
| ︙ | ︙ | |||
1269 1270 1271 1272 1273 1274 1275 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
| < > | 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr;
if (parsePtr->numWords != 2) {
return TCL_ERROR;
}
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
CompileWord(envPtr, varTokenPtr, interp, 1);
|
| ︙ | ︙ | |||
1302 1303 1304 1305 1306 1307 1308 |
Tcl_Interp *interp, /* Tcl interpreter for context. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
| < > | 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 |
Tcl_Interp *interp, /* Tcl interpreter for context. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr, *listTokenPtr;
int idx1, idx2;
if (parsePtr->numWords != 4) {
return TCL_ERROR;
}
listTokenPtr = TokenAfter(parsePtr->tokenPtr);
|
| ︙ | ︙ | |||
1363 1364 1365 1366 1367 1368 1369 |
Tcl_Interp *interp, /* Tcl interpreter for context. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
| < > | 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 |
Tcl_Interp *interp, /* Tcl interpreter for context. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr, *listTokenPtr;
int idx, i;
if (parsePtr->numWords < 3) {
return TCL_ERROR;
}
listTokenPtr = TokenAfter(parsePtr->tokenPtr);
|
| ︙ | ︙ | |||
1466 1467 1468 1469 1470 1471 1472 |
Tcl_Interp *interp, /* Tcl interpreter for context. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
| < > | 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 |
Tcl_Interp *interp, /* Tcl interpreter for context. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr, *listTokenPtr;
int idx1, idx2, i;
int emptyPrefix=1, suffixStart = 0;
if (parsePtr->numWords < 4) {
return TCL_ERROR;
}
listTokenPtr = TokenAfter(parsePtr->tokenPtr);
|
| ︙ | ︙ | |||
1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 |
Tcl_Interp *interp, /* Tcl interpreter for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
int tempDepth; /* Depth used for emitting one part of the
* code burst. */
Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the
* parse of the variable name. */
int localIndex; /* Index of var in local var table. */
int isScalar; /* Flag == 1 if scalar, 0 if array. */
int i;
| > < | 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 |
Tcl_Interp *interp, /* Tcl interpreter for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
int tempDepth; /* Depth used for emitting one part of the
* code burst. */
Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the
* parse of the variable name. */
int localIndex; /* Index of var in local var table. */
int isScalar; /* Flag == 1 if scalar, 0 if array. */
int i;
/*
* Check argument count.
*/
/* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords < 3) {
|
| ︙ | ︙ | |||
1802 1803 1804 1805 1806 1807 1808 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
| < > | 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
if (parsePtr->numWords != 2) {
return TCL_ERROR;
}
tokenPtr = TokenAfter(parsePtr->tokenPtr);
/*
|
| ︙ | ︙ | |||
1852 1853 1854 1855 1856 1857 1858 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
| < > < > | 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
if (parsePtr->numWords != 2) {
return TCL_ERROR;
}
tokenPtr = TokenAfter(parsePtr->tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 1);
TclEmitOpcode( INST_ORIGIN_COMMAND, envPtr);
return TCL_OK;
}
int
TclCompileNamespaceQualifiersCmd(
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
int off;
if (parsePtr->numWords != 2) {
return TCL_ERROR;
}
CompileWord(envPtr, tokenPtr, interp, 1);
|
| ︙ | ︙ | |||
1910 1911 1912 1913 1914 1915 1916 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
| < > | 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
JumpFixup jumpFixup;
if (parsePtr->numWords != 2) {
return TCL_ERROR;
}
/*
|
| ︙ | ︙ | |||
1947 1948 1949 1950 1951 1952 1953 1954 1955 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
int localIndex, numWords, i;
| > < | 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
int localIndex, numWords, i;
if (envPtr->procPtr == NULL) {
return TCL_ERROR;
}
/*
* Only compile [namespace upvar ...]: needs an even number of args, >=4
|
| ︙ | ︙ | |||
2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 |
Tcl_Interp *interp, /* Tcl interpreter for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the
* parse of the RE or string. */
int i, len, nocase, exact, sawLast, simple;
const char *str;
| > < | 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 |
Tcl_Interp *interp, /* Tcl interpreter for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the
* parse of the RE or string. */
int i, len, nocase, exact, sawLast, simple;
const char *str;
/*
* We are only interested in compiling simple regexp cases. Currently
* supported compile cases are:
* regexp ?-nocase? ?--? staticString $var
* regexp ?-nocase? ?--? {^staticString$} $var
*/
|
| ︙ | ︙ | |||
2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
/*
* General syntax: [return ?-option value ...? ?result?]
* An even number of words means an explicit result argument is present.
*/
int level, code, objc, size, status = TCL_OK;
int numWords = parsePtr->numWords;
int explicitResult = (0 == (numWords % 2));
int numOptionWords = numWords - 1 - explicitResult;
Tcl_Obj *returnOpts, **objv;
Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
| > < | 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
/*
* General syntax: [return ?-option value ...? ?result?]
* An even number of words means an explicit result argument is present.
*/
int level, code, objc, size, status = TCL_OK;
int numWords = parsePtr->numWords;
int explicitResult = (0 == (numWords % 2));
int numOptionWords = numWords - 1 - explicitResult;
Tcl_Obj *returnOpts, **objv;
Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
/*
* Check for special case which can always be compiled:
* return -options <opts> <msg>
* Unlike the normal [return] compilation, this version does everything at
* runtime so it can handle arbitrary words and not just literals. Note
* that if INST_RETURN_STK wasn't already needed for something else
|
| ︙ | ︙ | |||
2664 2665 2666 2667 2668 2669 2670 2671 2672 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
int localIndex, numWords, i;
| > < | 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
int localIndex, numWords, i;
Tcl_Obj *objPtr;
if (envPtr->procPtr == NULL) {
return TCL_ERROR;
}
numWords = parsePtr->numWords;
|
| ︙ | ︙ | |||
2771 2772 2773 2774 2775 2776 2777 2778 2779 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
int localIndex, numWords, i;
| > < | 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *valueTokenPtr;
int localIndex, numWords, i;
numWords = parsePtr->numWords;
if (numWords < 2) {
return TCL_ERROR;
}
/*
|
| ︙ | ︙ |
Changes to generic/tclCompCmdsSZ.c.
| ︙ | ︙ | |||
131 132 133 134 135 136 137 138 139 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr, *valueTokenPtr;
int isAssignment, isScalar, localIndex, numWords;
| > < | 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *valueTokenPtr;
int isAssignment, isScalar, localIndex, numWords;
numWords = parsePtr->numWords;
if ((numWords != 2) && (numWords != 3)) {
return TCL_ERROR;
}
isAssignment = (numWords == 3);
|
| ︙ | ︙ | |||
225 226 227 228 229 230 231 232 233 234 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
int i, numWords = parsePtr->numWords, numArgs;
Tcl_Token *wordTokenPtr;
Tcl_Obj *obj, *folded;
| > < | 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
int i, numWords = parsePtr->numWords, numArgs;
Tcl_Token *wordTokenPtr;
Tcl_Obj *obj, *folded;
/* Trivial case, no arg */
if (numWords<2) {
PushStringLiteral(envPtr, "");
return TCL_OK;
}
|
| ︙ | ︙ | |||
992 993 994 995 996 997 998 |
Tcl_Interp *interp, /* Tcl interpreter for context. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
| < > | 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 |
Tcl_Interp *interp, /* Tcl interpreter for context. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the
* command. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr, *valueTokenPtr;
int first, last;
if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
return TCL_ERROR;
}
/* Bytecode to compute/push string argument being replaced */
|
| ︙ | ︙ | |||
1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
int numArgs = parsePtr->numWords - 1;
int numOpts = numArgs - 1;
int objc, flags = TCL_SUBST_ALL;
Tcl_Obj **objv/*, *toSubst = NULL*/;
Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
int code = TCL_ERROR;
| > < | 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
int numArgs = parsePtr->numWords - 1;
int numOpts = numArgs - 1;
int objc, flags = TCL_SUBST_ALL;
Tcl_Obj **objv/*, *toSubst = NULL*/;
Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
int code = TCL_ERROR;
if (numArgs == 0) {
return TCL_ERROR;
}
objv = TclStackAlloc(interp, /*numArgs*/ numOpts * sizeof(Tcl_Obj *));
|
| ︙ | ︙ | |||
1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr; /* Pointer to tokens in command. */
int numWords; /* Number of words in command. */
Tcl_Token *valueTokenPtr; /* Token for the value to switch on. */
enum {Switch_Exact, Switch_Glob, Switch_Regexp} mode;
/* What kind of switch are we doing? */
Tcl_Token *bodyTokenArray; /* Array of real pattern list items. */
Tcl_Token **bodyToken; /* Array of pointers to pattern list items. */
int *bodyLines; /* Array of line numbers for body list
* items. */
int **bodyContLines; /* Array of continuation line info. */
int noCase; /* Has the -nocase flag been given? */
int foundMode = 0; /* Have we seen a mode flag yet? */
int i, valueIndex;
int result = TCL_ERROR;
| > < | 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr; /* Pointer to tokens in command. */
int numWords; /* Number of words in command. */
Tcl_Token *valueTokenPtr; /* Token for the value to switch on. */
enum {Switch_Exact, Switch_Glob, Switch_Regexp} mode;
/* What kind of switch are we doing? */
Tcl_Token *bodyTokenArray; /* Array of real pattern list items. */
Tcl_Token **bodyToken; /* Array of pointers to pattern list items. */
int *bodyLines; /* Array of line numbers for body list
* items. */
int **bodyContLines; /* Array of continuation line info. */
int noCase; /* Has the -nocase flag been given? */
int foundMode = 0; /* Have we seen a mode flag yet? */
int i, valueIndex;
int result = TCL_ERROR;
int *clNext = envPtr->clNext;
/*
* Only handle the following versions:
* switch ?--? word {pattern body ...}
* switch -exact ?--? word {pattern body ...}
* switch -glob ?--? word {pattern body ...}
|
| ︙ | ︙ | |||
1796 1797 1798 1799 1800 1801 1802 |
* way to statically avoid the problems you get from strings-to-be-matched
* that start with a - (the interpreted code falls apart if it encounters
* them, so we punt if we *might* encounter them as that is the easiest
* way of emulating the behaviour).
*/
for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) {
| | | | 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 |
* way to statically avoid the problems you get from strings-to-be-matched
* that start with a - (the interpreted code falls apart if it encounters
* them, so we punt if we *might* encounter them as that is the easiest
* way of emulating the behaviour).
*/
for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) {
unsigned size = tokenPtr[1].size;
const char *chrs = tokenPtr[1].start;
/*
* We only process literal options, and we assume that -e, -g and -n
* are unique prefixes of -exact, -glob and -nocase respectively (true
* at time of writing). Note that -exact and -glob may only be given
* at most once or we bail out (error case).
*/
|
| ︙ | ︙ | |||
2536 2537 2538 2539 2540 2541 2542 |
static void
PrintJumptableInfo(
ClientData clientData,
Tcl_Obj *appendObj,
ByteCode *codePtr,
unsigned int pcOffset)
{
| | | 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 |
static void
PrintJumptableInfo(
ClientData clientData,
Tcl_Obj *appendObj,
ByteCode *codePtr,
unsigned int pcOffset)
{
JumptableInfo *jtPtr = clientData;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
const char *keyPtr;
int offset, i = 0;
hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
|
| ︙ | ︙ | |||
2565 2566 2567 2568 2569 2570 2571 |
static void
DisassembleJumptableInfo(
ClientData clientData,
Tcl_Obj *dictObj,
ByteCode *codePtr,
unsigned int pcOffset)
{
| | | 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 |
static void
DisassembleJumptableInfo(
ClientData clientData,
Tcl_Obj *dictObj,
ByteCode *codePtr,
unsigned int pcOffset)
{
JumptableInfo *jtPtr = clientData;
Tcl_Obj *mapping = Tcl_NewObj();
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
const char *keyPtr;
int offset;
hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
|
| ︙ | ︙ | |||
3570 3571 3572 3573 3574 3575 3576 3577 3578 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *varTokenPtr;
int isScalar, localIndex, flags = 1, i, varCount = 0, haveFlags = 0;
| > < | 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr;
int isScalar, localIndex, flags = 1, i, varCount = 0, haveFlags = 0;
/* TODO: Consider support for compiling expanded args. */
/*
* Verify that all words - except the first non-option one - are known at
* compile time so that we can handle them without needing to do a nasty
* push/rotate. [Bug 3970f54c4e]
|
| ︙ | ︙ | |||
3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *testTokenPtr, *bodyTokenPtr;
JumpFixup jumpEvalCondFixup;
int testCodeOffset, bodyCodeOffset, jumpDist, range, code, boolVal;
int loopMayEnd = 1; /* This is set to 0 if it is recognized as an
* infinite loop. */
Tcl_Obj *boolObj;
| > < | 3708 3709 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 3728 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *testTokenPtr, *bodyTokenPtr;
JumpFixup jumpEvalCondFixup;
int testCodeOffset, bodyCodeOffset, jumpDist, range, code, boolVal;
int loopMayEnd = 1; /* This is set to 0 if it is recognized as an
* infinite loop. */
Tcl_Obj *boolObj;
if (parsePtr->numWords != 3) {
return TCL_ERROR;
}
/*
* If the test expression requires substitutions, don't compile the while
|
| ︙ | ︙ | |||
3972 3973 3974 3975 3976 3977 3978 |
static int
CompileUnaryOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
int instruction,
CompileEnv *envPtr)
{
| < > | 3972 3973 3974 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 |
static int
CompileUnaryOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
int instruction,
CompileEnv *envPtr)
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
if (parsePtr->numWords != 2) {
return TCL_ERROR;
}
tokenPtr = TokenAfter(parsePtr->tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 1);
TclEmitOpcode(instruction, envPtr);
|
| ︙ | ︙ | |||
4014 4015 4016 4017 4018 4019 4020 |
CompileAssociativeBinaryOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
const char *identity,
int instruction,
CompileEnv *envPtr)
{
| < > | 4014 4015 4016 4017 4018 4019 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 |
CompileAssociativeBinaryOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
const char *identity,
int instruction,
CompileEnv *envPtr)
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
int words;
/* TODO: Consider support for compiling expanded args. */
for (words=1 ; words<parsePtr->numWords ; words++) {
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, words);
}
|
| ︙ | ︙ | |||
4099 4100 4101 4102 4103 4104 4105 |
static int
CompileComparisonOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
int instruction,
CompileEnv *envPtr)
{
| < > | 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 4109 4110 4111 4112 4113 4114 |
static int
CompileComparisonOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
int instruction,
CompileEnv *envPtr)
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
/* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords < 3) {
PUSH("1");
} else if (parsePtr->numWords == 3) {
tokenPtr = TokenAfter(parsePtr->tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 1);
|
| ︙ | ︙ | |||
4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 |
TclCompilePowOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr)
{
/*
* This one has its own implementation because the ** operator is the only
* one with right associativity.
*/
| > > > > < < < < | 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 |
TclCompilePowOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr)
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
int words;
/*
* This one has its own implementation because the ** operator is the only
* one with right associativity.
*/
for (words=1 ; words<parsePtr->numWords ; words++) {
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, words);
}
if (parsePtr->numWords <= 2) {
PUSH("1");
words++;
|
| ︙ | ︙ | |||
4436 4437 4438 4439 4440 4441 4442 |
TclCompileMinusOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr)
{
| < > | 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 |
TclCompileMinusOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr)
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
int words;
/* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords == 1) {
/*
* Fallback to direct eval to report syntax error.
*/
|
| ︙ | ︙ | |||
4482 4483 4484 4485 4486 4487 4488 |
TclCompileDivOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr)
{
| < > | 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 |
TclCompileDivOpCmd(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr)
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
int words;
/* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords == 1) {
/*
* Fallback to direct eval to report syntax error.
*/
|
| ︙ | ︙ |
Changes to generic/tclCompile.c.
| ︙ | ︙ | |||
964 965 966 967 968 969 970 | * cleanup is delayed until the last execution of the code completes. * *---------------------------------------------------------------------- */ static void FreeByteCodeInternalRep( | | | | 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 |
* cleanup is delayed until the last execution of the code completes.
*
*----------------------------------------------------------------------
*/
static void
FreeByteCodeInternalRep(
Tcl_Obj *objPtr) /* Object whose internal rep to free. */
{
ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
objPtr->typePtr = NULL;
if (codePtr->refCount-- <= 1) {
TclCleanupByteCode(codePtr);
}
}
|
| ︙ | ︙ | |||
995 996 997 998 999 1000 1001 | * Also releases its literals and frees its auxiliary data items. * *---------------------------------------------------------------------- */ void TclCleanupByteCode( | | | | | 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 |
* Also releases its literals and frees its auxiliary data items.
*
*----------------------------------------------------------------------
*/
void
TclCleanupByteCode(
ByteCode *codePtr) /* Points to the ByteCode to free. */
{
Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
Interp *iPtr = (Interp *) interp;
int numLitObjects = codePtr->numLitObjects;
int numAuxDataItems = codePtr->numAuxDataItems;
Tcl_Obj **objArrayPtr, *objPtr;
const AuxData *auxDataPtr;
int i;
#ifdef TCL_COMPILE_STATS
if (interp != NULL) {
ByteCodeStats *statsPtr;
Tcl_Time destroyTime;
int lifetimeSec, lifetimeMicroSec, log2;
|
| ︙ | ︙ | |||
1350 1351 1352 1353 1354 1355 1356 | * the cleanup is delayed until the last execution of the code completes. * *---------------------------------------------------------------------- */ static void FreeSubstCodeInternalRep( | | | | 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 |
* the cleanup is delayed until the last execution of the code completes.
*
*----------------------------------------------------------------------
*/
static void
FreeSubstCodeInternalRep(
Tcl_Obj *objPtr) /* Object whose internal rep to free. */
{
ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
objPtr->typePtr = NULL;
if (codePtr->refCount-- <= 1) {
TclCleanupByteCode(codePtr);
}
}
|
| ︙ | ︙ | |||
1401 1402 1403 1404 1405 1406 1407 |
*----------------------------------------------------------------------
*/
void
TclInitCompileEnv(
Tcl_Interp *interp, /* The interpreter for which a CompileEnv
* structure is initialized. */
| | | 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 |
*----------------------------------------------------------------------
*/
void
TclInitCompileEnv(
Tcl_Interp *interp, /* The interpreter for which a CompileEnv
* structure is initialized. */
CompileEnv *envPtr,/* Points to the CompileEnv structure to
* initialize. */
const char *stringPtr, /* The source string to be compiled. */
int numBytes, /* Number of bytes in source string. */
const CmdFrame *invoker, /* Location context invoking the bcc */
int word) /* Index of the word in that context getting
* compiled */
{
|
| ︙ | ︙ | |||
1608 1609 1610 1611 1612 1613 1614 | * corresponding ByteCode structure. * *---------------------------------------------------------------------- */ void TclFreeCompileEnv( | | | 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 |
* corresponding ByteCode structure.
*
*----------------------------------------------------------------------
*/
void
TclFreeCompileEnv(
CompileEnv *envPtr)/* Points to the CompileEnv structure. */
{
if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){
ckfree(envPtr->localLitTable.buckets);
envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets;
}
if (envPtr->iPtr) {
/*
|
| ︙ | ︙ | |||
1808 1809 1810 1811 1812 1813 1814 |
TclCompileInvocation(
Tcl_Interp *interp,
Tcl_Token *tokenPtr,
Tcl_Obj *cmdObj,
int numWords,
CompileEnv *envPtr)
{
| < > | 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 |
TclCompileInvocation(
Tcl_Interp *interp,
Tcl_Token *tokenPtr,
Tcl_Obj *cmdObj,
int numWords,
CompileEnv *envPtr)
{
DefineLineInformation;
int wordIdx = 0, depth = TclGetStackDepth(envPtr);
if (cmdObj) {
CompileCmdLiteral(interp, cmdObj, envPtr);
wordIdx = 1;
tokenPtr = TokenAfter(tokenPtr);
}
|
| ︙ | ︙ | |||
1852 1853 1854 1855 1856 1857 1858 |
CompileExpanded(
Tcl_Interp *interp,
Tcl_Token *tokenPtr,
Tcl_Obj *cmdObj,
int numWords,
CompileEnv *envPtr)
{
| < > | 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 |
CompileExpanded(
Tcl_Interp *interp,
Tcl_Token *tokenPtr,
Tcl_Obj *cmdObj,
int numWords,
CompileEnv *envPtr)
{
DefineLineInformation;
int wordIdx = 0;
int depth = TclGetStackDepth(envPtr);
StartExpanding(envPtr);
if (cmdObj) {
CompileCmdLiteral(interp, cmdObj, envPtr);
wordIdx = 1;
tokenPtr = TokenAfter(tokenPtr);
|
| ︙ | ︙ | |||
1911 1912 1913 1914 1915 1916 1917 |
static int
CompileCmdCompileProc(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
Command *cmdPtr,
CompileEnv *envPtr)
{
| < > | 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 |
static int
CompileCmdCompileProc(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
Command *cmdPtr,
CompileEnv *envPtr)
{
DefineLineInformation;
int unwind = 0, incrOffset = -1;
int depth = TclGetStackDepth(envPtr);
/*
* Emit of the INST_START_CMD instruction is controlled by the value of
* envPtr->atCmdStart:
*
* atCmdStart == 2 : We are not using the INST_START_CMD instruction.
|
| ︙ | ︙ | |||
2745 2746 2747 2748 2749 2750 2751 |
*/
void
TclInitByteCodeObj(
Tcl_Obj *objPtr, /* Points object that should be initialized,
* and whose string rep contains the source
* code. */
| | | | | 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 |
*/
void
TclInitByteCodeObj(
Tcl_Obj *objPtr, /* Points object that should be initialized,
* and whose string rep contains the source
* code. */
CompileEnv *envPtr)/* Points to the CompileEnv structure from
* which to create a ByteCode structure. */
{
ByteCode *codePtr;
size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
size_t auxDataArrayBytes, structureSize;
unsigned char *p;
#ifdef TCL_COMPILE_DEBUG
unsigned char *nextPtr;
#endif
int numLitObjects = envPtr->literalArrayNext;
Namespace *namespacePtr;
int i, isNew;
Interp *iPtr;
|
| ︙ | ︙ | |||
2936 2937 2938 2939 2940 2941 2942 | * variable is unknown, or if the name is NULL. * *---------------------------------------------------------------------- */ int TclFindCompiledLocal( | | | | | 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 |
* variable is unknown, or if the name is NULL.
*
*----------------------------------------------------------------------
*/
int
TclFindCompiledLocal(
const char *name, /* Points to first character of the name of a
* scalar or array variable. If NULL, a
* temporary var should be created. */
int nameBytes, /* Number of bytes in the name. */
int create, /* If 1, allocate a local frame entry for the
* variable if it is new. */
CompileEnv *envPtr) /* Points to the current compile environment*/
{
CompiledLocal *localPtr;
int localVar = -1;
int i;
Proc *procPtr;
/*
* If not creating a temporary, does a local variable of the specified
* name already exist?
*/
|
| ︙ | ︙ | |||
3318 3319 3320 3321 3322 3323 3324 |
*
*----------------------------------------------------------------------
*/
int
TclCreateExceptRange(
ExceptionRangeType type, /* The kind of ExceptionRange desired. */
| | | | | 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 |
*
*----------------------------------------------------------------------
*/
int
TclCreateExceptRange(
ExceptionRangeType type, /* The kind of ExceptionRange desired. */
CompileEnv *envPtr)/* Points to CompileEnv for which to create a
* new ExceptionRange structure. */
{
ExceptionRange *rangePtr;
ExceptionAux *auxPtr;
int index = envPtr->exceptArrayNext;
if (index >= envPtr->exceptArrayEnd) {
/*
* Expand the ExceptionRange array. The currently allocated entries
* are stored between elements 0 and (envPtr->exceptArrayNext - 1)
* [inclusive].
|
| ︙ | ︙ | |||
3686 3687 3688 3689 3690 3691 3692 |
int
TclCreateAuxData(
ClientData clientData, /* The compilation auxiliary data to store in
* the new aux data record. */
const AuxDataType *typePtr, /* Pointer to the type to attach to this
* AuxData */
| | | | 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 3696 3697 3698 3699 3700 3701 3702 3703 3704 |
int
TclCreateAuxData(
ClientData clientData, /* The compilation auxiliary data to store in
* the new aux data record. */
const AuxDataType *typePtr, /* Pointer to the type to attach to this
* AuxData */
CompileEnv *envPtr)/* Points to the CompileEnv for which a new
* aux data structure is to be allocated. */
{
int index; /* Index for the new AuxData structure. */
AuxData *auxDataPtr;
/* Points to the new AuxData structure */
index = envPtr->auxDataArrayNext;
if (index >= envPtr->auxDataArrayEnd) {
/*
* Expand the AuxData array. The currently allocated entries are
* stored between elements 0 and (envPtr->auxDataArrayNext - 1)
|
| ︙ | ︙ | |||
3749 3750 3751 3752 3753 3754 3755 | * The JumpFixupArray structure is initialized. * *---------------------------------------------------------------------- */ void TclInitJumpFixupArray( | | | 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 |
* The JumpFixupArray structure is initialized.
*
*----------------------------------------------------------------------
*/
void
TclInitJumpFixupArray(
JumpFixupArray *fixupArrayPtr)
/* Points to the JumpFixupArray structure to
* initialize. */
{
fixupArrayPtr->fixup = fixupArrayPtr->staticFixupSpace;
fixupArrayPtr->next = 0;
fixupArrayPtr->end = JUMPFIXUP_INIT_ENTRIES - 1;
fixupArrayPtr->mallocedArray = 0;
|
| ︙ | ︙ | |||
3781 3782 3783 3784 3785 3786 3787 | * array to the new one. * *---------------------------------------------------------------------- */ void TclExpandJumpFixupArray( | | | 3781 3782 3783 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 |
* array to the new one.
*
*----------------------------------------------------------------------
*/
void
TclExpandJumpFixupArray(
JumpFixupArray *fixupArrayPtr)
/* Points to the JumpFixupArray structure to
* enlarge. */
{
/*
* The currently allocated jump fixup entries are stored from fixup[0] up
* to fixup[fixupArrayPtr->fixupNext] (*not* inclusive). We assume
* fixupArrayPtr->fixupNext is equal to fixupArrayPtr->fixupEnd.
|
| ︙ | ︙ | |||
3830 3831 3832 3833 3834 3835 3836 | * Allocated storage in the JumpFixupArray structure is freed. * *---------------------------------------------------------------------- */ void TclFreeJumpFixupArray( | | | 3830 3831 3832 3833 3834 3835 3836 3837 3838 3839 3840 3841 3842 3843 3844 |
* Allocated storage in the JumpFixupArray structure is freed.
*
*----------------------------------------------------------------------
*/
void
TclFreeJumpFixupArray(
JumpFixupArray *fixupArrayPtr)
/* Points to the JumpFixupArray structure to
* free. */
{
if (fixupArrayPtr->mallocedArray) {
ckfree(fixupArrayPtr->fixup);
}
}
|
| ︙ | ︙ | |||
4277 4278 4279 4280 4281 4282 4283 |
static int
GetCmdLocEncodingSize(
CompileEnv *envPtr) /* Points to compilation environment structure
* containing the CmdLocation structure to
* encode. */
{
| | | 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 |
static int
GetCmdLocEncodingSize(
CompileEnv *envPtr) /* Points to compilation environment structure
* containing the CmdLocation structure to
* encode. */
{
CmdLocation *mapPtr = envPtr->cmdMapPtr;
int numCmds = envPtr->numCommands;
int codeDelta, codeLen, srcDelta, srcLen;
int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext;
/* The offsets in their respective byte
* sequences where the next encoded offset or
* length should go. */
int prevCodeOffset, prevSrcOffset, i;
|
| ︙ | ︙ | |||
4361 4362 4363 4364 4365 4366 4367 |
* encode. */
ByteCode *codePtr, /* ByteCode in which to encode envPtr's
* command location information. */
unsigned char *startPtr) /* Points to the first byte in codePtr's
* memory block where the location information
* is to be stored. */
{
| | | | | 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 |
* encode. */
ByteCode *codePtr, /* ByteCode in which to encode envPtr's
* command location information. */
unsigned char *startPtr) /* Points to the first byte in codePtr's
* memory block where the location information
* is to be stored. */
{
CmdLocation *mapPtr = envPtr->cmdMapPtr;
int numCmds = envPtr->numCommands;
unsigned char *p = startPtr;
int codeDelta, codeLen, srcDelta, srcLen, prevOffset;
int i;
/*
* Encode the code offset for each command as a sequence of deltas.
*/
codePtr->codeDeltaStart = p;
prevOffset = 0;
|
| ︙ | ︙ | |||
4479 4480 4481 4482 4483 4484 4485 |
void
RecordByteCodeStats(
ByteCode *codePtr) /* Points to ByteCode structure with info
* to add to accumulated statistics. */
{
Interp *iPtr = (Interp *) *codePtr->interpHandle;
| | | 4479 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 |
void
RecordByteCodeStats(
ByteCode *codePtr) /* Points to ByteCode structure with info
* to add to accumulated statistics. */
{
Interp *iPtr = (Interp *) *codePtr->interpHandle;
ByteCodeStats *statsPtr;
if (iPtr == NULL) {
/* Avoid segfaulting in case we're called in a deleted interp */
return;
}
statsPtr = &(iPtr->stats);
|
| ︙ | ︙ |
Changes to generic/tclEnsemble.c.
| ︙ | ︙ | |||
103 104 105 106 107 108 109 |
} EnsembleCmdRep;
static inline Tcl_Obj *
NewNsObj(
Tcl_Namespace *namespacePtr)
{
| | | 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 |
} EnsembleCmdRep;
static inline Tcl_Obj *
NewNsObj(
Tcl_Namespace *namespacePtr)
{
Namespace *nsPtr = (Namespace *) namespacePtr;
if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) {
return Tcl_NewStringObj("::", 2);
} else {
return Tcl_NewStringObj(nsPtr->fullName, -1);
}
}
|
| ︙ | ︙ | |||
1801 1802 1803 1804 1805 1806 1807 |
char *fullName = NULL; /* Full name of the subcommand. */
int stringLength, i;
int tableLength = ensemblePtr->subcommandTable.numEntries;
Tcl_Obj *fix;
subcmdName = Tcl_GetStringFromObj(subObj, &stringLength);
for (i=0 ; i<tableLength ; i++) {
| | | 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 |
char *fullName = NULL; /* Full name of the subcommand. */
int stringLength, i;
int tableLength = ensemblePtr->subcommandTable.numEntries;
Tcl_Obj *fix;
subcmdName = Tcl_GetStringFromObj(subObj, &stringLength);
for (i=0 ; i<tableLength ; i++) {
int cmp = strncmp(subcmdName,
ensemblePtr->subcommandArrayPtr[i],
(unsigned) stringLength);
if (cmp == 0) {
if (fullName != NULL) {
/*
* Since there's never the exact-match case to worry about
|
| ︙ | ︙ | |||
2392 2393 2394 2395 2396 2397 2398 |
static void
MakeCachedEnsembleCommand(
Tcl_Obj *objPtr,
EnsembleConfig *ensemblePtr,
Tcl_HashEntry *hPtr,
Tcl_Obj *fix)
{
| | | 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 |
static void
MakeCachedEnsembleCommand(
Tcl_Obj *objPtr,
EnsembleConfig *ensemblePtr,
Tcl_HashEntry *hPtr,
Tcl_Obj *fix)
{
EnsembleCmdRep *ensembleCmd;
if (objPtr->typePtr == &ensembleCmdType) {
ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
TclCleanupCommandMacro(ensembleCmd->token);
if (ensembleCmd->fix) {
Tcl_DecrRefCount(ensembleCmd->fix);
}
|
| ︙ | ︙ | |||
2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
Tcl_Obj *replaced = Tcl_NewObj(), *replacement;
Tcl_Command ensemble = (Tcl_Command) cmdPtr;
Command *oldCmdPtr = cmdPtr, *newCmdPtr;
int len, result, flags = 0, i, depth = 1, invokeAnyway = 0;
int ourResult = TCL_ERROR;
unsigned numBytes;
const char *word;
| > < | 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 |
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Parse *parsePtr, /* Points to a parse structure for the command
* created by Tcl_ParseCommand. */
Command *cmdPtr, /* Points to defintion of command being
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation;
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
Tcl_Obj *replaced = Tcl_NewObj(), *replacement;
Tcl_Command ensemble = (Tcl_Command) cmdPtr;
Command *oldCmdPtr = cmdPtr, *newCmdPtr;
int len, result, flags = 0, i, depth = 1, invokeAnyway = 0;
int ourResult = TCL_ERROR;
unsigned numBytes;
const char *word;
Tcl_IncrRefCount(replaced);
if (parsePtr->numWords < depth + 1) {
goto failed;
}
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
/*
|
| ︙ | ︙ | |||
3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 |
TclAttemptCompileProc(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
int depth,
Command *cmdPtr,
CompileEnv *envPtr) /* Holds resulting instructions. */
{
int result, i;
Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
int savedStackDepth = envPtr->currStackDepth;
unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
int savedAuxDataArrayNext = envPtr->auxDataArrayNext;
int savedExceptArrayNext = envPtr->exceptArrayNext;
#ifdef TCL_COMPILE_DEBUG
int savedExceptDepth = envPtr->exceptDepth;
#endif
| > < | 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 |
TclAttemptCompileProc(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
int depth,
Command *cmdPtr,
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation;
int result, i;
Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
int savedStackDepth = envPtr->currStackDepth;
unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
int savedAuxDataArrayNext = envPtr->auxDataArrayNext;
int savedExceptArrayNext = envPtr->exceptArrayNext;
#ifdef TCL_COMPILE_DEBUG
int savedExceptDepth = envPtr->exceptDepth;
#endif
if (cmdPtr->compileProc == NULL) {
return TCL_ERROR;
}
/*
* Advance parsePtr->tokenPtr so that it points at the last subcommand.
|
| ︙ | ︙ | |||
3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 |
CompileToInvokedCommand(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
Tcl_Obj *replacements,
Command *cmdPtr,
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Tcl_Token *tokPtr;
Tcl_Obj *objPtr, **words;
char *bytes;
int length, i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;
| > < | 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 |
CompileToInvokedCommand(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
Tcl_Obj *replacements,
Command *cmdPtr,
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation;
Tcl_Token *tokPtr;
Tcl_Obj *objPtr, **words;
char *bytes;
int length, i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;
/*
* Push the words of the command. Take care; the command words may be
* scripts that have backslashes in them, and [info frame 0] can see the
* difference. Hence the call to TclContinuationsEnterDerived...
*/
|
| ︙ | ︙ |
Changes to generic/tclInt.h.
| ︙ | ︙ | |||
4480 4481 4482 4483 4484 4485 4486 |
} while (0);
#define TclUtfPrev(src, start) \
(((src) < (start)+2) ? (start) : \
(UCHAR(*((src) - 1))) < 0x80 ? (src)-1 : \
Tcl_UtfPrev(src, start))
| < < < | 4480 4481 4482 4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 |
} while (0);
#define TclUtfPrev(src, start) \
(((src) < (start)+2) ? (start) : \
(UCHAR(*((src) - 1))) < 0x80 ? (src)-1 : \
Tcl_UtfPrev(src, start))
/*
*----------------------------------------------------------------
* Macro that encapsulates the logic that determines when it is safe to
* interpret a string as a byte array directly. In summary, the object must be
* a byte array and must not have a string representation (as the operations
* that it is used in are defined on strings, not byte arrays). Theoretically
* it is possible to also be efficient in the case where the object's bytes
|
| ︙ | ︙ |
Changes to generic/tclProc.c.
| ︙ | ︙ | |||
118 119 120 121 122 123 124 |
int
Tcl_ProcObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
| | | 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 |
int
Tcl_ProcObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
Proc *procPtr;
const char *procName;
const char *simpleName, *procArgs, *procBody;
Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
Tcl_Command cmd;
if (objc != 4) {
|
| ︙ | ︙ | |||
193 194 195 196 197 198 199 |
* this file. The differences are the different index of the body in the
* line array of the context, and the lambda code requires some special
* processing. Find a way to factor the common elements into a single
* function.
*/
if (iPtr->cmdFramePtr) {
| | > | 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 |
* this file. The differences are the different index of the body in the
* line array of the context, and the lambda code requires some special
* processing. Find a way to factor the common elements into a single
* function.
*/
if (iPtr->cmdFramePtr) {
CmdFrame *contextPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
*contextPtr = *iPtr->cmdFramePtr;
if (contextPtr->type == TCL_LOCATION_BC) {
/*
* Retrieve source information from the bytecode, if possible. If
* the information is retrieved successfully, context.type will be
* TCL_LOCATION_SOURCE and the reference held by
* context.data.eval.path will be counted.
*/
|
| ︙ | ︙ | |||
224 225 226 227 228 229 230 |
* proc body was not created by substitution.
*/
if (contextPtr->line
&& (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) {
int isNew;
Tcl_HashEntry *hePtr;
| | | | | 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 |
* proc body was not created by substitution.
*/
if (contextPtr->line
&& (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) {
int isNew;
Tcl_HashEntry *hePtr;
CmdFrame *cfPtr = (CmdFrame *)ckalloc(sizeof(CmdFrame));
cfPtr->level = -1;
cfPtr->type = contextPtr->type;
cfPtr->line = (int *)ckalloc(sizeof(int));
cfPtr->line[0] = contextPtr->line[3];
cfPtr->nline = 1;
cfPtr->framePtr = NULL;
cfPtr->nextPtr = NULL;
cfPtr->data.eval.path = contextPtr->data.eval.path;
Tcl_IncrRefCount(cfPtr->data.eval.path);
cfPtr->cmd = NULL;
cfPtr->len = 0;
hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
(char *)procPtr, &isNew);
if (!isNew) {
/*
* Get the old command frame and release it. See also
* TclProcCleanupProc in this file. Currently it seems as
* if only the procbodytest::proc command of the testsuite
* is able to trigger this situation.
*/
|
| ︙ | ︙ | |||
366 367 368 369 370 371 372 |
const char *procName, /* Unqualified name of this proc. */
Tcl_Obj *argsPtr, /* Description of arguments. */
Tcl_Obj *bodyPtr, /* Command body. */
Proc **procPtrPtr) /* Returns: pointer to proc data. */
{
Interp *iPtr = (Interp *) interp;
| | | | 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 |
const char *procName, /* Unqualified name of this proc. */
Tcl_Obj *argsPtr, /* Description of arguments. */
Tcl_Obj *bodyPtr, /* Command body. */
Proc **procPtrPtr) /* Returns: pointer to proc data. */
{
Interp *iPtr = (Interp *) interp;
Proc *procPtr;
int i, result, numArgs;
CompiledLocal *localPtr = NULL;
Tcl_Obj **argArray;
int precompiled = 0;
if (bodyPtr->typePtr == &tclProcBodyType) {
/*
* Because the body is a TclProProcBody, the actual body is already
* compiled, and it is not shared with anyone else, so it's OK not to
|
| ︙ | ︙ | |||
430 431 432 433 434 435 436 | * Create and initialize a Proc structure for the procedure. We * increment the ref count of the procedure's body object since there * will be a reference to it in the Proc structure. */ Tcl_IncrRefCount(bodyPtr); | | | | 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 |
* Create and initialize a Proc structure for the procedure. We
* increment the ref count of the procedure's body object since there
* will be a reference to it in the Proc structure.
*/
Tcl_IncrRefCount(bodyPtr);
procPtr = (Proc *)ckalloc(sizeof(Proc));
procPtr->iPtr = iPtr;
procPtr->refCount = 1;
procPtr->bodyPtr = bodyPtr;
procPtr->numArgs = 0; /* Actual argument count is set below. */
procPtr->numCompiledLocals = 0;
procPtr->firstLocalPtr = NULL;
procPtr->lastLocalPtr = NULL;
}
/*
* Break up the argument list into argument specifiers, then process each
* argument specifier. If the body is precompiled, processing is limited
* to checking that the parsed argument is consistent with the one stored
* in the Proc.
*/
result = Tcl_ListObjGetElements(interp, argsPtr, &numArgs, &argArray);
if (result != TCL_OK) {
goto procError;
}
if (precompiled) {
if (numArgs > procPtr->numArgs) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
| ︙ | ︙ | |||
469 470 471 472 473 474 475 |
localPtr = procPtr->firstLocalPtr;
} else {
procPtr->numArgs = numArgs;
procPtr->numCompiledLocals = numArgs;
}
for (i = 0; i < numArgs; i++) {
| | | 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 |
localPtr = procPtr->firstLocalPtr;
} else {
procPtr->numArgs = numArgs;
procPtr->numCompiledLocals = numArgs;
}
for (i = 0; i < numArgs; i++) {
const char *argname, *p, *last;
int fieldCount, nameLength;
Tcl_Obj **fieldValues;
/*
* Now divide the specifier up into name and default.
*/
|
| ︙ | ︙ | |||
500 501 502 503 504 505 506 | Tcl_SetObjResult(interp, Tcl_NewStringObj( "argument with no name", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC", "FORMALARGUMENTFORMAT", NULL); goto procError; } | < < | | | | | | < > | 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 |
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument with no name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
/*
* Check that the formal parameter name is a scalar.
*/
p = argname = Tcl_GetStringFromObj(fieldValues[0], &nameLength);
last = argname + nameLength;
while (p < last) {
if (*p == '(') {
if (last[-1] == ')') { /* We have an array element. */
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"formal parameter \"%s\" is an array element",
Tcl_GetString(fieldValues[0])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
} else if (p[0] == ':' && p[1] == ':') {
Tcl_Obj *errorObj = Tcl_NewStringObj(
"formal parameter \"", -1);
Tcl_AppendObjToObj(errorObj, fieldValues[0]);
Tcl_AppendToObj(errorObj, "\" is not a simple name", -1);
Tcl_SetObjResult(interp, errorObj);
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
"FORMALARGUMENTFORMAT", NULL);
goto procError;
}
p++;
}
if (precompiled) {
/*
* Compare the parsed argument with the stored one. Note that the
* only flag value that makes sense at this point is VAR_ARGUMENT
* (its value was kept the same as pre VarReform to simplify
|
| ︙ | ︙ | |||
596 597 598 599 600 601 602 |
localPtr = localPtr->nextPtr;
} else {
/*
* Allocate an entry in the runtime procedure frame's array of
* local variables for the argument.
*/
| > | | 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 |
localPtr = localPtr->nextPtr;
} else {
/*
* Allocate an entry in the runtime procedure frame's array of
* local variables for the argument.
*/
localPtr = (CompiledLocal *)ckalloc(
TclOffset(CompiledLocal, name) + fieldValues[0]->length +1);
if (procPtr->firstLocalPtr == NULL) {
procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
} else {
procPtr->lastLocalPtr->nextPtr = localPtr;
procPtr->lastLocalPtr = localPtr;
}
localPtr->nextPtr = NULL;
|
| ︙ | ︙ | |||
680 681 682 683 684 685 686 |
int
TclGetFrame(
Tcl_Interp *interp, /* Interpreter in which to find frame. */
const char *name, /* String describing frame. */
CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
* global frame indicated). */
{
| | | 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 |
int
TclGetFrame(
Tcl_Interp *interp, /* Interpreter in which to find frame. */
const char *name, /* String describing frame. */
CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
* global frame indicated). */
{
Interp *iPtr = (Interp *) interp;
int curLevel, level, result;
CallFrame *framePtr;
/*
* Parse string to figure out which level number to go to.
*/
|
| ︙ | ︙ | |||
764 765 766 767 768 769 770 |
int
TclObjGetFrame(
Tcl_Interp *interp, /* Interpreter in which to find frame. */
Tcl_Obj *objPtr, /* Object describing frame. */
CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
* global frame indicated). */
{
| | | 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 |
int
TclObjGetFrame(
Tcl_Interp *interp, /* Interpreter in which to find frame. */
Tcl_Obj *objPtr, /* Object describing frame. */
CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
* global frame indicated). */
{
Interp *iPtr = (Interp *) interp;
int curLevel, level, result;
const char *name = NULL;
/*
* Parse object to figure out which level number to go to.
*/
|
| ︙ | ︙ | |||
891 892 893 894 895 896 897 |
TclNRUplevelObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
| | | 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 |
TclNRUplevelObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Interp *iPtr = (Interp *) interp;
CmdFrame *invoker = NULL;
int word = 0;
int result;
CallFrame *savedVarFramePtr, *framePtr;
Tcl_Obj *objPtr;
if (objc < 2) {
|
| ︙ | ︙ | |||
1031 1032 1033 1034 1035 1036 1037 |
static int
ProcWrongNumArgs(
Tcl_Interp *interp,
int skip)
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
| | | | | 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 |
static int
ProcWrongNumArgs(
Tcl_Interp *interp,
int skip)
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
Proc *procPtr = framePtr->procPtr;
int localCt = procPtr->numCompiledLocals, numArgs, i;
Tcl_Obj **desiredObjs;
const char *final = NULL;
/*
* Build up desired argument list for Tcl_WrongNumArgs
*/
numArgs = framePtr->procPtr->numArgs;
desiredObjs = (Tcl_Obj **)TclStackAlloc(interp,
(int) sizeof(Tcl_Obj *) * (numArgs+1));
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
} else {
#ifdef AVOID_HACKS_FOR_ITCL
desiredObjs[0] = framePtr->objv[skip-1];
#else
desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1);
#endif /* AVOID_HACKS_FOR_ITCL */
}
Tcl_IncrRefCount(desiredObjs[0]);
if (localCt > 0) {
Var *defPtr = (Var *)(&framePtr->localCachePtr->varName0 + localCt);
for (i=1 ; i<=numArgs ; i++, defPtr++) {
Tcl_Obj *argObj;
Tcl_Obj *namePtr = localName(framePtr, i-1);
if (defPtr->value.objPtr != NULL) {
TclNewObj(argObj);
|
| ︙ | ︙ | |||
1247 1248 1249 1250 1251 1252 1253 |
/*
* Now invoke the resolvers to determine the exact variables that
* should be used.
*/
resVarInfo = localPtr->resolveInfo;
if (resVarInfo && resVarInfo->fetchProc) {
| | | 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 |
/*
* Now invoke the resolvers to determine the exact variables that
* should be used.
*/
resVarInfo = localPtr->resolveInfo;
if (resVarInfo && resVarInfo->fetchProc) {
Var *resolvedVarPtr = (Var *)
resVarInfo->fetchProc(interp, resVarInfo);
if (resolvedVarPtr) {
if (TclIsVarInHash(resolvedVarPtr)) {
VarHashRefCount(resolvedVarPtr)++;
}
varPtr->flags = VAR_LINK;
|
| ︙ | ︙ | |||
1270 1271 1272 1273 1274 1275 1276 |
Tcl_Interp *interp,
LocalCache *localCachePtr)
{
int i;
Tcl_Obj **namePtrPtr = &localCachePtr->varName0;
for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) {
| | | 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 |
Tcl_Interp *interp,
LocalCache *localCachePtr)
{
int i;
Tcl_Obj **namePtrPtr = &localCachePtr->varName0;
for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) {
Tcl_Obj *objPtr = *namePtrPtr;
if (objPtr) {
/* TclReleaseLiteral calls Tcl_DecrRefCount for us */
TclReleaseLiteral(interp, objPtr);
}
}
ckfree(localCachePtr);
|
| ︙ | ︙ | |||
1354 1355 1356 1357 1358 1359 1360 | * are being referenced at runtime. * *---------------------------------------------------------------------- */ static int InitArgsAndLocals( | | | | | 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 |
* are being referenced at runtime.
*
*----------------------------------------------------------------------
*/
static int
InitArgsAndLocals(
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
Tcl_Obj *procNameObj, /* Procedure name for error reporting. */
int skip) /* Number of initial arguments to be skipped,
* i.e., words in the "command name". */
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
Proc *procPtr = framePtr->procPtr;
ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
Var *varPtr, *defPtr;
int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
Tcl_Obj *const *argObjs;
/*
* Make sure that the local cache of variable names and initial values has
* been initialised properly .
*/
|
| ︙ | ︙ | |||
1389 1390 1391 1392 1393 1394 1395 |
/*
* Create the "compiledLocals" array. Make sure it is large enough to hold
* all the procedure's compiled local variables, including its formal
* parameters.
*/
| | | 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 |
/*
* Create the "compiledLocals" array. Make sure it is large enough to hold
* all the procedure's compiled local variables, including its formal
* parameters.
*/
varPtr = TclStackAlloc(interp, localCt * sizeof(Var));
framePtr->compiledLocals = varPtr;
framePtr->numCompiledLocals = localCt;
/*
* Match and assign the call's actual parameters to the procedure's formal
* arguments. The formal arguments are described by the first numArgs
* entries in both the Proc structure's local variable list and the call
|
| ︙ | ︙ | |||
1519 1520 1521 1522 1523 1524 1525 |
*----------------------------------------------------------------------
*/
int
TclPushProcCallFrame(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
| | | 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 |
*----------------------------------------------------------------------
*/
int
TclPushProcCallFrame(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
int objc, /* Count of number of arguments to this
* procedure. */
Tcl_Obj *const objv[], /* Argument value objects. */
int isLambda) /* 1 if this is a call by ApplyObjCmd: it
* needs special rules for error msg */
{
|
| ︙ | ︙ | |||
1611 1612 1613 1614 1615 1616 1617 |
*----------------------------------------------------------------------
*/
int
TclObjInterpProc(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
| | | | 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 |
*----------------------------------------------------------------------
*/
int
TclObjInterpProc(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
int objc, /* Count of number of arguments to this
* procedure. */
Tcl_Obj *const objv[]) /* Argument value objects. */
{
/*
* Not used much in the core; external interface for iTcl
*/
return Tcl_NRCallObjProc(interp, TclNRInterpProc, clientData, objc, objv);
}
int
TclNRInterpProc(
ClientData clientData, /* Record describing procedure to be
* interpreted. */
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
int objc, /* Count of number of arguments to this
* procedure. */
Tcl_Obj *const objv[]) /* Argument value objects. */
{
int result = TclPushProcCallFrame(clientData, interp, objc, objv,
/*isLambda*/ 0);
|
| ︙ | ︙ | |||
1663 1664 1665 1666 1667 1668 1669 | * Nearly anything; depends on the commands in the procedure body. * *---------------------------------------------------------------------- */ int TclNRInterpProcCore( | | | | | | 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 |
* Nearly anything; depends on the commands in the procedure body.
*
*----------------------------------------------------------------------
*/
int
TclNRInterpProcCore(
Tcl_Interp *interp,/* Interpreter in which procedure was
* invoked. */
Tcl_Obj *procNameObj, /* Procedure name for error reporting. */
int skip, /* Number of initial arguments to be skipped,
* i.e., words in the "command name". */
ProcErrorProc *errorProc) /* How to convert results from the script into
* results of the overall procedure. */
{
Interp *iPtr = (Interp *) interp;
Proc *procPtr = iPtr->varFramePtr->procPtr;
int result;
CallFrame *freePtr;
ByteCode *codePtr;
result = InitArgsAndLocals(interp, procNameObj, skip);
if (result != TCL_OK) {
freePtr = iPtr->framePtr;
Tcl_PopCallFrame(interp); /* Pop but do not free. */
TclStackFree(interp, freePtr->compiledLocals);
/* Free compiledLocals. */
TclStackFree(interp, freePtr); /* Free CallFrame. */
return TCL_ERROR;
}
#if defined(TCL_COMPILE_DEBUG)
if (tclTraceExec >= 1) {
CallFrame *framePtr = iPtr->varFramePtr;
int i;
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
fprintf(stdout, "Calling lambda ");
} else {
fprintf(stdout, "Calling proc ");
}
for (i = 0; i < framePtr->objc; i++) {
|
| ︙ | ︙ | |||
2103 2104 2105 2106 2107 2108 2109 | * Memory gets freed. * *---------------------------------------------------------------------- */ void TclProcCleanupProc( | | | | 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 |
* Memory gets freed.
*
*----------------------------------------------------------------------
*/
void
TclProcCleanupProc(
Proc *procPtr) /* Procedure to be deleted. */
{
CompiledLocal *localPtr;
Tcl_Obj *bodyPtr = procPtr->bodyPtr;
Tcl_Obj *defPtr;
Tcl_ResolvedVarInfo *resVarInfo;
Tcl_HashEntry *hePtr = NULL;
CmdFrame *cfPtr = NULL;
Interp *iPtr = procPtr->iPtr;
|
| ︙ | ︙ | |||
2152 2153 2154 2155 2156 2157 2158 |
}
hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);
if (!hePtr) {
return;
}
| | | 2152 2153 2154 2155 2156 2157 2158 2159 2160 2161 2162 2163 2164 2165 2166 |
}
hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);
if (!hePtr) {
return;
}
cfPtr = (CmdFrame *) Tcl_GetHashValue(hePtr);
if (cfPtr) {
if (cfPtr->type == TCL_LOCATION_SOURCE) {
Tcl_DecrRefCount(cfPtr->data.eval.path);
cfPtr->data.eval.path = NULL;
}
ckfree(cfPtr->line);
|
| ︙ | ︙ | |||
2356 2357 2358 2359 2360 2361 2362 |
*
*----------------------------------------------------------------------
*/
static void
DupLambdaInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
| | | | | 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 |
*
*----------------------------------------------------------------------
*/
static void
DupLambdaInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1;
Tcl_Obj *nsObjPtr = srcPtr->internalRep.twoPtrValue.ptr2;
copyPtr->internalRep.twoPtrValue.ptr1 = procPtr;
copyPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
procPtr->refCount++;
Tcl_IncrRefCount(nsObjPtr);
copyPtr->typePtr = &tclLambdaType;
}
static void
FreeLambdaInternalRep(
Tcl_Obj *objPtr) /* CmdName object with internal representation
* to free. */
{
Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2;
if (procPtr->refCount-- == 1) {
TclProcCleanupProc(procPtr);
}
TclDecrRefCount(nsObjPtr);
objPtr->typePtr = NULL;
}
static int
SetLambdaFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr) /* The object to convert. */
{
Interp *iPtr = (Interp *) interp;
const char *name;
Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv;
int isNew, objc, result;
CmdFrame *cfPtr = NULL;
Proc *procPtr;
|
| ︙ | ︙ |
Changes to generic/tclTest.c.
| ︙ | ︙ | |||
6757 6758 6759 6760 6761 6762 6763 |
if (!Tcl_UtfCharComplete(buffer + 1, offset)) {
/* Cannot scan a complete sequence from the data */
Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
return TCL_OK;
}
| | | | | 6757 6758 6759 6760 6761 6762 6763 6764 6765 6766 6767 6768 6769 6770 6771 6772 6773 6774 6775 6776 6777 6778 6779 6780 6781 6782 6783 |
if (!Tcl_UtfCharComplete(buffer + 1, offset)) {
/* Cannot scan a complete sequence from the data */
Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
return TCL_OK;
}
first = result = Tcl_UtfNext(buffer + 1);
while ((buffer[0] = *p++) != '\0') {
/* Run Tcl_UtfNext with many more possible bytes at src[-1], all should give the same result */
result = Tcl_UtfNext(buffer + 1);
if (first != result) {
Tcl_AppendResult(interp, "Tcl_UtfNext is not supposed to read src[-1]", NULL);
return TCL_ERROR;
}
}
p = tobetested;
while ((buffer[numBytes + 1] = *p++) != '\0') {
/* Run Tcl_UtfNext with many more possible bytes at src[end], all should give the same result */
result = Tcl_UtfNext(buffer + 1);
if (first != result) {
first = buffer;
break;
}
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(first - buffer - 1));
|
| ︙ | ︙ |
Changes to generic/tclUtil.c.
| ︙ | ︙ | |||
1849 1850 1851 1852 1853 1854 1855 1856 |
/* When bytes is NUL-terminated, returns 0 <= trimLeft <= numBytes */
trimLeft = TclTrimLeft(bytes, numBytes, trim, numTrim);
numBytes -= trimLeft;
/* If we did not trim the whole string, it starts with a character
* that we will not trim. Skip over it. */
if (numBytes > 0) {
const char *first = bytes + trimLeft;
| > | | 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 |
/* When bytes is NUL-terminated, returns 0 <= trimLeft <= numBytes */
trimLeft = TclTrimLeft(bytes, numBytes, trim, numTrim);
numBytes -= trimLeft;
/* If we did not trim the whole string, it starts with a character
* that we will not trim. Skip over it. */
if (numBytes > 0) {
int ch;
const char *first = bytes + trimLeft;
bytes += TclUtfToUCS4(first, &ch);
numBytes -= (bytes - first);
if (numBytes > 0) {
/* When bytes is NUL-terminated, returns
* 0 <= trimRight <= numBytes */
trimRight = TclTrimRight(bytes, numBytes, trim, numTrim);
}
|
| ︙ | ︙ | |||
3709 3710 3711 3712 3713 3714 3715 | * object that already has a valid string rep, it will leak memory. * *---------------------------------------------------------------------- */ static void UpdateStringOfEndOffset( | | | | 3710 3711 3712 3713 3714 3715 3716 3717 3718 3719 3720 3721 3722 3723 3724 3725 3726 3727 |
* object that already has a valid string rep, it will leak memory.
*
*----------------------------------------------------------------------
*/
static void
UpdateStringOfEndOffset(
Tcl_Obj *objPtr)
{
char buffer[TCL_INTEGER_SPACE + 5];
int len = 3;
memcpy(buffer, "end", 4);
if (objPtr->internalRep.longValue != 0) {
buffer[len++] = '-';
len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue));
}
objPtr->bytes = (char *)ckalloc(len+1);
|
| ︙ | ︙ | |||
3783 3784 3785 3786 3787 3788 3789 |
static int
SetEndOffsetFromAny(
Tcl_Interp *interp, /* Tcl interpreter or NULL */
Tcl_Obj *objPtr) /* Pointer to the object to parse */
{
int offset; /* Offset in the "end-offset" expression */
| | | 3784 3785 3786 3787 3788 3789 3790 3791 3792 3793 3794 3795 3796 3797 3798 |
static int
SetEndOffsetFromAny(
Tcl_Interp *interp, /* Tcl interpreter or NULL */
Tcl_Obj *objPtr) /* Pointer to the object to parse */
{
int offset; /* Offset in the "end-offset" expression */
const char *bytes; /* String rep of the object */
int length; /* Length of the object's string rep */
/*
* If it's already the right type, we're fine.
*/
if (objPtr->typePtr == &tclEndOffsetType) {
|
| ︙ | ︙ |