Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | merge trunk |
|---|---|
| Timelines: | family | ancestors | descendants | both | novem |
| Files: | files | file ages | folders |
| SHA1: |
ce8eb2a4dd5d246b7dcce91f0f297f1d |
| User & Date: | dgp 2014-12-23 15:19:12.249 |
Context
|
2014-12-23
| ||
| 18:44 | merge trunk check-in: 526ce54517 user: dgp tags: novem | |
| 15:37 | merge novem check-in: 37e28f586b user: dgp tags: dgp-refactor | |
| 15:19 | merge trunk check-in: ce8eb2a4dd user: dgp tags: novem | |
| 02:41 | Use more suitable variable name pushers. check-in: d9a4be6a30 user: dgp tags: trunk | |
|
2014-12-15
| ||
| 10:23 | merge trunk (but 86 -> 90) check-in: ba65c384d5 user: jan.nijtmans tags: novem | |
Changes
Changes to changes.
| ︙ | ︙ | |||
8487 8488 8489 8490 8491 8492 8493 | 2014-10-31 (bug)[dcc034] restore [open comX: r+] (lll,nijtmans) 2014-11-05 (bug)[214cc0] Restore [lappend v] return value (sayers,porter) 2014-11-06 (bug)[5adc35] Stop forcing EOF to be permanent (porter) --- Released 8.6.3, November 12, 2014 --- http://core.tcl.tk/tcl/ for details | > > | 8487 8488 8489 8490 8491 8492 8493 8494 8495 | 2014-10-31 (bug)[dcc034] restore [open comX: r+] (lll,nijtmans) 2014-11-05 (bug)[214cc0] Restore [lappend v] return value (sayers,porter) 2014-11-06 (bug)[5adc35] Stop forcing EOF to be permanent (porter) --- Released 8.6.3, November 12, 2014 --- http://core.tcl.tk/tcl/ for details 2014-12-17 (TIP 427) [fconfigure $h -connecting, -peername, -sockname] (oehlmann,rmax) |
Changes to doc/socket.n.
| ︙ | ︙ | |||
93 94 95 96 97 98 99 100 101 102 103 104 105 106 | The Tcl event loop should be running while an asynchronous connection is in progress, because it may have to do several connection attempts in the background. Running the event loop also allows you to set up a writable channel event on the socket to get notified when the asynchronous connection has succeeded or failed. See the \fBvwait\fR and the \fBchan\fR commands for more details on the event loop and channel events. .RE .SH "SERVER SOCKETS" .PP If the \fB\-server\fR option is specified then the new socket will be a server that listens on the given \fIport\fR (either an integer or a service name, where supported and understood by the host operating system; if \fIport\fR is zero, the operating system will allocate a | > > > > | 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 | The Tcl event loop should be running while an asynchronous connection is in progress, because it may have to do several connection attempts in the background. Running the event loop also allows you to set up a writable channel event on the socket to get notified when the asynchronous connection has succeeded or failed. See the \fBvwait\fR and the \fBchan\fR commands for more details on the event loop and channel events. .PP The \fBchan configure\fR option \fB-connecting\fR may be used to check if the connect is still running. To verify a successful connect, the option \fB-error\fR may be checked when \fB-connecting\fR returned 0. .PP Operation without the event queue requires at the moment calls to \fBchan configure\fR to advance the internal state machine. .RE .SH "SERVER SOCKETS" .PP If the \fB\-server\fR option is specified then the new socket will be a server that listens on the given \fIport\fR (either an integer or a service name, where supported and understood by the host operating system; if \fIport\fR is zero, the operating system will allocate a |
| ︙ | ︙ | |||
182 183 184 185 186 187 188 189 190 191 192 193 194 195 |
\fB\-peername\fR
.
This option is not supported by server sockets. For client and accepted
sockets, this option returns a list of three elements; these are the
address, the host name and the port to which the peer socket is connected
or bound. If the host name cannot be computed, the second element of the
list is identical to the address, its first element.
.PP
.SH "EXAMPLES"
.PP
Here is a very simple time server:
.PP
.CS
proc Server {startTime channel clientaddr clientport} {
| > > > > > | 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 |
\fB\-peername\fR
.
This option is not supported by server sockets. For client and accepted
sockets, this option returns a list of three elements; these are the
address, the host name and the port to which the peer socket is connected
or bound. If the host name cannot be computed, the second element of the
list is identical to the address, its first element.
.RE
.TP
\fB\-connecting\fR
.
This option is not supported by server sockets. For client sockets, this option returns 1 if an asyncroneous connect is still in progress, 0 otherwise.
.PP
.SH "EXAMPLES"
.PP
Here is a very simple time server:
.PP
.CS
proc Server {startTime channel clientaddr clientport} {
|
| ︙ | ︙ |
Changes to generic/tclCompCmds.c.
| ︙ | ︙ | |||
173 174 175 176 177 178 179 |
appendMultiple:
/*
* Can only handle the case where we are appending to a local scalar when
* there are multiple values to append. Fortunately, this is common.
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
| | | | | 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 |
appendMultiple:
/*
* Can only handle the case where we are appending to a local scalar when
* there are multiple values to append. Fortunately, this is common.
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
localIndex = LocalScalarFromToken(varTokenPtr, envPtr);
if (localIndex < 0) {
return TCL_ERROR;
}
/*
* Definitely appending to a local scalar; generate the words and append
* them.
*/
|
| ︙ | ︙ | |||
2523 2524 2525 2526 2527 2528 2529 |
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;
| | | > < < < < < < < < < | 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545 2546 |
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;
DefineLineInformation; /* TIP #280 */
/*
* If the foreach command isn't in a procedure, don't compile it inline:
* the payoff is too small.
*/
if (procPtr == NULL) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
2569 2570 2571 2572 2573 2574 2575 |
}
bodyTokenPtr = tokenPtr;
if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
}
/*
| | > > | | < | < | | | > < < < | < < > > | | < < < | | | > > > > > < < < < < < < < < < < > | > > > | > > < > < < < < < < < < < < < < < < < < < < < < < < < < < < < | 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 |
}
bodyTokenPtr = tokenPtr;
if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
}
/*
* Create and initialize the ForeachInfo and ForeachVarList data
* structures describing this command. Then create a AuxData record
* pointing to the ForeachInfo structure.
*/
numLists = (numWords - 2)/2;
infoPtr = ckalloc(sizeof(ForeachInfo)
+ (numLists - 1) * sizeof(ForeachVarList *));
infoPtr->numLists = 0; /* Count this up as we go */
/*
* Parse each var list into sequence of var names. Don't
* compile the foreach inline if any var name needs substitutions or isn't
* a scalar, or if any var list needs substitutions.
*/
varListObj = Tcl_NewObj();
for (i = 0, tokenPtr = parsePtr->tokenPtr;
i < numWords-1;
i++, tokenPtr = TokenAfter(tokenPtr)) {
ForeachVarList *varListPtr;
int numVars;
if (i%2 != 1) {
continue;
}
/*
* If the variable list is empty, we can enter an infinite loop when
* the interpreted version would not. Take care to ensure this does
* not happen. [Bug 1671138]
*/
if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
numVars == 0) {
code = TCL_ERROR;
goto done;
}
varListPtr = ckalloc(sizeof(ForeachVarList)
+ (numVars - 1) * sizeof(int));
varListPtr->numVars = numVars;
infoPtr->varLists[i/2] = varListPtr;
infoPtr->numLists++;
for (j = 0; j < numVars; j++) {
Tcl_Obj *varNameObj;
const char *bytes;
int numBytes, varIndex;
Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
varIndex = LocalScalar(bytes, numBytes, envPtr);
if (varIndex < 0) {
code = TCL_ERROR;
goto done;
}
varListPtr->varIndexes[j] = varIndex;
}
Tcl_SetObjLength(varListObj, 0);
}
/*
* We will compile the foreach command.
*/
infoIndex = TclCreateAuxData(infoPtr, &tclNewForeachInfoType, envPtr);
/*
* Create the collecting object, unshared.
*/
if (collect == TCL_EACH_COLLECT) {
|
| ︙ | ︙ | |||
2739 2740 2741 2742 2743 2744 2745 |
*/
if (collect != TCL_EACH_COLLECT) {
PushStringLiteral(envPtr, "");
}
done:
| | | | | | > | 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 |
*/
if (collect != TCL_EACH_COLLECT) {
PushStringLiteral(envPtr, "");
}
done:
if (code == TCL_ERROR) {
if (infoPtr) {
FreeForeachInfo(infoPtr);
}
}
if (varListObj) {
Tcl_DecrRefCount(varListObj);
}
return code;
}
/*
*----------------------------------------------------------------------
*
* DupForeachInfo --
|
| ︙ | ︙ | |||
3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 |
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclPushVarName --
*
* Procedure used in the compiling where pushing a variable name is
* necessary (append, lappend, set).
*
* Results:
* The values written to *localIndexPtr and *isScalarPtr signal to
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 3216 3217 3218 3219 3220 3221 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 |
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclLocalScalarFromToken --
*
* Get the index into the table of compiled locals that corresponds
* to a local scalar variable name.
*
* Results:
* Returns the non-negative integer index value into the table of
* compiled locals corresponding to a local scalar variable name.
* If the arguments passed in do not identify a local scalar variable
* then return -1.
*
* Side effects:
* May add an entery into the table of compiled locals.
*
*----------------------------------------------------------------------
*/
int
TclLocalScalarFromToken(
Tcl_Token *tokenPtr,
CompileEnv *envPtr)
{
int isScalar, index;
TclPushVarName(NULL, tokenPtr, envPtr, TCL_NO_ELEMENT, &index, &isScalar);
if (!isScalar) {
index = -1;
}
return index;
}
int
TclLocalScalar(
const char *bytes,
int numBytes,
CompileEnv *envPtr)
{
Tcl_Token token[2] = {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
{TCL_TOKEN_TEXT, NULL, 0, 0}};
token[1].start = bytes;
token[1].size = numBytes;
return TclLocalScalarFromToken(token, envPtr);
}
/*
*----------------------------------------------------------------------
*
* TclPushVarName --
*
* Procedure used in the compiling where pushing a variable name is
* necessary (append, lappend, set).
*
* Results:
* The values written to *localIndexPtr and *isScalarPtr signal to
|
| ︙ | ︙ | |||
3309 3310 3311 3312 3313 3314 3315 | elName = p + 1; elNameChars = nameChars - i - 2; nameChars = i; break; } } | | | | 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 |
elName = p + 1;
elNameChars = nameChars - i - 2;
nameChars = i;
break;
}
}
if (!(flags & TCL_NO_ELEMENT) && (elName != NULL) && elNameChars) {
/*
* An array element, the element name is a simple string:
* assemble the corresponding token.
*/
elemTokenPtr = TclStackAlloc(interp, sizeof(Tcl_Token));
allocedTokens = 1;
elemTokenPtr->type = TCL_TOKEN_TEXT;
elemTokenPtr->start = elName;
elemTokenPtr->size = elNameChars;
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.
*/
|
| ︙ | ︙ | |||
3362 3363 3364 3365 3366 3367 3368 | name = varTokenPtr[1].start; nameChars = p - varTokenPtr[1].start; elName = p + 1; remainingChars = (varTokenPtr[2].start - p) - 1; elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1; | > | | > | 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 3409 3410 3411 3412 3413 |
name = varTokenPtr[1].start;
nameChars = p - varTokenPtr[1].start;
elName = p + 1;
remainingChars = (varTokenPtr[2].start - p) - 1;
elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1;
if (!(flags & TCL_NO_ELEMENT)) {
if (remainingChars) {
/*
* Make a first token with the extra characters in the first
* token.
*/
elemTokenPtr = TclStackAlloc(interp, n * sizeof(Tcl_Token));
allocedTokens = 1;
elemTokenPtr->type = TCL_TOKEN_TEXT;
elemTokenPtr->start = elName;
elemTokenPtr->size = remainingChars;
elemTokenPtr->numComponents = 0;
elemTokenCount = n;
/*
* Copy the remaining tokens.
*/
memcpy(elemTokenPtr+1, varTokenPtr+2,
(n-1) * sizeof(Tcl_Token));
} else {
/*
* Use the already available tokens.
*/
elemTokenPtr = &varTokenPtr[2];
elemTokenCount = n - 1;
}
}
}
}
if (simpleVarName) {
/*
* See whether name has any namespace separators (::'s).
|
| ︙ | ︙ | |||
3423 3424 3425 3426 3427 3428 3429 | /* * We'll push the name. */ localIndex = -1; } } | | | | 3434 3435 3436 3437 3438 3439 3440 3441 3442 3443 3444 3445 3446 3447 3448 3449 3450 3451 3452 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 |
/*
* We'll push the name.
*/
localIndex = -1;
}
}
if (interp && localIndex < 0) {
PushLiteral(envPtr, name, nameChars);
}
/*
* Compile the element script, if any, and only if not inhibited. [Bug
* 3600328]
*/
if (elName != NULL && !(flags & TCL_NO_ELEMENT)) {
if (elNameChars) {
TclCompileTokens(interp, elemTokenPtr, elemTokenCount,
envPtr);
} else {
PushStringLiteral(envPtr, "");
}
}
} else if (interp) {
/*
* The var name isn't simple: compile and push it.
*/
CompileTokens(envPtr, varTokenPtr, interp);
}
|
| ︙ | ︙ |
Changes to generic/tclCompCmdsGR.c.
| ︙ | ︙ | |||
2040 2041 2042 2043 2044 2045 2046 |
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;
| | | 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 |
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;
DefineLineInformation; /* TIP #280 */
if (envPtr->procPtr == NULL) {
return TCL_ERROR;
}
/*
|
| ︙ | ︙ | |||
2075 2076 2077 2078 2079 2080 2081 |
localTokenPtr = tokenPtr;
for (i=2; i<numWords; i+=2) {
otherTokenPtr = TokenAfter(localTokenPtr);
localTokenPtr = TokenAfter(otherTokenPtr);
CompileWord(envPtr, otherTokenPtr, interp, i);
| < < | | | 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 |
localTokenPtr = tokenPtr;
for (i=2; i<numWords; i+=2) {
otherTokenPtr = TokenAfter(localTokenPtr);
localTokenPtr = TokenAfter(otherTokenPtr);
CompileWord(envPtr, otherTokenPtr, interp, i);
localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
if (localIndex < 0) {
return TCL_ERROR;
}
TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
}
/*
* Pop the namespace, and set the result to empty
|
| ︙ | ︙ | |||
2759 2760 2761 2762 2763 2764 2765 |
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;
| | | 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 |
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;
DefineLineInformation; /* TIP #280 */
Tcl_Obj *objPtr;
if (envPtr->procPtr == NULL) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
2822 2823 2824 2825 2826 2827 2828 |
* be called at runtime.
*/
for (; i<numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) {
localTokenPtr = TokenAfter(otherTokenPtr);
CompileWord(envPtr, otherTokenPtr, interp, i);
| < < | | | 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 |
* be called at runtime.
*/
for (; i<numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) {
localTokenPtr = TokenAfter(otherTokenPtr);
CompileWord(envPtr, otherTokenPtr, interp, i);
localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
if (localIndex < 0) {
return TCL_ERROR;
}
TclEmitInstInt4( INST_UPVAR, localIndex, envPtr);
}
/*
* Pop the frame index, and set the result to empty
|
| ︙ | ︙ |
Changes to generic/tclCompile.h.
| ︙ | ︙ | |||
1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 | ExceptionAux *auxPtr); MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr, int range); #ifdef TCL_COMPILE_STATS MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr); MODULE_SCOPE int TclLog2(int value); #endif MODULE_SCOPE void TclOptimizeBytecode(void *envPtr); #ifdef TCL_COMPILE_DEBUG MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr); #endif MODULE_SCOPE int TclPrintInstruction(ByteCode *codePtr, const unsigned char *pc); | > > > > | 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 | ExceptionAux *auxPtr); MODULE_SCOPE void TclFinalizeLoopExceptionRange(CompileEnv *envPtr, int range); #ifdef TCL_COMPILE_STATS MODULE_SCOPE char * TclLiteralStats(LiteralTable *tablePtr); MODULE_SCOPE int TclLog2(int value); #endif MODULE_SCOPE int TclLocalScalar(const char *bytes, int numBytes, CompileEnv *envPtr); MODULE_SCOPE int TclLocalScalarFromToken(Tcl_Token *tokenPtr, CompileEnv *envPtr); MODULE_SCOPE void TclOptimizeBytecode(void *envPtr); #ifdef TCL_COMPILE_DEBUG MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr); #endif MODULE_SCOPE int TclPrintInstruction(ByteCode *codePtr, const unsigned char *pc); |
| ︙ | ︙ | |||
1674 1675 1676 1677 1678 1679 1680 |
* How to get an anonymous local variable (used for holding temporary values
* off the stack) or a local simple scalar.
*/
#define AnonymousLocal(envPtr) \
(TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, (envPtr)))
#define LocalScalar(chars,len,envPtr) \
| | < < | | 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 |
* How to get an anonymous local variable (used for holding temporary values
* off the stack) or a local simple scalar.
*/
#define AnonymousLocal(envPtr) \
(TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, (envPtr)))
#define LocalScalar(chars,len,envPtr) \
TclLocalScalar(chars, len, envPtr)
#define LocalScalarFromToken(tokenPtr,envPtr) \
TclLocalScalarFromToken(tokenPtr, envPtr)
/*
* Flags bits used by TclPushVarName.
*/
#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */
#define TCL_NO_ELEMENT 2 /* Do not push the array element. */
|
| ︙ | ︙ |
Changes to generic/tclEncoding.c.
| ︙ | ︙ | |||
176 177 178 179 180 181 182 | /* * The following are used to hold the default and current system encodings. * If NULL is passed to one of the conversion routines, the current setting of * the system encoding will be used to perform the conversion. */ | | | | | 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 | /* * The following are used to hold the default and current system encodings. * If NULL is passed to one of the conversion routines, the current setting of * the system encoding will be used to perform the conversion. */ static Tcl_Encoding defaultEncoding = NULL; static Tcl_Encoding systemEncoding = NULL; Tcl_Encoding tclIdentityEncoding = NULL; /* * The following variable is used in the sparse matrix code for a * TableEncoding to represent a page in the table that has no entries. */ static unsigned short emptyPage[256]; |
| ︙ | ︙ | |||
648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 |
{
Tcl_HashSearch search;
Tcl_HashEntry *hPtr;
Tcl_MutexLock(&encodingMutex);
encodingsInitialized = 0;
FreeEncoding(systemEncoding);
FreeEncoding(tclIdentityEncoding);
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
while (hPtr != NULL) {
/*
* Call FreeEncoding instead of doing it directly to handle refcounts
* like escape encodings use. [Bug 524674] Make sure to call
* Tcl_FirstHashEntry repeatedly so that all encodings are eventually
| > > > | 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 |
{
Tcl_HashSearch search;
Tcl_HashEntry *hPtr;
Tcl_MutexLock(&encodingMutex);
encodingsInitialized = 0;
FreeEncoding(systemEncoding);
systemEncoding = NULL;
defaultEncoding = NULL;
FreeEncoding(tclIdentityEncoding);
tclIdentityEncoding = NULL;
hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
while (hPtr != NULL) {
/*
* Call FreeEncoding instead of doing it directly to handle refcounts
* like escape encodings use. [Bug 524674] Make sure to call
* Tcl_FirstHashEntry repeatedly so that all encodings are eventually
|
| ︙ | ︙ | |||
2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 |
TableEncodingData *dataPtr = clientData;
/*
* Make sure we aren't freeing twice on shutdown. [Bug 219314]
*/
ckfree(dataPtr->toUnicode);
ckfree(dataPtr->fromUnicode);
ckfree(dataPtr);
}
/*
*-------------------------------------------------------------------------
*
* EscapeToUtfProc --
| > > | 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 |
TableEncodingData *dataPtr = clientData;
/*
* Make sure we aren't freeing twice on shutdown. [Bug 219314]
*/
ckfree(dataPtr->toUnicode);
dataPtr->toUnicode = NULL;
ckfree(dataPtr->fromUnicode);
dataPtr->fromUnicode = NULL;
ckfree(dataPtr);
}
/*
*-------------------------------------------------------------------------
*
* EscapeToUtfProc --
|
| ︙ | ︙ | |||
3367 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 |
* as a "not in finalization" test.
*/
if (encodingsInitialized) {
subTablePtr = dataPtr->subTables;
for (i = 0; i < dataPtr->numSubTables; i++) {
FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
subTablePtr++;
}
}
ckfree(dataPtr);
}
/*
| > | 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 |
* as a "not in finalization" test.
*/
if (encodingsInitialized) {
subTablePtr = dataPtr->subTables;
for (i = 0; i < dataPtr->numSubTables; i++) {
FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
subTablePtr->encodingPtr = NULL;
subTablePtr++;
}
}
ckfree(dataPtr);
}
/*
|
| ︙ | ︙ |
Changes to generic/tclEvent.c.
| ︙ | ︙ | |||
115 116 117 118 119 120 121 122 123 124 125 126 127 128 | static void BgErrorDeleteProc(ClientData clientData, Tcl_Interp *interp); static void HandleBgErrors(ClientData clientData); static char * VwaitVarProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); static void InvokeExitHandlers(void); /* *---------------------------------------------------------------------- * * Tcl_BackgroundError -- * * This function is invoked to handle errors that occur in Tcl commands | > | 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | static void BgErrorDeleteProc(ClientData clientData, Tcl_Interp *interp); static void HandleBgErrors(ClientData clientData); static char * VwaitVarProc(ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); static void InvokeExitHandlers(void); static void FinalizeThread(int quick); /* *---------------------------------------------------------------------- * * Tcl_BackgroundError -- * * This function is invoked to handle errors that occur in Tcl commands |
| ︙ | ︙ | |||
979 980 981 982 983 984 985 | /* * Now finalize the calling thread only (others are not safely * reachable). Among other things, this triggers a flush of the * Tcl_Channels that may have data enqueued. */ | | | 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 |
/*
* Now finalize the calling thread only (others are not safely
* reachable). Among other things, this triggers a flush of the
* Tcl_Channels that may have data enqueued.
*/
FinalizeThread(/* quick */ 1);
}
TclpExit(status);
Tcl_Panic("OS exit failed!");
}
}
/*
|
| ︙ | ︙ | |||
1179 1180 1181 1182 1183 1184 1185 |
* important to note is that things happening afterwards should not
* reference anything which may re-initialize TSD's. This includes freeing
* Tcl_Objs's, among other things.
*
* This fixes the Tcl Bug #990552.
*/
| | | 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 |
* important to note is that things happening afterwards should not
* reference anything which may re-initialize TSD's. This includes freeing
* Tcl_Objs's, among other things.
*
* This fixes the Tcl Bug #990552.
*/
TclFinalizeThreadData(/* quick */ 0);
/*
* Now we can free constants for conversions to/from double.
*/
TclFinalizeDoubleConversion();
|
| ︙ | ︙ | |||
1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 |
* Varied, see the respective finalization routines.
*
*----------------------------------------------------------------------
*/
void
Tcl_FinalizeThread(void)
{
ExitHandler *exitPtr;
ThreadSpecificData *tsdPtr;
/*
* We use TclThreadDataKeyGet here, rather than Tcl_GetThreadData, because
* we don't want to initialize the data block if it hasn't been
| > > > > > > > | 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 |
* Varied, see the respective finalization routines.
*
*----------------------------------------------------------------------
*/
void
Tcl_FinalizeThread(void)
{
FinalizeThread(/* quick */ 0);
}
void
FinalizeThread(
int quick)
{
ExitHandler *exitPtr;
ThreadSpecificData *tsdPtr;
/*
* We use TclThreadDataKeyGet here, rather than Tcl_GetThreadData, because
* we don't want to initialize the data block if it hasn't been
|
| ︙ | ︙ | |||
1305 1306 1307 1308 1309 1310 1311 |
*
* Note that Tcl API allows creation of threads which do not use any Tcl
* interp or other Tcl subsytems. Those threads might, however, use thread
* local storage, so we must unconditionally finalize it.
*
* Fix [Bug #571002]
*/
| | | 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 |
*
* Note that Tcl API allows creation of threads which do not use any Tcl
* interp or other Tcl subsytems. Those threads might, however, use thread
* local storage, so we must unconditionally finalize it.
*
* Fix [Bug #571002]
*/
TclFinalizeThreadData(quick);
}
/*
*----------------------------------------------------------------------
*
* TclInExit --
*
|
| ︙ | ︙ |
Changes to generic/tclIO.c.
| ︙ | ︙ | |||
9158 9159 9160 9161 9162 9163 9164 9165 9166 9167 9168 9169 9170 9171 |
if (outStatePtr->outQueueTail) {
outStatePtr->outQueueTail->nextPtr = inStatePtr->inQueueHead;
} else {
outStatePtr->outQueueHead = inStatePtr->inQueueHead;
}
outStatePtr->outQueueTail = tail;
inStatePtr->inQueueHead = bufPtr;
if (bufPtr == NULL) {
inStatePtr->inQueueTail = NULL;
}
code = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
if (code) {
MBError(csPtr, TCL_WRITABLE, code);
| > > > | 9158 9159 9160 9161 9162 9163 9164 9165 9166 9167 9168 9169 9170 9171 9172 9173 9174 |
if (outStatePtr->outQueueTail) {
outStatePtr->outQueueTail->nextPtr = inStatePtr->inQueueHead;
} else {
outStatePtr->outQueueHead = inStatePtr->inQueueHead;
}
outStatePtr->outQueueTail = tail;
inStatePtr->inQueueHead = bufPtr;
if (inStatePtr->inQueueTail == tail) {
inStatePtr->inQueueTail = bufPtr;
}
if (bufPtr == NULL) {
inStatePtr->inQueueTail = NULL;
}
code = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
if (code) {
MBError(csPtr, TCL_WRITABLE, code);
|
| ︙ | ︙ |
Changes to generic/tclInt.h.
| ︙ | ︙ | |||
2878 2879 2880 2881 2882 2883 2884 | MODULE_SCOPE void TclFinalizeMemorySubsystem(void); MODULE_SCOPE void TclFinalizeNotifier(void); MODULE_SCOPE void TclFinalizeObjects(void); MODULE_SCOPE void TclFinalizePreserve(void); MODULE_SCOPE void TclFinalizeSynchronization(void); MODULE_SCOPE void TclFinalizeThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadAllocThread(void); | | | 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 | MODULE_SCOPE void TclFinalizeMemorySubsystem(void); MODULE_SCOPE void TclFinalizeNotifier(void); MODULE_SCOPE void TclFinalizeObjects(void); MODULE_SCOPE void TclFinalizePreserve(void); MODULE_SCOPE void TclFinalizeSynchronization(void); MODULE_SCOPE void TclFinalizeThreadAlloc(void); MODULE_SCOPE void TclFinalizeThreadAllocThread(void); MODULE_SCOPE void TclFinalizeThreadData(int quick); MODULE_SCOPE void TclFinalizeThreadObjects(void); MODULE_SCOPE double TclFloor(const mp_int *a); MODULE_SCOPE void TclFormatNaN(double value, char *buffer); MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr, const char *attributeName, int *indexPtr); MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *encodingName); |
| ︙ | ︙ | |||
2933 2934 2935 2936 2937 2938 2939 | MODULE_SCOPE void TclInitIOSubsystem(void); MODULE_SCOPE void TclInitLimitSupport(Tcl_Interp *interp); MODULE_SCOPE void TclInitNamespaceSubsystem(void); MODULE_SCOPE void TclInitNotifier(void); MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE void TclInitSubsystems(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); | < | 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 | MODULE_SCOPE void TclInitIOSubsystem(void); MODULE_SCOPE void TclInitLimitSupport(Tcl_Interp *interp); MODULE_SCOPE void TclInitNamespaceSubsystem(void); MODULE_SCOPE void TclInitNotifier(void); MODULE_SCOPE void TclInitObjSubsystem(void); MODULE_SCOPE void TclInitSubsystems(void); MODULE_SCOPE int TclInterpReady(Tcl_Interp *interp); MODULE_SCOPE int TclIsSpaceProc(char byte); MODULE_SCOPE int TclIsBareword(char byte); MODULE_SCOPE Tcl_Obj * TclJoinPath(int elements, Tcl_Obj * const objv[]); MODULE_SCOPE int TclJoinThread(Tcl_ThreadId id, int *result); MODULE_SCOPE void TclLimitRemoveAllHandlers(Tcl_Interp *interp); MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *argPtr); |
| ︙ | ︙ |
Changes to generic/tclParse.c.
| ︙ | ︙ | |||
2520 2521 2522 2523 2524 2525 2526 |
* check. */
{
int length;
const char *script = Tcl_GetStringFromObj(objPtr, &length);
return CommandComplete(script, length);
}
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 2520 2521 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 |
* check. */
{
int length;
const char *script = Tcl_GetStringFromObj(objPtr, &length);
return CommandComplete(script, length);
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
|
| ︙ | ︙ |
Changes to generic/tclThread.c.
| ︙ | ︙ | |||
349 350 351 352 353 354 355 | * Side effects: * Frees up all thread local storage. * *---------------------------------------------------------------------- */ void | | | | 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 |
* Side effects:
* Frees up all thread local storage.
*
*----------------------------------------------------------------------
*/
void
TclFinalizeThreadData(int quick)
{
TclFinalizeThreadDataThread();
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
if (!quick) {
/*
* Quick exit principle makes it useless to terminate allocators
*/
TclFinalizeThreadAllocThread();
}
#endif
}
|
| ︙ | ︙ |
Changes to tests/io.test.
| ︙ | ︙ | |||
7896 7897 7898 7899 7900 7901 7902 7903 7904 7905 7906 7907 7908 7909 |
} -body {
chan copy $c $outChan
} -cleanup {
close $outChan
close $c
removeFile out
} -result 100
test io-54.1 {Recursive channel events} {socket fileevent} {
# This test checks to see if file events are delivered during recursive
# event loops when there is buffered data on the channel.
proc accept {s a p} {
variable as
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 7896 7897 7898 7899 7900 7901 7902 7903 7904 7905 7906 7907 7908 7909 7910 7911 7912 7913 7914 7915 7916 7917 7918 7919 7920 7921 7922 7923 7924 7925 7926 7927 7928 7929 7930 7931 7932 7933 7934 7935 7936 7937 7938 7939 7940 7941 7942 7943 7944 7945 7946 7947 |
} -body {
chan copy $c $outChan
} -cleanup {
close $outChan
close $c
removeFile out
} -result 100
test io-53.17 {[7c187a3773] MBWrite: proper inQueueTail handling} -setup {
proc driver {cmd args} {
variable buffer
variable index
set chan [lindex $args 0]
switch -- $cmd {
initialize {
set index($chan) 0
set buffer($chan) [encoding convertto utf-8 \
line\n[string repeat a 100]line\n]
return {initialize finalize watch read}
}
finalize {
unset index($chan) buffer($chan)
return
}
watch {}
read {
set n [lindex $args 1]
set new [expr {$index($chan) + $n}]
set result [string range $buffer($chan) $index($chan) $new-1]
set index($chan) $new
return $result
}
}
}
set c [chan create read [namespace which driver]]
chan configure $c -encoding utf-8 -translation lf -buffersize 107
set out [makeFile {} out]
set outChan [open $out w]
chan configure $outChan -encoding utf-8 -translation lf
} -body {
list [gets $c] [chan copy $c $outChan -size 100] [gets $c]
} -cleanup {
close $outChan
close $c
removeFile out
} -result {line 100 line}
test io-54.1 {Recursive channel events} {socket fileevent} {
# This test checks to see if file events are delivered during recursive
# event loops when there is buffered data on the channel.
proc accept {s a p} {
variable as
|
| ︙ | ︙ |
Changes to tests/ioCmd.test.
| ︙ | ︙ | |||
290 291 292 293 294 295 296 |
} -body {
fconfigure $cli -blah
} -cleanup {
close $cli
close $srv
unset cli srv port
rename iocmdSRV {}
| | | 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 |
} -body {
fconfigure $cli -blah
} -cleanup {
close $cli
close $srv
unset cli srv port
rename iocmdSRV {}
} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -connecting, -peername, or -sockname}
test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup {
set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $srv -sockname] 2]
proc iocmdSRV {sock ip port} {close $sock}
set cli [socket 127.0.0.1 $port]
} -body {
expr {[lindex [fconfigure $cli -peername] 2] == $port}
|
| ︙ | ︙ |
Changes to unix/tclUnixSock.c.
| ︙ | ︙ | |||
901 902 903 904 905 906 907 |
"can't get sockname: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
}
if (len > 0) {
| | | 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 |
"can't get sockname: %s", Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
}
if (len > 0) {
return Tcl_BadChannelOption(interp, optionName, "connecting peername sockname");
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ |
Changes to win/tclWinSock.c.
| ︙ | ︙ | |||
1497 1498 1499 1500 1501 1502 1503 |
}
}
#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
if (len > 0) {
#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
return Tcl_BadChannelOption(interp, optionName,
| | | | 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 |
}
}
#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
if (len > 0) {
#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
return Tcl_BadChannelOption(interp, optionName,
"connecting peername sockname keepalive nagle");
#else
return Tcl_BadChannelOption(interp, optionName, "connecting peername sockname");
#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
}
return TCL_OK;
}
/*
|
| ︙ | ︙ |