Check-in [1ea47b059c]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:@1451
Timelines: family | ancestors | descendants | both | activestate-nre-excised-variant-1-roll-forward
Files: files | file ages | folders
SHA1: 1ea47b059cd6591a5269958871329d2834234d92
User & Date: andreask 2010-12-07 10:15:15.000
Context
2010-12-07
11:45
@1511 check-in: cde12364d3 user: andreask tags: activestate-nre-excised-variant-1-roll-forward
10:15
@1451 check-in: 1ea47b059c user: andreask tags: activestate-nre-excised-variant-1-roll-forward
2010-12-06
14:52
@1400, undo of 177 (TclpThreadGetStacksize). check-in: 861c844a13 user: andreask tags: activestate-nre-excised-variant-1-roll-forward
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/tcl.h.
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73

#define TCL_MAJOR_VERSION   8
#define TCL_MINOR_VERSION   6
#define TCL_RELEASE_LEVEL   TCL_BETA_RELEASE
#define TCL_RELEASE_SERIAL  1

#define TCL_VERSION	    "8.6"
#define TCL_PATCH_LEVEL	    "8.6b1.1"

/*
 *----------------------------------------------------------------------------
 * The following definitions set up the proper options for Windows compilers.
 * We use this method because there is no autoconf equivalent.
 */








|







59
60
61
62
63
64
65
66
67
68
69
70
71
72
73

#define TCL_MAJOR_VERSION   8
#define TCL_MINOR_VERSION   6
#define TCL_RELEASE_LEVEL   TCL_BETA_RELEASE
#define TCL_RELEASE_SERIAL  1

#define TCL_VERSION	    "8.6"
#define TCL_PATCH_LEVEL	    "8.6b1.2"

/*
 *----------------------------------------------------------------------------
 * The following definitions set up the proper options for Windows compilers.
 * We use this method because there is no autoconf equivalent.
 */

Changes to generic/tclBasic.c.
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 *
 * RCS: @(#) $Id: tclBasic.c,v 1.303 2008/06/13 12:14:32 das Exp $
 */

#include "tclInt.h"
#include "tclOOInt.h"
#include "tclCompile.h"
#include <float.h>
#include <limits.h>
#include <math.h>
#include "tommath.h"

/*
 * Determine whether we're using IEEE floating point
 */

#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
#   define IEEE_FLOATING_POINT







|
<

<







17
18
19
20
21
22
23
24

25

26
27
28
29
30
31
32
 *
 * RCS: @(#) $Id: tclBasic.c,v 1.303 2008/06/13 12:14:32 das Exp $
 */

#include "tclInt.h"
#include "tclOOInt.h"
#include "tclCompile.h"
#include "tommath.h"

#include <math.h>


/*
 * Determine whether we're using IEEE floating point
 */

#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
#   define IEEE_FLOATING_POINT
Changes to generic/tclBinary.c.
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
 */

Tcl_Command
TclInitBinaryCmd(
    Tcl_Interp *interp)
{
    const EnsembleImplMap binaryMap[] = {
	{ "format", BinaryFormatCmd, NULL, NULL ,NULL },
	{ "scan",   BinaryScanCmd, NULL,NULL ,NULL },
	{ "encode", NULL, NULL, NULL, NULL },
	{ "decode", NULL, NULL, NULL, NULL },
	{ NULL, NULL, NULL, NULL, NULL }
    };
    const EnsembleImplMap encodeMap[] = {
	{ "hex",      BinaryEncodeHex, NULL, NULL, (ClientData)HexDigits },
	{ "uuencode", BinaryEncode64,  NULL, NULL, (ClientData)UueDigits },
	{ "base64",   BinaryEncode64,  NULL, NULL, (ClientData)B64Digits },
	{ NULL, NULL, NULL, NULL, NULL }
    };
    const EnsembleImplMap decodeMap[] = {
	{ "hex",      BinaryDecodeHex, NULL, NULL, NULL },
	{ "uuencode", BinaryDecodeUu,  NULL, NULL, NULL },
	{ "base64",   BinaryDecode64,  NULL, NULL, NULL },
	{ NULL, NULL, NULL, NULL, NULL }
    };
    Tcl_Command binaryEnsemble;

    binaryEnsemble = TclMakeEnsemble(interp, "binary", binaryMap);
    TclMakeEnsemble(interp, "binary encode", encodeMap);
    TclMakeEnsemble(interp, "binary decode", decodeMap);
    return binaryEnsemble;







|
|
|
|
|


|
|
|
|


|
|
|
|







692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
 */

Tcl_Command
TclInitBinaryCmd(
    Tcl_Interp *interp)
{
    const EnsembleImplMap binaryMap[] = {
	{ "format", BinaryFormatCmd, NULL, NULL },
	{ "scan",   BinaryScanCmd, NULL,NULL },
	{ "encode", NULL, NULL, NULL },
	{ "decode", NULL, NULL, NULL },
	{ NULL, NULL, NULL, NULL }
    };
    const EnsembleImplMap encodeMap[] = {
	{ "hex",      BinaryEncodeHex, NULL, (ClientData)HexDigits },
	{ "uuencode", BinaryEncode64,  NULL, (ClientData)UueDigits },
	{ "base64",   BinaryEncode64,  NULL, (ClientData)B64Digits },
	{ NULL, NULL, NULL, NULL }
    };
    const EnsembleImplMap decodeMap[] = {
	{ "hex",      BinaryDecodeHex, NULL, NULL },
	{ "uuencode", BinaryDecodeUu,  NULL, NULL },
	{ "base64",   BinaryDecode64,  NULL, NULL },
	{ NULL, NULL, NULL, NULL }
    };
    Tcl_Command binaryEnsemble;

    binaryEnsemble = TclMakeEnsemble(interp, "binary", binaryMap);
    TclMakeEnsemble(interp, "binary encode", encodeMap);
    TclMakeEnsemble(interp, "binary decode", decodeMap);
    return binaryEnsemble;
Changes to generic/tclCmdIL.c.
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
     * Procedure CallFrame.
     */

    if (procPtr != NULL) {
	Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;

	if (namePtr) {
	    char *procName = Tcl_GetHashKey(namePtr->tablePtr, namePtr);
	    char *nsName = procPtr->cmdPtr->nsPtr->fullName;

	    /*
	     * This is a regular command.
	     */

	    ADD_PAIR("proc", Tcl_NewStringObj(nsName, -1));

	    if (strcmp(nsName, "::") != 0) {
		Tcl_AppendToObj(lv[lc-1], "::", -1);
	    }
	    Tcl_AppendToObj(lv[lc-1], procName, -1);
	} else if (procPtr->cmdPtr->clientData) {
	    ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
	    int i;

	    /*
	     * This is a non-standard command. Luckily, it's told us how to
	     * render extra information about its frame.







|
<





|
|
|
<
<
|







1309
1310
1311
1312
1313
1314
1315
1316

1317
1318
1319
1320
1321
1322
1323
1324


1325
1326
1327
1328
1329
1330
1331
1332
     * Procedure CallFrame.
     */

    if (procPtr != NULL) {
	Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;

	if (namePtr) {
            Tcl_Obj *procNameObj;


	    /*
	     * This is a regular command.
	     */

            TclNewObj(procNameObj);
            Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
                    procNameObj);


	    ADD_PAIR("proc", procNameObj);
	} else if (procPtr->cmdPtr->clientData) {
	    ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
	    int i;

	    /*
	     * This is a non-standard command. Luckily, it's told us how to
	     * render extra information about its frame.
Changes to generic/tclCompCmds.c.
1695
1696
1697
1698
1699
1700
1701

1702
1703
1704
1705
1706
1707
1708
    infoPtr = (ForeachInfo *) ckalloc((unsigned)
	    sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *));
    infoPtr->numLists = numLists;
    infoPtr->firstValueTemp = firstValueTemp;
    infoPtr->loopCtTemp = loopCtTemp;
    for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
	ForeachVarList *varListPtr;

	numVars = varcList[loopIndex];
	varListPtr = (ForeachVarList *) ckalloc((unsigned)
		sizeof(ForeachVarList) + numVars*sizeof(int));
	varListPtr->numVars = numVars;
	for (j = 0;  j < numVars;  j++) {
	    const char *varName = varvList[loopIndex][j];
	    int nameChars = strlen(varName);







>







1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
    infoPtr = (ForeachInfo *) ckalloc((unsigned)
	    sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *));
    infoPtr->numLists = numLists;
    infoPtr->firstValueTemp = firstValueTemp;
    infoPtr->loopCtTemp = loopCtTemp;
    for (loopIndex = 0;  loopIndex < numLists;  loopIndex++) {
	ForeachVarList *varListPtr;

	numVars = varcList[loopIndex];
	varListPtr = (ForeachVarList *) ckalloc((unsigned)
		sizeof(ForeachVarList) + numVars*sizeof(int));
	varListPtr->numVars = numVars;
	for (j = 0;  j < numVars;  j++) {
	    const char *varName = varvList[loopIndex][j];
	    int nameChars = strlen(varName);
2158
2159
2160
2161
2162
2163
2164

2165
2166
2167
2168
2169
2170
2171
	if (realCond) {
	    /*
	     * Find out if the condition is a constant.
	     */

	    Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start,
		    testTokenPtr[1].size);

	    Tcl_IncrRefCount(boolObj);
	    code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
	    TclDecrRefCount(boolObj);
	    if (code == TCL_OK) {
		/*
		 * A static condition.
		 */







>







2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
	if (realCond) {
	    /*
	     * Find out if the condition is a constant.
	     */

	    Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start,
		    testTokenPtr[1].size);

	    Tcl_IncrRefCount(boolObj);
	    code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
	    TclDecrRefCount(boolObj);
	    if (code == TCL_OK) {
		/*
		 * A static condition.
		 */
3789
3790
3791
3792
3793
3794
3795



3796

3797
3798
3799
3800
3801
3802
3803

	if (i != numWords) {
	    /*
	     * A value has been given: set the variable, pop the value
	     */

	    CompileWord(envPtr, valueTokenPtr, interp, 1);



	    TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);

	    TclEmitOpcode(INST_POP, envPtr);
	}
    }

    /*
     * Set the result to empty
     */







>
>
>
|
>







3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809

	if (i != numWords) {
	    /*
	     * A value has been given: set the variable, pop the value
	     */

	    CompileWord(envPtr, valueTokenPtr, interp, 1);
	    if (localIndex < 0x100) {
		TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
	    } else {
		TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
	    }
	    TclEmitOpcode(INST_POP, envPtr);
	}
    }

    /*
     * Set the result to empty
     */
Changes to generic/tclCompCmdsSZ.c.
2403
2404
2405
2406
2407
2408
2409
2410
2411













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
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465

2466
2467
2468
2469
2470
2471
2472
		STORE(			resultVars[i]);
		OP(			POP);
		if (optionVars[i] >= 0) {
		    LOAD(		optionsVar);
		    STORE(		optionVars[i]);
		    OP(			POP);
		}
	    }
	    if (!handlerTokens[i]) {













		/*
		 * No handler. Will not be the last handler (that condition is
		 * checked by the caller). Chain to the next one.
		 */

		ExceptionRangeEnds(envPtr, range);
		forwardsNeedFixing = 1;
		JUMP(forwardsToFix[i],	JUMP4);
		if (resultVars[i] >= 0) {
		    goto finishTrapCatchHandling;
		}
	    } else {
		/*
		 * Got a handler. Make sure that any pending patch-up actions
		 * from previous unprocessed handlers are dealt with now that
		 * we know where they are to jump to.
		 */

		if (forwardsNeedFixing) {
		    forwardsNeedFixing = 0;
		    OP1(		JUMP1, 7);
		    for (j=0 ; j<i ; j++) {
			if (forwardsToFix[j] == -1) {
			    continue;
			}
			FIXJUMP(forwardsToFix[j]);
			forwardsToFix[j] = -1;
		    }
		    OP4(		BEGIN_CATCH4, range);
		}
		BODY(			handlerTokens[i], 5+i*4);
		ExceptionRangeEnds(envPtr, range);
		OP(			PUSH_RETURN_OPTIONS);
		OP4(			REVERSE, 2);
		OP1(			JUMP1, 4);
		forwardsToFix[i] = -1;

		/*
		 * Error in handler or setting of variables; replace the
		 * stored exception with the new one. Note that we only push
		 * this if we have either a body or some variable setting
		 * here. Otherwise this code is unreachable.
		 */

	    finishTrapCatchHandling:
		ExceptionRangeTarget(envPtr, range, catchOffset);
		OP(			PUSH_RETURN_OPTIONS);
		OP(			PUSH_RESULT);
		OP(			END_CATCH);
		STORE(			resultVar);
		OP(			POP);
		STORE(			optionsVar);
		OP(			POP);
	    }

	    if (i+1 < numHandlers) {
		JUMP(addrsToFix[i],	JUMP4);
	    }
	    if (matchClauses[i]) {
		FIXJUMP(notECJumpSource);
	    }
	    FIXJUMP(notCodeJumpSource);







|
|
>
>
>
>
>
>
>
>
>
>
>
>
>





<


<
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
>







2403
2404
2405
2406
2407
2408
2409
2410
2411
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
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
		STORE(			resultVars[i]);
		OP(			POP);
		if (optionVars[i] >= 0) {
		    LOAD(		optionsVar);
		    STORE(		optionVars[i]);
		    OP(			POP);
		}

		if (!handlerTokens[i]) {
		    /*
		     * No handler. Will not be the last handler (that is a
		     * condition that is checked by the caller). Chain to the
		     * next one.
		     */

		    ExceptionRangeEnds(envPtr, range);
		    OP(			END_CATCH);
		    forwardsNeedFixing = 1;
		    JUMP(forwardsToFix[i], JUMP4);
		    goto finishTrapCatchHandling;
		}
	    } else if (!handlerTokens[i]) {
		/*
		 * No handler. Will not be the last handler (that condition is
		 * checked by the caller). Chain to the next one.
		 */


		forwardsNeedFixing = 1;
		JUMP(forwardsToFix[i],	JUMP4);

		goto endOfThisArm;
	    }

	    /*
	     * Got a handler. Make sure that any pending patch-up actions from
	     * previous unprocessed handlers are dealt with now that we know
	     * where they are to jump to.
	     */

	    if (forwardsNeedFixing) {
		forwardsNeedFixing = 0;
		OP1(			JUMP1, 7);
		for (j=0 ; j<i ; j++) {
		    if (forwardsToFix[j] == -1) {
			continue;
		    }
		    FIXJUMP(forwardsToFix[j]);
		    forwardsToFix[j] = -1;
		}
		OP4(			BEGIN_CATCH4, range);
	    }
	    BODY(			handlerTokens[i], 5+i*4);
	    ExceptionRangeEnds(envPtr, range);
	    OP(				PUSH_RETURN_OPTIONS);
	    OP4(			REVERSE, 2);
	    OP1(			JUMP1, 4);
	    forwardsToFix[i] = -1;

	    /*
	     * Error in handler or setting of variables; replace the stored
	     * exception with the new one. Note that we only push this if we
	     * have either a body or some variable setting here. Otherwise
	     * this code is unreachable.
	     */

	finishTrapCatchHandling:
	    ExceptionRangeTarget(envPtr, range, catchOffset);
	    OP(				PUSH_RETURN_OPTIONS);
	    OP(				PUSH_RESULT);
	    OP(				END_CATCH);
	    STORE(			resultVar);
	    OP(				POP);
	    STORE(			optionsVar);
	    OP(				POP);

	endOfThisArm:
	    if (i+1 < numHandlers) {
		JUMP(addrsToFix[i],	JUMP4);
	    }
	    if (matchClauses[i]) {
		FIXJUMP(notECJumpSource);
	    }
	    FIXJUMP(notCodeJumpSource);
Changes to generic/tclCompExpr.c.
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
		int length;

		Tcl_DStringInit(&cmdName);
		Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1);
		p = TclGetStringFromObj(*funcObjv, &length);
		funcObjv++;
		Tcl_DStringAppend(&cmdName, p, length);
		TclEmitPush(TclRegisterNewNSLiteral(envPtr,
			Tcl_DStringValue(&cmdName),
			Tcl_DStringLength(&cmdName)), envPtr);
		Tcl_DStringFree(&cmdName);

		/*
		 * Start a count of the number of words in this function
		 * command invocation. In case there's already a count in







|







2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
		int length;

		Tcl_DStringInit(&cmdName);
		Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1);
		p = TclGetStringFromObj(*funcObjv, &length);
		funcObjv++;
		Tcl_DStringAppend(&cmdName, p, length);
		TclEmitPush(TclRegisterNewCmdLiteral(envPtr,
			Tcl_DStringValue(&cmdName),
			Tcl_DStringLength(&cmdName)), envPtr);
		Tcl_DStringFree(&cmdName);

		/*
		 * Start a count of the number of words in this function
		 * command invocation. In case there's already a count in
Changes to generic/tclCompile.c.
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
    {"eq",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Equal:	push (stknext == stktop) */
    {"neq",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Not equal:	push (stknext != stktop) */
    {"lt",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Less:	push (stknext < stktop) */
    {"gt",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Greater:	push (stknext || stktop) */
    {"le",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Less or equal: push (stknext || stktop) */
    {"ge",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Greater or equal: push (stknext || stktop) */
    {"lshift",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Left shift:	push (stknext << stktop) */
    {"rshift",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Right shift:	push (stknext >> stktop) */
    {"add",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Add:		push (stknext + stktop) */
    {"sub",		  1,   -1,         0,	{OPERAND_NONE}},







|

|

|







152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
    {"eq",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Equal:	push (stknext == stktop) */
    {"neq",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Not equal:	push (stknext != stktop) */
    {"lt",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Less:	push (stknext < stktop) */
    {"gt",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Greater:	push (stknext > stktop) */
    {"le",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Less or equal: push (stknext <= stktop) */
    {"ge",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Greater or equal: push (stknext >= stktop) */
    {"lshift",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Left shift:	push (stknext << stktop) */
    {"rshift",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Right shift:	push (stknext >> stktop) */
    {"add",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Add:		push (stknext + stktop) */
    {"sub",		  1,   -1,         0,	{OPERAND_NONE}},
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
			envPtr->numCommands = savedNumCmds;
			envPtr->codeNext = envPtr->codeStart + savedCodeNext;
		    }

		    /*
		     * No compile procedure so push the word. If the command
		     * was found, push a CmdName object to reduce runtime
		     * lookups. Avoid sharing this literal among different
		     * namespaces to reduce shimmering.
		     */

		    objIndex = TclRegisterNewNSLiteral(envPtr,
			    tokenPtr[1].start, tokenPtr[1].size);
		    if (cmdPtr != NULL) {
			TclSetCmdNameObj(interp,
				envPtr->literalArrayPtr[objIndex].objPtr,
				cmdPtr);
		    }
		    if ((wordIdx == 0) && (parsePtr->numWords == 1)) {
			/*
			 * Single word script: unshare the command name to
			 * avoid shimmering between bytecode and cmdName
			 * representations. [Bug 458361]
			 */

			TclHideLiteral(interp, envPtr, objIndex);
		    }
		} else {
		    /*
		     * Simple argument word of a command. We reach this if and
		     * only if the command word was not compiled for whatever
		     * reason. Register the literal's location for use by
		     * uplevel, etc. commands, should they encounter it
		     * unmodified. We care only if the we are in a context







|
|


|






<
<
<
<
<
<
<
<
<







1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556









1557
1558
1559
1560
1561
1562
1563
			envPtr->numCommands = savedNumCmds;
			envPtr->codeNext = envPtr->codeStart + savedCodeNext;
		    }

		    /*
		     * No compile procedure so push the word. If the command
		     * was found, push a CmdName object to reduce runtime
		     * lookups. Mark this as a command name literal to reduce
		     * shimmering. 
		     */

		    objIndex = TclRegisterNewCmdLiteral(envPtr,
			    tokenPtr[1].start, tokenPtr[1].size);
		    if (cmdPtr != NULL) {
			TclSetCmdNameObj(interp,
				envPtr->literalArrayPtr[objIndex].objPtr,
				cmdPtr);
		    }









		} else {
		    /*
		     * Simple argument word of a command. We reach this if and
		     * only if the command word was not compiled for whatever
		     * reason. Register the literal's location for use by
		     * uplevel, etc. commands, should they encounter it
		     * unmodified. We care only if the we are in a context
Changes to generic/tclCompile.h.
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
 *----------------------------------------------------------------
 * Macros and flag values used by Tcl bytecode compilation and execution
 * modules inside the Tcl core but not used outside.
 *----------------------------------------------------------------
 */

#define LITERAL_ON_HEAP		0x01
#define LITERAL_NS_SCOPE	0x02

/*
 * Form of TclRegisterLiteral with flags == 0. In that case, it is safe to
 * cast away constness, and it is cleanest to do that here, all in one place.
 *
 * int TclRegisterNewLiteral(CompileEnv *envPtr, const char *bytes,
 *			     int length);
 */

#define TclRegisterNewLiteral(envPtr, bytes, length) \
    TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0)

/*
 * Form of TclRegisterLiteral with flags == LITERAL_NS_SCOPE. In that case, it
 * is safe to cast away constness, and it is cleanest to do that here, all in
 * one place.
 *
 * int TclRegisterNewNSLiteral(CompileEnv *envPtr, const char *bytes,
 *			       int length);
 */

#define TclRegisterNewNSLiteral(envPtr, bytes, length) \
    TclRegisterLiteral(envPtr, (char *)(bytes), length, LITERAL_NS_SCOPE)

/*
 * Macro used to manually adjust the stack requirements; used in cases where
 * the stack effect cannot be computed from the opcode and its operands, but
 * is still known at compile time.
 *
 * void TclAdjustStackDepth(int delta, CompileEnv *envPtr);







|













|







|
|







978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
 *----------------------------------------------------------------
 * Macros and flag values used by Tcl bytecode compilation and execution
 * modules inside the Tcl core but not used outside.
 *----------------------------------------------------------------
 */

#define LITERAL_ON_HEAP		0x01
#define LITERAL_CMD_NAME	0x02

/*
 * Form of TclRegisterLiteral with flags == 0. In that case, it is safe to
 * cast away constness, and it is cleanest to do that here, all in one place.
 *
 * int TclRegisterNewLiteral(CompileEnv *envPtr, const char *bytes,
 *			     int length);
 */

#define TclRegisterNewLiteral(envPtr, bytes, length) \
    TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0)

/*
 * Form of TclRegisterLiteral with flags == LITERAL_CMD_NAME. In that case, it
 * is safe to cast away constness, and it is cleanest to do that here, all in
 * one place.
 *
 * int TclRegisterNewNSLiteral(CompileEnv *envPtr, const char *bytes,
 *			       int length);
 */

#define TclRegisterNewCmdLiteral(envPtr, bytes, length) \
    TclRegisterLiteral(envPtr, (char *)(bytes), length, LITERAL_CMD_NAME)

/*
 * Macro used to manually adjust the stack requirements; used in cases where
 * the stack effect cannot be computed from the opcode and its operands, but
 * is still known at compile time.
 *
 * void TclAdjustStackDepth(int delta, CompileEnv *envPtr);
Changes to generic/tclExecute.c.
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 *
 * RCS: @(#) $Id: tclExecute.c,v 1.375 2008/06/30 01:10:46 das Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tommath.h"

#include <math.h>
#include <float.h>

/*
 * Hack to determine whether we may expect IEEE floating point. The hack is
 * formally incorrect in that non-IEEE platforms might have the same precision
 * and range, but VAX, IBM, and Cray do not; are there any other floating
 * point units that we might care about?
 */







<

<







16
17
18
19
20
21
22

23

24
25
26
27
28
29
30
 *
 * RCS: @(#) $Id: tclExecute.c,v 1.375 2008/06/30 01:10:46 das Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tommath.h"

#include <math.h>


/*
 * Hack to determine whether we may expect IEEE floating point. The hack is
 * formally incorrect in that non-IEEE platforms might have the same precision
 * and range, but VAX, IBM, and Cray do not; are there any other floating
 * point units that we might care about?
 */
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185

static inline Var *
VarHashCreateVar(
    TclVarHashTable *tablePtr,
    Tcl_Obj *key,
    int *newPtr)
{
    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) tablePtr,
	    (char *) key, newPtr);

    if (!hPtr) {
	return NULL;
    }
    return VarHashGetValue(hPtr);
}







|







169
170
171
172
173
174
175
176
177
178
179
180
181
182
183

static inline Var *
VarHashCreateVar(
    TclVarHashTable *tablePtr,
    Tcl_Obj *key,
    int *newPtr)
{
    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table,
	    (char *) key, newPtr);

    if (!hPtr) {
	return NULL;
    }
    return VarHashGetValue(hPtr);
}
7302
7303
7304
7305
7306
7307
7308

























7309
7310
7311
7312
7313
7314
7315
	    TclNewObj(emptyPtr);
	    PUSH_OBJECT(emptyPtr);
	    PUSH_OBJECT(emptyPtr);
	} else {
	    PUSH_OBJECT(valPtr);
	    PUSH_OBJECT(keyPtr);
	}

























	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
	objResultPtr = constants[done];
	/* TODO: consider opt like INST_FOREACH_STEP4 */
	NEXT_INST_F(5, 0, 1);

    case INST_DICT_DONE:







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







7300
7301
7302
7303
7304
7305
7306
7307
7308
7309
7310
7311
7312
7313
7314
7315
7316
7317
7318
7319
7320
7321
7322
7323
7324
7325
7326
7327
7328
7329
7330
7331
7332
7333
7334
7335
7336
7337
7338
	    TclNewObj(emptyPtr);
	    PUSH_OBJECT(emptyPtr);
	    PUSH_OBJECT(emptyPtr);
	} else {
	    PUSH_OBJECT(valPtr);
	    PUSH_OBJECT(keyPtr);
	}

#ifndef TCL_COMPILE_DEBUG
	/*
	 * The INST_DICT_FIRST and INST_DICT_NEXT instructsions are always
	 * followed by a conditional jump, so we can take advantage of this to
	 * do some peephole optimization (note that we're careful to not close
	 * out someone doing something else).
	 */

	pc += 5;
	switch (*pc) {
	case INST_JUMP_FALSE1:
	    NEXT_INST_F((done ? 2 : TclGetInt1AtPtr(pc+1)), 0, 0);
	case INST_JUMP_FALSE4:
	    NEXT_INST_F((done ? 5 : TclGetInt4AtPtr(pc+1)), 0, 0);
	case INST_JUMP_TRUE1:
	    NEXT_INST_F((done ? TclGetInt1AtPtr(pc+1) : 2), 0, 0);
	case INST_JUMP_TRUE4:
	    NEXT_INST_F((done ? TclGetInt4AtPtr(pc+1) : 5), 0, 0);
	default:
	    pc -= 5;
	    /* fall through to non-debug handling */
	}
#endif

	TRACE_APPEND(("\"%.30s\" \"%.30s\" %d",
		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), done));
	objResultPtr = constants[done];
	/* TODO: consider opt like INST_FOREACH_STEP4 */
	NEXT_INST_F(5, 0, 1);

    case INST_DICT_DONE:
Changes to generic/tclInt.h.
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
 */

#include "tclPort.h"

#include <stdio.h>

#include <ctype.h>
#ifdef NO_LIMITS_H
#   include "../compat/limits.h"
#else
#   include <limits.h>
#endif
#ifdef NO_STDLIB_H
#   include "../compat/stdlib.h"
#else
#   include <stdlib.h>
#endif
#ifdef NO_STRING_H
#include "../compat/string.h"







<
<
<
<
<







37
38
39
40
41
42
43





44
45
46
47
48
49
50
 */

#include "tclPort.h"

#include <stdio.h>

#include <ctype.h>





#ifdef NO_STDLIB_H
#   include "../compat/stdlib.h"
#else
#   include <stdlib.h>
#endif
#ifdef NO_STRING_H
#include "../compat/string.h"
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
    (   !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ)) \
    &&  (varPtr)->value.objPtr)

#define TclIsVarDirectWritable(varPtr) \
    !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_WRITE|VAR_DEAD_HASH))

#define TclIsVarDirectUnsettable(varPtr) \
    !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_UNSET|VAR_DEAD_HASH))

#define TclIsVarDirectModifyable(varPtr) \
    (   !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE)) \
    &&  (varPtr)->value.objPtr)

#define TclIsVarDirectReadable2(varPtr, arrayPtr) \
    (TclIsVarDirectReadable(varPtr) &&\







|







883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
    (   !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ)) \
    &&  (varPtr)->value.objPtr)

#define TclIsVarDirectWritable(varPtr) \
    !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_WRITE|VAR_DEAD_HASH))

#define TclIsVarDirectUnsettable(varPtr) \
    !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH))

#define TclIsVarDirectModifyable(varPtr) \
    (   !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE)) \
    &&  (varPtr)->value.objPtr)

#define TclIsVarDirectReadable2(varPtr, arrayPtr) \
    (TclIsVarDirectReadable(varPtr) &&\
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
    Tcl_Obj *returnOpts;	/* A dictionary holding the options to the
				 * last [return] command. */

    Tcl_Obj *errorInfo;		/* errorInfo value (now as a Tcl_Obj). */
    Tcl_Obj *eiVar;		/* cached ref to ::errorInfo variable. */
    Tcl_Obj *errorCode;		/* errorCode value (now as a Tcl_Obj). */
    Tcl_Obj *ecVar;		/* cached ref to ::errorInfo variable. */
    Tcl_Obj *errorStack;	/* [info errorstack] value (as a Tcl_Obj). */
    Tcl_Obj *upLiteral;		/* "UP" literal for [info errorstack] */
    Tcl_Obj *callLiteral;	/* "CALL" literal for [info errorstack] */
    int resetErrorStack;        /* controls cleaning up of ::errorStack */
    int returnLevel;		/* [return -level] parameter. */

    /*
     * Resource limiting framework support (TIP#143).
     */

    struct {







<
<
<
<







1932
1933
1934
1935
1936
1937
1938




1939
1940
1941
1942
1943
1944
1945
    Tcl_Obj *returnOpts;	/* A dictionary holding the options to the
				 * last [return] command. */

    Tcl_Obj *errorInfo;		/* errorInfo value (now as a Tcl_Obj). */
    Tcl_Obj *eiVar;		/* cached ref to ::errorInfo variable. */
    Tcl_Obj *errorCode;		/* errorCode value (now as a Tcl_Obj). */
    Tcl_Obj *ecVar;		/* cached ref to ::errorInfo variable. */




    int returnLevel;		/* [return -level] parameter. */

    /*
     * Resource limiting framework support (TIP#143).
     */

    struct {
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132

















2133
2134
2135
2136
2137
2138
2139
     */
    void *objectFoundation;	/* Pointer to the Foundation structure of the
				 * object system, which contains things like
				 * references to key namespaces. See
				 * tclOOInt.h and tclOO.c for real definition
				 * and setup. */

#ifdef TCL_COMPILE_STATS
    /*
     * Statistical information about the bytecode compiler and interpreter's
     * operation.
     */

    ByteCodeStats stats;	/* Holds compilation and execution statistics
				 * for this interpreter. */
#endif /* TCL_COMPILE_STATS */
    /*
     * TIP #285, Script cancellation support.
     */

    Tcl_AsyncHandler asyncCancel;
				/* Async handler token for Tcl_CancelEval. */
    Tcl_Obj *asyncCancelMsg;	/* Error message set by async cancel handler
				 * for the propagation of arbitrary Tcl
				 * errors. This information, if present
				 * (asyncCancelMsg not NULL), takes precedence
				 * over the default error messages returned by
				 * a script cancellation operation. */


















} Interp;

/*
 * Macros that use the TSD-ekeko.
 */

#define TclAsyncReady(iPtr) \







<
<
<
<
<
<
<
<
<













>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2095
2096
2097
2098
2099
2100
2101









2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
     */
    void *objectFoundation;	/* Pointer to the Foundation structure of the
				 * object system, which contains things like
				 * references to key namespaces. See
				 * tclOOInt.h and tclOO.c for real definition
				 * and setup. */










    /*
     * TIP #285, Script cancellation support.
     */

    Tcl_AsyncHandler asyncCancel;
				/* Async handler token for Tcl_CancelEval. */
    Tcl_Obj *asyncCancelMsg;	/* Error message set by async cancel handler
				 * for the propagation of arbitrary Tcl
				 * errors. This information, if present
				 * (asyncCancelMsg not NULL), takes precedence
				 * over the default error messages returned by
				 * a script cancellation operation. */

	/*
	 * TIP #348 IMPLEMENTATION  -  Substituted error stack
	 */
    Tcl_Obj *errorStack;	/* [info errorstack] value (as a Tcl_Obj). */
    Tcl_Obj *upLiteral;		/* "UP" literal for [info errorstack] */
    Tcl_Obj *callLiteral;	/* "CALL" literal for [info errorstack] */
    int resetErrorStack;        /* controls cleaning up of ::errorStack */

#ifdef TCL_COMPILE_STATS
    /*
     * Statistical information about the bytecode compiler and interpreter's
     * operation. This should be the last field of Interp.
     */

    ByteCodeStats stats;	/* Holds compilation and execution statistics
				 * for this interpreter. */
#endif /* TCL_COMPILE_STATS */
} Interp;

/*
 * Macros that use the TSD-ekeko.
 */

#define TclAsyncReady(iPtr) \
2718
2719
2720
2721
2722
2723
2724


2725
2726
2727
2728
2729
2730
2731
			    void *codePtr, CmdFrame *cfPtr, int pc);
MODULE_SCOPE void       TclArgumentBCRelease(Tcl_Interp* interp,
			    CmdFrame *cfPtr);
MODULE_SCOPE void       TclArgumentGet(Tcl_Interp* interp, Tcl_Obj* obj,
			    CmdFrame** cfPtrPtr, int* wordPtr);
MODULE_SCOPE int	TclArraySet(Tcl_Interp *interp,
			    Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);


MODULE_SCOPE double	TclBignumToDouble(const mp_int *bignum);
MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
			    int strLen, const unsigned char *pattern,
			    int ptnLen, int flags);
MODULE_SCOPE double	TclCeil(const mp_int *a);
MODULE_SCOPE int	TclCheckBadOctal(Tcl_Interp *interp,
			    const char *value);







>
>







2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
			    void *codePtr, CmdFrame *cfPtr, int pc);
MODULE_SCOPE void       TclArgumentBCRelease(Tcl_Interp* interp,
			    CmdFrame *cfPtr);
MODULE_SCOPE void       TclArgumentGet(Tcl_Interp* interp, Tcl_Obj* obj,
			    CmdFrame** cfPtrPtr, int* wordPtr);
MODULE_SCOPE int	TclArraySet(Tcl_Interp *interp,
			    Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
MODULE_SCOPE void	TclAppendBytesToByteArray(Tcl_Obj *objPtr,
			    const unsigned char *bytes, int len);
MODULE_SCOPE double	TclBignumToDouble(const mp_int *bignum);
MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
			    int strLen, const unsigned char *pattern,
			    int ptnLen, int flags);
MODULE_SCOPE double	TclCeil(const mp_int *a);
MODULE_SCOPE int	TclCheckBadOctal(Tcl_Interp *interp,
			    const char *value);
Changes to generic/tclLiteral.c.
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
				 * create an object in CompileEnv's object
				 * array. */
    int length,			/* Number of bytes in the string. If < 0, the
				 * string consists of all bytes up to the
				 * first null character. */
    int flags)			/* If LITERAL_ON_HEAP then the caller already
				 * malloc'd bytes and ownership is passed to
				 * this function. If LITERAL_NS_SCOPE then
				 * the literal shouldnot be shared accross
				 * namespaces. */
{
    Interp *iPtr = envPtr->iPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *globalPtr, *localPtr;
    Tcl_Obj *objPtr;
    unsigned hash;







|
|







407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
				 * create an object in CompileEnv's object
				 * array. */
    int length,			/* Number of bytes in the string. If < 0, the
				 * string consists of all bytes up to the
				 * first null character. */
    int flags)			/* If LITERAL_ON_HEAP then the caller already
				 * malloc'd bytes and ownership is passed to
				 * this function. If LITERAL_CMD_NAME then
				 * the literal should not be shared accross
				 * namespaces. */
{
    Interp *iPtr = envPtr->iPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *globalPtr, *localPtr;
    Tcl_Obj *objPtr;
    unsigned hash;
449
450
451
452
453
454
455
456


457
458
459
460
461
462


463

464
465
466
467
468
469
470
471
472
473
474
#endif /*TCL_COMPILE_DEBUG*/

	    return objIndex;
	}
    }

    /*
     * The literal is new to this CompileEnv. Should it be shared accross


     * namespaces? If it is a fully qualified name, the namespace
     * specification is not needed to avoid sharing.
     */

    if ((flags & LITERAL_NS_SCOPE) && iPtr->varFramePtr
	    && ((length <2) || (bytes[0] != ':') || (bytes[1] != ':'))) {


	nsPtr = iPtr->varFramePtr->nsPtr;

    } else {
	nsPtr = NULL;
    }

    /*
     * Is it in the interpreter's global literal table? If not, create it.
     */

    objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, flags,
	    &globalPtr);
    objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash);







|
>
>
|
<


|
|
>
>
|
>



|







449
450
451
452
453
454
455
456
457
458
459

460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
#endif /*TCL_COMPILE_DEBUG*/

	    return objIndex;
	}
    }

    /*
     * The literal is new to this CompileEnv. If it is a command name, avoid
     * sharing it accross namespaces, and try not to share it with non-cmd
     * literals. Note that FQ command names can be shared, so that we register
     * the namespace as the interp's global NS.

     */

    if (flags & LITERAL_CMD_NAME) {
	if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) {
	    nsPtr = iPtr->globalNsPtr;
	} else {
	    nsPtr = iPtr->varFramePtr->nsPtr;
	}
    } else {
	nsPtr = NULL;
    }
    
    /*
     * Is it in the interpreter's global literal table? If not, create it.
     */

    objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, flags,
	    &globalPtr);
    objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash);
Changes to generic/tclLoad.c.
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
    Tcl_Interp *target;
    LoadedPackage *pkgPtr, *defaultPtr;
    Tcl_DString pkgName, tmp, initName, safeInitName;
    Tcl_DString unloadName, safeUnloadName;
    InterpPackage *ipFirstPtr, *ipPtr;
    int code, namesMatch, filesMatch, offset;
    const char *symbols[2];
    void* procPtrs[1];
    const char *p, *fullFileName, *packageName;
    Tcl_LoadHandle loadHandle;
    Tcl_UniChar ch;

    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?");
	return TCL_ERROR;







|







125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
    Tcl_Interp *target;
    LoadedPackage *pkgPtr, *defaultPtr;
    Tcl_DString pkgName, tmp, initName, safeInitName;
    Tcl_DString unloadName, safeUnloadName;
    InterpPackage *ipFirstPtr, *ipPtr;
    int code, namesMatch, filesMatch, offset;
    const char *symbols[2];
    Tcl_PackageInitProc *initProc;
    const char *p, *fullFileName, *packageName;
    Tcl_LoadHandle loadHandle;
    Tcl_UniChar ch;

    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?");
	return TCL_ERROR;
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
	 * initialization functions.
	 */

	symbols[0] = Tcl_DStringValue(&initName);
	symbols[1] = NULL;

	Tcl_MutexLock(&packageMutex);
	code = Tcl_LoadFile(interp, objv[1], symbols, 0, procPtrs, &loadHandle);
	Tcl_MutexUnlock(&packageMutex);
	if (code != TCL_OK) {
	    goto done;
	}

	/*
	 * Create a new record to describe this package.
	 */

	pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
	pkgPtr->fileName	   =
		ckalloc((unsigned) (strlen(fullFileName) + 1));
	strcpy(pkgPtr->fileName, fullFileName);
	pkgPtr->packageName	   =
		ckalloc((unsigned) (Tcl_DStringLength(&pkgName) + 1));
	strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName));
	pkgPtr->loadHandle	   = loadHandle;
	pkgPtr->initProc	   = (Tcl_PackageInitProc*) procPtrs[0];
	pkgPtr->safeInitProc	   = (Tcl_PackageInitProc*)
	    Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&safeInitName));
	pkgPtr->unloadProc	   = (Tcl_PackageUnloadProc*)
	    Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&unloadName));
	pkgPtr->safeUnloadProc	   = (Tcl_PackageUnloadProc *) 
	    Tcl_FindSymbol(interp, loadHandle,
			   Tcl_DStringValue(&safeUnloadName));







|

















|







350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
	 * initialization functions.
	 */

	symbols[0] = Tcl_DStringValue(&initName);
	symbols[1] = NULL;

	Tcl_MutexLock(&packageMutex);
	code = Tcl_LoadFile(interp, objv[1], symbols, 0, &initProc, &loadHandle);
	Tcl_MutexUnlock(&packageMutex);
	if (code != TCL_OK) {
	    goto done;
	}

	/*
	 * Create a new record to describe this package.
	 */

	pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
	pkgPtr->fileName	   =
		ckalloc((unsigned) (strlen(fullFileName) + 1));
	strcpy(pkgPtr->fileName, fullFileName);
	pkgPtr->packageName	   =
		ckalloc((unsigned) (Tcl_DStringLength(&pkgName) + 1));
	strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName));
	pkgPtr->loadHandle	   = loadHandle;
	pkgPtr->initProc	   = initProc;
	pkgPtr->safeInitProc	   = (Tcl_PackageInitProc*)
	    Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&safeInitName));
	pkgPtr->unloadProc	   = (Tcl_PackageUnloadProc*)
	    Tcl_FindSymbol(interp, loadHandle, Tcl_DStringValue(&unloadName));
	pkgPtr->safeUnloadProc	   = (Tcl_PackageUnloadProc *) 
	    Tcl_FindSymbol(interp, loadHandle,
			   Tcl_DStringValue(&safeUnloadName));
Changes to generic/tclNamesp.c.
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
    if (iPtr->varFramePtr != iPtr->framePtr) {
        /* uplevel case, [lappend errorstack UP $relativelevel] */
        struct CallFrame *frame;
        int n;

        for (n=0, frame=iPtr->framePtr;
		(frame && (frame != iPtr->varFramePtr));
		n++, frame=frame->callerVarPtr);
        Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral);
        Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewIntObj(n));
    } else if (iPtr->framePtr != iPtr->rootFramePtr) {
        /* normal case, [lappend errorstack CALL [info level 0]] */
        Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->callLiteral);
        Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
                                 Tcl_NewListObj(iPtr->varFramePtr->objc,







|







4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
    if (iPtr->varFramePtr != iPtr->framePtr) {
        /* uplevel case, [lappend errorstack UP $relativelevel] */
        struct CallFrame *frame;
        int n;

        for (n=0, frame=iPtr->framePtr;
		(frame && (frame != iPtr->varFramePtr));
		n++, frame=frame->callerPtr);
        Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral);
        Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewIntObj(n));
    } else if (iPtr->framePtr != iPtr->rootFramePtr) {
        /* normal case, [lappend errorstack CALL [info level 0]] */
        Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->callLiteral);
        Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
                                 Tcl_NewListObj(iPtr->varFramePtr->objc,
Changes to generic/tclOOInt.h.
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 *
 * RCS: @(#) $Id: tclOOInt.h,v 1.2 2008/05/31 19:56:07 dkf Exp $
 */

#ifndef TCL_OO_INTERNAL_H
#define TCL_OO_INTERNAL_H 1

#include <tclInt.h>
#include "tclOO.h"

/*
 * Hack to make things work with Objective C. Note that ObjC isn't really
 * supported, but we don't want to to be actively hostile to it. [Bug 2163447]
 */








|







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 *
 * RCS: @(#) $Id: tclOOInt.h,v 1.2 2008/05/31 19:56:07 dkf Exp $
 */

#ifndef TCL_OO_INTERNAL_H
#define TCL_OO_INTERNAL_H 1

#include "tclInt.h"
#include "tclOO.h"

/*
 * Hack to make things work with Objective C. Note that ObjC isn't really
 * supported, but we don't want to to be actively hostile to it. [Bug 2163447]
 */

Changes to generic/tclObj.c.
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclObj.c,v 1.141 2008/04/27 22:21:31 dkf Exp $
 */

#include "tclInt.h"
#include "tommath.h"
#include <float.h>
#include <math.h>

/*
 * Table of all object types.
 */

static Tcl_HashTable typeTable;







<







14
15
16
17
18
19
20

21
22
23
24
25
26
27
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclObj.c,v 1.141 2008/04/27 22:21:31 dkf Exp $
 */

#include "tclInt.h"
#include "tommath.h"

#include <math.h>

/*
 * Table of all object types.
 */

static Tcl_HashTable typeTable;
Changes to generic/tclPkg.c.
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
	    /*
	     * We found an ifneeded script for the package. Be careful while
	     * executing it: this could cause reentrancy, so (a) protect the
	     * script itself from deletion and (b) don't assume that bestPtr
	     * will still exist when the script completes.
	     */

	    const char *versionToProvide = bestPtr->version;
	    script = bestPtr->script;

	    pkgPtr->clientData = (ClientData) versionToProvide;
	    Tcl_Preserve((ClientData) script);
	    Tcl_Preserve((ClientData) versionToProvide);
	    code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
	    Tcl_Release((ClientData) script);

	    pkgPtr = FindPackage(interp, name);
	    if (code == TCL_OK) {
		Tcl_ResetResult(interp);
		if (pkgPtr->version == NULL) {
		    code = TCL_ERROR;
		    Tcl_AppendResult(interp, "attempt to provide package ",







|


|
|
|

|







473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
	    /*
	     * We found an ifneeded script for the package. Be careful while
	     * executing it: this could cause reentrancy, so (a) protect the
	     * script itself from deletion and (b) don't assume that bestPtr
	     * will still exist when the script completes.
	     */

	    char *versionToProvide = bestPtr->version;
	    script = bestPtr->script;

	    pkgPtr->clientData = versionToProvide;
	    Tcl_Preserve(script);
	    Tcl_Preserve(versionToProvide);
	    code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
	    Tcl_Release(script);

	    pkgPtr = FindPackage(interp, name);
	    if (code == TCL_OK) {
		Tcl_ResetResult(interp);
		if (pkgPtr->version == NULL) {
		    code = TCL_ERROR;
		    Tcl_AppendResult(interp, "attempt to provide package ",
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
	    }

	    if (code == TCL_ERROR) {
		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			"\n    (\"package ifneeded %s %s\" script)",
			name, versionToProvide));
	    }
	    Tcl_Release((ClientData) versionToProvide);

	    if (code != TCL_OK) {
		/*
		 * Take a non-TCL_OK code from the script as an indication the
		 * package wasn't loaded properly, so the package system
		 * should not remember an improper load.
		 *







|







532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
	    }

	    if (code == TCL_ERROR) {
		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			"\n    (\"package ifneeded %s %s\" script)",
			name, versionToProvide));
	    }
	    Tcl_Release(versionToProvide);

	    if (code != TCL_OK) {
		/*
		 * Take a non-TCL_OK code from the script as an indication the
		 * package wasn't loaded properly, so the package system
		 * should not remember an improper load.
		 *
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
	    Tcl_DeleteHashEntry(hPtr);
	    if (pkgPtr->version != NULL) {
		ckfree(pkgPtr->version);
	    }
	    while (pkgPtr->availPtr != NULL) {
		availPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr->nextPtr;
		Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC);
		Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
		ckfree((char *) availPtr);
	    }
	    ckfree((char *) pkgPtr);
	}
	break;
    }
    case PKG_IFNEEDED: {







|
|







786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
	    Tcl_DeleteHashEntry(hPtr);
	    if (pkgPtr->version != NULL) {
		ckfree(pkgPtr->version);
	    }
	    while (pkgPtr->availPtr != NULL) {
		availPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr->nextPtr;
		Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
		ckfree((char *) availPtr);
	    }
	    ckfree((char *) pkgPtr);
	}
	break;
    }
    case PKG_IFNEEDED: {
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850

	    if (res == 0){
		if (objc == 4) {
		    ckfree(argv3i);
		    Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
		    return TCL_OK;
		}
		Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
		break;
	    }
	}
	ckfree(argv3i);

	if (objc == 4) {
	    return TCL_OK;







|







836
837
838
839
840
841
842
843
844
845
846
847
848
849
850

	    if (res == 0){
		if (objc == 4) {
		    ckfree(argv3i);
		    Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
		    return TCL_OK;
		}
		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
		break;
	    }
	}
	ckfree(argv3i);

	if (objc == 4) {
	    return TCL_OK;
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
	pkgPtr = Tcl_GetHashValue(hPtr);
	if (pkgPtr->version != NULL) {
	    ckfree(pkgPtr->version);
	}
	while (pkgPtr->availPtr != NULL) {
	    availPtr = pkgPtr->availPtr;
	    pkgPtr->availPtr = availPtr->nextPtr;
	    Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC);
	    Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
	    ckfree((char *) availPtr);
	}
	ckfree((char *) pkgPtr);
    }
    Tcl_DeleteHashTable(&iPtr->packageTable);
    if (iPtr->packageUnknown != NULL) {
	ckfree(iPtr->packageUnknown);







|
|







1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
	pkgPtr = Tcl_GetHashValue(hPtr);
	if (pkgPtr->version != NULL) {
	    ckfree(pkgPtr->version);
	}
	while (pkgPtr->availPtr != NULL) {
	    availPtr = pkgPtr->availPtr;
	    pkgPtr->availPtr = availPtr->nextPtr;
	    Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
	    Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
	    ckfree((char *) availPtr);
	}
	ckfree((char *) pkgPtr);
    }
    Tcl_DeleteHashTable(&iPtr->packageTable);
    if (iPtr->packageUnknown != NULL) {
	ckfree(iPtr->packageUnknown);
Changes to generic/tclStrToD.c.
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStrToD.c,v 1.34 2008/04/01 20:08:22 andreas_kupries Exp $
 *
 *----------------------------------------------------------------------
 */

#include <tclInt.h>
#include <stdio.h>
#include <stdlib.h>
#include <float.h>
#include <limits.h>
#include <math.h>
#include <ctype.h>
#include <tommath.h>

/*
 * Define KILL_OCTAL to suppress interpretation of numbers with leading zero
 * as octal. (Ceterum censeo: numeros octonarios delendos esse.)
 */

#undef	KILL_OCTAL







<
|
<
<
<
|
|
<







15
16
17
18
19
20
21

22



23
24

25
26
27
28
29
30
31
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStrToD.c,v 1.34 2008/04/01 20:08:22 andreas_kupries Exp $
 *
 *----------------------------------------------------------------------
 */


#include "tclInt.h"



#include "tommath.h"
#include <math.h>


/*
 * Define KILL_OCTAL to suppress interpretation of numbers with leading zero
 * as octal. (Ceterum censeo: numeros octonarios delendos esse.)
 */

#undef	KILL_OCTAL
106
107
108
109
110
111
112

113
114
115
116
117
118
119
				 * represented exactly in a 'double'. */
static int log10_DIGIT_MAX;	/* The number of decimal digits that fit in an
				 * mp_digit. */
static int log2FLT_RADIX;	/* Logarithm of the floating point radix. */
static int mantBits;		/* Number of bits in a double's significand */
static mp_int pow5[9];		/* Table of powers of 5**(2**n), up to
				 * 5**256 */

static int maxDigits;		/* The maximum number of digits to the left of
				 * the decimal point of a double. */
static int minDigits;		/* The maximum number of digits to the right
				 * of the decimal point in a double. */
static int mantDIGIT;		/* Number of mp_digit's needed to hold the
				 * significand of a double. */
static const double pow_10_2_n[] = {	/* Inexact higher powers of ten. */







>







101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
				 * represented exactly in a 'double'. */
static int log10_DIGIT_MAX;	/* The number of decimal digits that fit in an
				 * mp_digit. */
static int log2FLT_RADIX;	/* Logarithm of the floating point radix. */
static int mantBits;		/* Number of bits in a double's significand */
static mp_int pow5[9];		/* Table of powers of 5**(2**n), up to
				 * 5**256 */
static double tiny = 0.0;		/* The smallest representable double */
static int maxDigits;		/* The maximum number of digits to the left of
				 * the decimal point of a double. */
static int minDigits;		/* The maximum number of digits to the right
				 * of the decimal point in a double. */
static int mantDIGIT;		/* Number of mp_digit's needed to hold the
				 * significand of a double. */
static const double pow_10_2_n[] = {	/* Inexact higher powers of ten. */
950
951
952
953
954
955
956

957
958
959
960
961
962
963
964
965
966
967
968
969
970
	case EXPONENT_SIGNUM:
	case sI:
	case sIN:
	case sINFI:
	case sINFIN:
	case sINFINI:
	case sINFINIT:

	case sN:
	case sNA:
	case sNANPAREN:
	case sNANHEX:
	    Tcl_Panic("TclParseNumber: bad acceptState %d parsing '%s'",
		    acceptState, bytes);

	case BINARY:
	    shift = numTrailZeros;
	    if (!significandOverflow && significandWide != 0 &&
		    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
		    significandWide > (MOST_BITS + signum) >> shift)) {
		significandOverflow = 1;
		TclBNInitBignumFromWideUInt(&significandBig, significandWide);







>






|







946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
	case EXPONENT_SIGNUM:
	case sI:
	case sIN:
	case sINFI:
	case sINFIN:
	case sINFINI:
	case sINFINIT:
#ifdef IEEE_FLOATING_POINT
	case sN:
	case sNA:
	case sNANPAREN:
	case sNANHEX:
	    Tcl_Panic("TclParseNumber: bad acceptState %d parsing '%s'",
		    acceptState, bytes);
#endif
	case BINARY:
	    shift = numTrailZeros;
	    if (!significandOverflow && significandWide != 0 &&
		    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
		    significandWide > (MOST_BITS + signum) >> shift)) {
		significandOverflow = 1;
		TclBNInitBignumFromWideUInt(&significandBig, significandWide);
1137
1138
1139
1140
1141
1142
1143

1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
		objPtr->internalRep.doubleValue = -HUGE_VAL;
	    } else {
		objPtr->internalRep.doubleValue = HUGE_VAL;
	    }
	    objPtr->typePtr = &tclDoubleType;
	    break;


	case sNAN:
	case sNANFINISH:
	    objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
	    objPtr->typePtr = &tclDoubleType;
	    break;

	case INITIAL:
	    /* This case only to silence compiler warning */
	    Tcl_Panic("TclParseNumber: state INITIAL can't happen here");
	}
    }

    /*







>





|







1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
		objPtr->internalRep.doubleValue = -HUGE_VAL;
	    } else {
		objPtr->internalRep.doubleValue = HUGE_VAL;
	    }
	    objPtr->typePtr = &tclDoubleType;
	    break;

#ifdef IEEE_FLOATING_POINT
	case sNAN:
	case sNANFINISH:
	    objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
	    objPtr->typePtr = &tclDoubleType;
	    break;
#endif
	case INITIAL:
	    /* This case only to silence compiler warning */
	    Tcl_Panic("TclParseNumber: state INITIAL can't happen here");
	}
    }

    /*
1485
1486
1487
1488
1489
1490
1491
1492
1493



1494
1495
1496
1497
1498
1499
1500
    retval = BignumToBiasedFrExp(significand, &machexp);
    retval = Pow10TimesFrExp(exponent, retval, &machexp);
    if (machexp > DBL_MAX_EXP*log2FLT_RADIX) {
	retval = HUGE_VAL;
	goto returnValue;
    }
    retval = SafeLdExp(retval, machexp);
    if (retval <= 0.0) {
	retval = SafeLdExp(1.0, DBL_MIN_EXP * log2FLT_RADIX - mantBits);



    }

    /*
     * Refine the result twice. (The second refinement should be necessary
     * only if the best approximation is a power of 2 minus 1/2 ulp).
     */








|
|
>
>
>







1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
    retval = BignumToBiasedFrExp(significand, &machexp);
    retval = Pow10TimesFrExp(exponent, retval, &machexp);
    if (machexp > DBL_MAX_EXP*log2FLT_RADIX) {
	retval = HUGE_VAL;
	goto returnValue;
    }
    retval = SafeLdExp(retval, machexp);
	if (tiny == 0.0) {
	    tiny = SafeLdExp(1.0, DBL_MIN_EXP * log2FLT_RADIX - mantBits);
	}
    if (retval < tiny) {
	retval = tiny;
    }

    /*
     * Refine the result twice. (The second refinement should be necessary
     * only if the best approximation is a power of 2 minus 1/2 ulp).
     */

Changes to generic/tclStringObj.c.
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
     * Handle append of one bytearray object to another as a special case.
     * Note that we only do this when the objects don't have string reps; if
     * it did, then appending the byte arrays together could well lose
     * information; this is a special-case optimization only.
     */

    if (IS_PURE_BYTE_ARRAY(objPtr) && IS_PURE_BYTE_ARRAY(appendObjPtr)) {
	unsigned char *bytesDst, *bytesSrc;
	int lengthSrc, lengthTotal;

	/*
	 * We do not assume that objPtr and appendObjPtr must be distinct!
	 * This makes this code a bit more complex than it otherwise would be,
	 * but in turn makes it much safer.
	 */

	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
	(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);
	lengthTotal = length + lengthSrc;
	if (((length > lengthSrc) ? length : lengthSrc) > lengthTotal) {
	    Tcl_Panic("overflow when calculating byte array size");
	}
	bytesDst = Tcl_SetByteArrayLength(objPtr, lengthTotal);
	bytesSrc = Tcl_GetByteArrayFromObj(appendObjPtr, NULL);
	memcpy(bytesDst + length, bytesSrc, lengthSrc);
	return;
    }

    /*
     * Must append as strings.
     */








|












|

<

|







1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265

1266
1267
1268
1269
1270
1271
1272
1273
1274
     * Handle append of one bytearray object to another as a special case.
     * Note that we only do this when the objects don't have string reps; if
     * it did, then appending the byte arrays together could well lose
     * information; this is a special-case optimization only.
     */

    if (IS_PURE_BYTE_ARRAY(objPtr) && IS_PURE_BYTE_ARRAY(appendObjPtr)) {
	unsigned char *bytesSrc;
	int lengthSrc, lengthTotal;

	/*
	 * We do not assume that objPtr and appendObjPtr must be distinct!
	 * This makes this code a bit more complex than it otherwise would be,
	 * but in turn makes it much safer.
	 */

	(void) Tcl_GetByteArrayFromObj(objPtr, &length);
	(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);
	lengthTotal = length + lengthSrc;
	if (((length > lengthSrc) ? length : lengthSrc) > lengthTotal) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}

	bytesSrc = Tcl_GetByteArrayFromObj(appendObjPtr, NULL);
	TclAppendBytesToByteArray(objPtr, bytesSrc, lengthSrc);
	return;
    }

    /*
     * Must append as strings.
     */

Changes to generic/tclVar.c.
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84

static inline Var *
VarHashCreateVar(
    TclVarHashTable *tablePtr,
    Tcl_Obj *key,
    int *newPtr)
{
    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) tablePtr,
	    (char *) key, newPtr);

    if (hPtr) {
	return VarHashGetValue(hPtr);
    } else {
	return NULL;
    }
}

#define VarHashFindVar(tablePtr, key) \
    VarHashCreateVar((tablePtr), (key), NULL)

#define VarHashInvalidateEntry(varPtr) \
    ((varPtr)->flags |= VAR_DEAD_HASH)

#define VarHashDeleteEntry(varPtr) \
    Tcl_DeleteHashEntry(&(((VarInHash *) varPtr)->entry))

#define VarHashFirstEntry(tablePtr, searchPtr) \
    Tcl_FirstHashEntry((Tcl_HashTable *) (tablePtr), (searchPtr))

#define VarHashNextEntry(searchPtr) \
    Tcl_NextHashEntry((searchPtr))

static inline Var *
VarHashFirstVar(
    TclVarHashTable *tablePtr,







|



















|







50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84

static inline Var *
VarHashCreateVar(
    TclVarHashTable *tablePtr,
    Tcl_Obj *key,
    int *newPtr)
{
    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table,
	    (char *) key, newPtr);

    if (hPtr) {
	return VarHashGetValue(hPtr);
    } else {
	return NULL;
    }
}

#define VarHashFindVar(tablePtr, key) \
    VarHashCreateVar((tablePtr), (key), NULL)

#define VarHashInvalidateEntry(varPtr) \
    ((varPtr)->flags |= VAR_DEAD_HASH)

#define VarHashDeleteEntry(varPtr) \
    Tcl_DeleteHashEntry(&(((VarInHash *) varPtr)->entry))

#define VarHashFirstEntry(tablePtr, searchPtr) \
    Tcl_FirstHashEntry(&(tablePtr)->table, (searchPtr))

#define VarHashNextEntry(searchPtr) \
    Tcl_NextHashEntry((searchPtr))

static inline Var *
VarHashFirstVar(
    TclVarHashTable *tablePtr,
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
    }
}

#define VarHashGetKey(varPtr) \
    (((VarInHash *)(varPtr))->entry.key.objPtr)

#define VarHashDeleteTable(tablePtr) \
    Tcl_DeleteHashTable((Tcl_HashTable *) (tablePtr))

/*
 * The strings below are used to indicate what went wrong when a variable
 * access is denied.
 */

static const char *noSuchVar =		"no such variable";







|







106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
    }
}

#define VarHashGetKey(varPtr) \
    (((VarInHash *)(varPtr))->entry.key.objPtr)

#define VarHashDeleteTable(tablePtr) \
    Tcl_DeleteHashTable(&(tablePtr)->table)

/*
 * The strings below are used to indicate what went wrong when a variable
 * access is denied.
 */

static const char *noSuchVar =		"no such variable";
Changes to library/init.tcl.
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

if {[info commands package] == ""} {
    error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
package require -exact Tcl 8.6b1.1

# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
#
# The environment variable TCLLIBPATH
#
# tcl_library, which is the directory containing this init.tcl script.







|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

if {[info commands package] == ""} {
    error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
package require -exact Tcl 8.6b1.2

# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
#
# The environment variable TCLLIBPATH
#
# tcl_library, which is the directory containing this init.tcl script.
Changes to unix/Makefile.in.
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704

test: test-tcl test-packages

test-tcl: ${TCLTEST_EXE}
	$(SHELL_ENV) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl $(TESTFLAGS)

gdb-test: ${TCLTEST_EXE}
	@echo "set env @LD_LIBRARY_PATH_VAR@=\"`pwd`:$${@LD_LIBRARY_PATH_VAR@}\"" > gdb.run
	@echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
	@echo "set args $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) -singleproc 1" >> gdb.run
	$(GDB) ./${TCLTEST_EXE} --command=gdb.run
	rm gdb.run

# Useful target to launch a built tcltest with the proper path,...
runtest: ${TCLTEST_EXE}







|







690
691
692
693
694
695
696
697
698
699
700
701
702
703
704

test: test-tcl test-packages

test-tcl: ${TCLTEST_EXE}
	$(SHELL_ENV) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl $(TESTFLAGS)

gdb-test: ${TCLTEST_EXE}
	@echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > gdb.run
	@echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
	@echo "set args $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) -singleproc 1" >> gdb.run
	$(GDB) ./${TCLTEST_EXE} --command=gdb.run
	rm gdb.run

# Useful target to launch a built tcltest with the proper path,...
runtest: ${TCLTEST_EXE}
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.4.3 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.3.tm;
	@echo "Installing package tcltest 2.3.2 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.2.tm;

	@echo "Installing package platform 1.0.6 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.6.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm;

	@echo "Installing library encoding directory";
	@for i in $(TOP_DIR)/library/encoding/*.enc ; do \
		$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/encoding; \
	done;







|
|







852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.4.3 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.3.tm;
	@echo "Installing package tcltest 2.3.2 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.2.tm;

	@echo "Installing package platform 1.0.8 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.8.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm;

	@echo "Installing library encoding directory";
	@for i in $(TOP_DIR)/library/encoding/*.enc ; do \
		$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/encoding; \
	done;
Changes to unix/configure.
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345




TCL_VERSION=8.6
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=6
TCL_PATCH_LEVEL="b1.1"
VERSION=${TCL_VERSION}

#------------------------------------------------------------------------
# Setup configure arguments for bundled packages
#------------------------------------------------------------------------

PKG_CFG_ARGS="$ac_configure_args ${PKG_CFG_ARGS}"







|







1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345




TCL_VERSION=8.6
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=6
TCL_PATCH_LEVEL="b1.2"
VERSION=${TCL_VERSION}

#------------------------------------------------------------------------
# Setup configure arguments for bundled packages
#------------------------------------------------------------------------

PKG_CFG_ARGS="$ac_configure_args ${PKG_CFG_ARGS}"