Tcl Source Code

Check-in [83fa62555b]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug-3606683
Files: files | file ages | folders
SHA1: 83fa62555b20ba5cba75cf3bae7eb87bb8523d5f
User & Date: dgp 2013-03-06 20:25:37
Context
2013-03-06
20:50
3604074,3606683 Rewrite of the fixempties() routine (and supporting routines) to completely eliminat... check-in: 4d7eba11ad user: dgp tags: trunk
20:25
merge trunk Closed-Leaf check-in: 83fa62555b user: dgp tags: bug-3606683
20:19
Rework into Tcl 8.5+ coding style. check-in: e2e917cba4 user: dgp tags: bug-3606683
12:26
Tell fossil and Eclipse that the default eol-convention is LF. Tell fossil which files are binary a... check-in: da4c323ede user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added .fossil-settings/binary-glob.






>
>
>
1
2
3
*.bmp
*.gif
*.png

Added .fossil-settings/crnl-glob.

Added .fossil-settings/ignore-glob.






























>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
*.a
*.dll
*.exe
*.o
*.obj
*.so
*/Makefile
*/config.cache
*/config.log
*/config.status
*/tclConfig.sh
*/tclsh*
*/tcltest*
unix/dltest.marker
win/tcl.hpj

Added .project.






















>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
<?xml version="1.0" encoding="UTF-8"?>
<projectDescription>
	<name>tcl8.6</name>
	<comment></comment>
	<projects>
	</projects>
	<buildSpec>
	</buildSpec>
	<natures>
	</natures>
</projectDescription>

Added .settings/org.eclipse.core.resources.prefs.




>
>
1
2
eclipse.preferences.version=1
encoding/<project>=UTF-8

Added .settings/org.eclipse.core.runtime.prefs.




>
>
1
2
eclipse.preferences.version=1
line.separator=\n

Changes to generic/tclCompCmds.c.

345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
	Tcl_Obj *objPtr = Tcl_NewObj();
	char *bytes;
	int length, cmdLit;

	Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
	bytes = Tcl_GetStringFromObj(objPtr, &length);
	cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length);
	TclSetCmdNameObj(interp, envPtr->literalArrayPtr[cmdLit].objPtr,
		cmdPtr);
	TclEmitPush(cmdLit, envPtr);
	TclDecrRefCount(objPtr);
	if (localIndex >= 0) {
	    CompileWord(envPtr, varTokenPtr, interp, 1);
	} else {
	    TclEmitInstInt4(INST_REVERSE, 2,			envPtr);
	}






|
<







345
346
347
348
349
350
351
352

353
354
355
356
357
358
359
	Tcl_Obj *objPtr = Tcl_NewObj();
	char *bytes;
	int length, cmdLit;

	Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
	bytes = Tcl_GetStringFromObj(objPtr, &length);
	cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length);
	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);

	TclEmitPush(cmdLit, envPtr);
	TclDecrRefCount(objPtr);
	if (localIndex >= 0) {
	    CompileWord(envPtr, varTokenPtr, interp, 1);
	} else {
	    TclEmitInstInt4(INST_REVERSE, 2,			envPtr);
	}

Changes to generic/tclCompExpr.c.

2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
....
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
	    numWords = 1;	/* No arguments, so just the command */
	    break;
	case OT_LITERAL: {
	    Tcl_Obj *const *litObjv = *litObjvPtr;
	    Tcl_Obj *literal = *litObjv;

	    if (optimize) {
		int length, index;
		const char *bytes = TclGetStringFromObj(literal, &length);
		LiteralEntry *lePtr;
		Tcl_Obj *objPtr;

		index = TclRegisterNewLiteral(envPtr, bytes, length);
		lePtr = envPtr->literalArrayPtr + index;
		objPtr = lePtr->objPtr;
		if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
		    /*
		     * Would like to do this:
		     *
		     * lePtr->objPtr = literal;
		     * Tcl_IncrRefCount(literal);
		     * Tcl_DecrRefCount(objPtr);
................................................................................
		     */

		    if (objPtr->bytes) {
			Tcl_Obj *tableValue;

			index = TclRegisterNewLiteral(envPtr, objPtr->bytes,
				objPtr->length);
			tableValue = envPtr->literalArrayPtr[index].objPtr;
			if ((tableValue->typePtr == NULL) &&
				(objPtr->typePtr != NULL)) {
			    /*
			     * Same intrep surgery as for OT_LITERAL.
			     */

			    tableValue->typePtr = objPtr->typePtr;






|

|
|
|
<
<
<







 







|







2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452



2453
2454
2455
2456
2457
2458
2459
....
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
	    numWords = 1;	/* No arguments, so just the command */
	    break;
	case OT_LITERAL: {
	    Tcl_Obj *const *litObjv = *litObjvPtr;
	    Tcl_Obj *literal = *litObjv;

	    if (optimize) {
		int length;
		const char *bytes = TclGetStringFromObj(literal, &length);
		int index = TclRegisterNewLiteral(envPtr, bytes, length);
		Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
		



		if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
		    /*
		     * Would like to do this:
		     *
		     * lePtr->objPtr = literal;
		     * Tcl_IncrRefCount(literal);
		     * Tcl_DecrRefCount(objPtr);
................................................................................
		     */

		    if (objPtr->bytes) {
			Tcl_Obj *tableValue;

			index = TclRegisterNewLiteral(envPtr, objPtr->bytes,
				objPtr->length);
			tableValue = TclFetchLiteral(envPtr, index);
			if ((tableValue->typePtr == NULL) &&
				(objPtr->typePtr != NULL)) {
			    /*
			     * Same intrep surgery as for OT_LITERAL.
			     */

			    tableValue->typePtr = objPtr->typePtr;

Changes to generic/tclCompile.c.

553
554
555
556
557
558
559

560
561
562
563
564
565
566
....
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
....
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
....
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
....
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
....
2574
2575
2576
2577
2578
2579
2580


2581
2582
2583
2584
2585
2586
2587
2588
....
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
....
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
....
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
....
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
			    int cmdNumber, int srcOffset, int codeOffset);
static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS
static void		RecordByteCodeStats(ByteCode *codePtr);
#endif /* TCL_COMPILE_STATS */

static int		SetByteCodeFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static int		FormatInstruction(ByteCode *codePtr,
			    const unsigned char *pc, Tcl_Obj *bufferObj);
static void		PrintSourceToObj(Tcl_Obj *appendObj,
			    const char *stringPtr, int maxChars);
static void		UpdateStringOfInstName(Tcl_Obj *objPtr);
................................................................................
		     * 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
................................................................................
		     */

		    objIndex = TclRegisterNewLiteral(envPtr,
			    tokenPtr[1].start, tokenPtr[1].size);

		    if (envPtr->clNext) {
			TclContinuationsEnterDerived(
				envPtr->literalArrayPtr[objIndex].objPtr,
				tokenPtr[1].start - envPtr->source,
				eclPtr->loc[wlineat].next[wordIdx]);
		    }
		}
		TclEmitPush(objIndex, envPtr);
	    } /* for loop */

................................................................................
		int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);

		TclEmitPush(literal, envPtr);
		numObjsToConcat++;
		Tcl_DStringFree(&textBuffer);

		if (numCL) {
		    TclContinuationsEnter(
			    envPtr->literalArrayPtr[literal].objPtr, numCL,
			    clPosition);
		}
		numCL = 0;
	    }

	    TclCompileScript(interp, tokenPtr->start+1,
		    tokenPtr->size-2, envPtr);
	    numObjsToConcat++;
................................................................................

    if (Tcl_DStringLength(&textBuffer) > 0) {
	int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);

	TclEmitPush(literal, envPtr);
	numObjsToConcat++;
	if (numCL) {
	    TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
		    numCL, clPosition);
	}
	numCL = 0;
    }

    /*
     * If necessary, concatenate the parts of the word.
................................................................................
    p += sizeof(ByteCode);
    codePtr->codeStart = p;
    memcpy(p, envPtr->codeStart, (size_t) codeBytes);

    p += TCL_ALIGN(codeBytes);		/* align object array */
    codePtr->objArrayPtr = (Tcl_Obj **) p;
    for (i = 0;  i < numLitObjects;  i++) {


	if (objPtr == envPtr->literalArrayPtr[i].objPtr) {
	    /*
	     * Prevent circular reference where the bytecode intrep of
	     * a value contains a literal which is that same value.
	     * If this is allowed to happen, refcount decrements may not
	     * reach zero, and memory may leak.  Bugs 467523, 3357771
	     *
	     * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
................................................................................
	    int numBytes;
	    const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);

	    codePtr->objArrayPtr[i] = Tcl_NewStringObj(bytes, numBytes);
	    Tcl_IncrRefCount(codePtr->objArrayPtr[i]);
	    Tcl_DecrRefCount(objPtr);
	} else {
	    codePtr->objArrayPtr[i] = envPtr->literalArrayPtr[i].objPtr;
	}
    }

    p += TCL_ALIGN(objArrayBytes);	/* align exception range array */
    if (exceptArrayBytes > 0) {
	codePtr->exceptArrayPtr = (ExceptionRange *) p;
	memcpy(p, envPtr->exceptArrayPtr, (size_t) exceptArrayBytes);
................................................................................
{
    return &tclInstructionTable[0];
}
 
/*
 *--------------------------------------------------------------
 *
 * TclRegisterAuxDataType --
 *
 *	This procedure is called to register a new AuxData type in the table
 *	of all AuxData types supported by Tcl.
 *
 * Results:
 *	None.
 *
................................................................................
 *	The type is registered in the AuxData type table. If there was already
 *	a type with the same name as in typePtr, it is replaced with the new
 *	type.
 *
 *--------------------------------------------------------------
 */

void
TclRegisterAuxDataType(
    const AuxDataType *typePtr)	/* Information about object type; storage must
				 * be statically allocated (must live forever;
				 * will not be deallocated). */
{
    register Tcl_HashEntry *hPtr;
    int isNew;

................................................................................
    auxDataTypeTableInitialized = 1;
    Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);

    /*
     * There are only two AuxData type at this time, so register them here.
     */

    TclRegisterAuxDataType(&tclForeachInfoType);
    TclRegisterAuxDataType(&tclJumptableInfoType);
    TclRegisterAuxDataType(&tclDictUpdateInfoType);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeAuxDataTypeTable --
 *






>







 







|
<







 







|







 







|
<
|







 







|







 







>
>
|







 







|







 







|







 







|
|







 







|
|
|







553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
....
1892
1893
1894
1895
1896
1897
1898
1899

1900
1901
1902
1903
1904
1905
1906
....
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
....
2218
2219
2220
2221
2222
2223
2224
2225

2226
2227
2228
2229
2230
2231
2232
2233
....
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
....
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
....
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
....
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
....
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
....
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
			    int cmdNumber, int srcOffset, int codeOffset);
static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS
static void		RecordByteCodeStats(ByteCode *codePtr);
#endif /* TCL_COMPILE_STATS */
static void		RegisterAuxDataType(const AuxDataType *typePtr);
static int		SetByteCodeFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static int		FormatInstruction(ByteCode *codePtr,
			    const unsigned char *pc, Tcl_Obj *bufferObj);
static void		PrintSourceToObj(Tcl_Obj *appendObj,
			    const char *stringPtr, int maxChars);
static void		UpdateStringOfInstName(Tcl_Obj *objPtr);
................................................................................
		     * shimmering. 
		     */

		    objIndex = TclRegisterNewCmdLiteral(envPtr,
			    tokenPtr[1].start, tokenPtr[1].size);
		    if (cmdPtr != NULL) {
			TclSetCmdNameObj(interp,
				TclFetchLiteral(envPtr, objIndex), 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
................................................................................
		     */

		    objIndex = TclRegisterNewLiteral(envPtr,
			    tokenPtr[1].start, tokenPtr[1].size);

		    if (envPtr->clNext) {
			TclContinuationsEnterDerived(
				TclFetchLiteral(envPtr, objIndex),
				tokenPtr[1].start - envPtr->source,
				eclPtr->loc[wlineat].next[wordIdx]);
		    }
		}
		TclEmitPush(objIndex, envPtr);
	    } /* for loop */

................................................................................
		int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);

		TclEmitPush(literal, envPtr);
		numObjsToConcat++;
		Tcl_DStringFree(&textBuffer);

		if (numCL) {
		    TclContinuationsEnter(TclFetchLiteral(envPtr, literal),

			    numCL, clPosition);
		}
		numCL = 0;
	    }

	    TclCompileScript(interp, tokenPtr->start+1,
		    tokenPtr->size-2, envPtr);
	    numObjsToConcat++;
................................................................................

    if (Tcl_DStringLength(&textBuffer) > 0) {
	int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);

	TclEmitPush(literal, envPtr);
	numObjsToConcat++;
	if (numCL) {
	    TclContinuationsEnter(TclFetchLiteral(envPtr, literal),
		    numCL, clPosition);
	}
	numCL = 0;
    }

    /*
     * If necessary, concatenate the parts of the word.
................................................................................
    p += sizeof(ByteCode);
    codePtr->codeStart = p;
    memcpy(p, envPtr->codeStart, (size_t) codeBytes);

    p += TCL_ALIGN(codeBytes);		/* align object array */
    codePtr->objArrayPtr = (Tcl_Obj **) p;
    for (i = 0;  i < numLitObjects;  i++) {
	Tcl_Obj *fetched = TclFetchLiteral(envPtr, i);

	if (objPtr == fetched) {
	    /*
	     * Prevent circular reference where the bytecode intrep of
	     * a value contains a literal which is that same value.
	     * If this is allowed to happen, refcount decrements may not
	     * reach zero, and memory may leak.  Bugs 467523, 3357771
	     *
	     * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
................................................................................
	    int numBytes;
	    const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);

	    codePtr->objArrayPtr[i] = Tcl_NewStringObj(bytes, numBytes);
	    Tcl_IncrRefCount(codePtr->objArrayPtr[i]);
	    Tcl_DecrRefCount(objPtr);
	} else {
	    codePtr->objArrayPtr[i] = fetched;
	}
    }

    p += TCL_ALIGN(objArrayBytes);	/* align exception range array */
    if (exceptArrayBytes > 0) {
	codePtr->exceptArrayPtr = (ExceptionRange *) p;
	memcpy(p, envPtr->exceptArrayPtr, (size_t) exceptArrayBytes);
................................................................................
{
    return &tclInstructionTable[0];
}
 
/*
 *--------------------------------------------------------------
 *
 * RegisterAuxDataType --
 *
 *	This procedure is called to register a new AuxData type in the table
 *	of all AuxData types supported by Tcl.
 *
 * Results:
 *	None.
 *
................................................................................
 *	The type is registered in the AuxData type table. If there was already
 *	a type with the same name as in typePtr, it is replaced with the new
 *	type.
 *
 *--------------------------------------------------------------
 */

static void
RegisterAuxDataType(
    const AuxDataType *typePtr)	/* Information about object type; storage must
				 * be statically allocated (must live forever;
				 * will not be deallocated). */
{
    register Tcl_HashEntry *hPtr;
    int isNew;

................................................................................
    auxDataTypeTableInitialized = 1;
    Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);

    /*
     * There are only two AuxData type at this time, so register them here.
     */

    RegisterAuxDataType(&tclForeachInfoType);
    RegisterAuxDataType(&tclJumptableInfoType);
    RegisterAuxDataType(&tclDictUpdateInfoType);
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeAuxDataTypeTable --
 *

Changes to generic/tclCompile.h.

950
951
952
953
954
955
956

957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
...
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
MODULE_SCOPE void	TclEmitForwardJump(CompileEnv *envPtr,
			    TclJumpType jumpType, JumpFixup *jumpFixupPtr);
MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
			    int catchOnly, ByteCode *codePtr);
MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclNRExecuteByteCode(Tcl_Interp *interp,
			    ByteCode *codePtr);

MODULE_SCOPE void	TclFinalizeAuxDataTypeTable(void);
MODULE_SCOPE int	TclFindCompiledLocal(const char *name, int nameChars,
			    int create, CompileEnv *envPtr);
MODULE_SCOPE LiteralEntry * TclLookupLiteralEntry(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void	TclInitAuxDataTypeTable(void);
MODULE_SCOPE void	TclInitByteCodeObj(Tcl_Obj *objPtr,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclInitCompilation(void);
MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    int numBytes, const CmdFrame *invoker, int word);
MODULE_SCOPE void	TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void	TclInitLiteralTable(LiteralTable *tablePtr);
#ifdef TCL_COMPILE_STATS
MODULE_SCOPE char *	TclLiteralStats(LiteralTable *tablePtr);
................................................................................
#endif
MODULE_SCOPE int	TclPrintInstruction(ByteCode *codePtr,
			    const unsigned char *pc);
MODULE_SCOPE void	TclPrintObject(FILE *outFile,
			    Tcl_Obj *objPtr, int maxChars);
MODULE_SCOPE void	TclPrintSource(FILE *outFile,
			    const char *string, int maxChars);
MODULE_SCOPE void	TclRegisterAuxDataType(const AuxDataType *typePtr);
MODULE_SCOPE int	TclRegisterLiteral(CompileEnv *envPtr,
			    char *bytes, int length, int flags);
MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclInvalidateCmdLiteral(Tcl_Interp *interp, 
			    const char *name, Namespace *nsPtr);
MODULE_SCOPE int	TclSingleOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,






>



<
<








<







 







<







950
951
952
953
954
955
956
957
958
959
960


961
962
963
964
965
966
967
968

969
970
971
972
973
974
975
...
981
982
983
984
985
986
987

988
989
990
991
992
993
994
MODULE_SCOPE void	TclEmitForwardJump(CompileEnv *envPtr,
			    TclJumpType jumpType, JumpFixup *jumpFixupPtr);
MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
			    int catchOnly, ByteCode *codePtr);
MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclNRExecuteByteCode(Tcl_Interp *interp,
			    ByteCode *codePtr);
MODULE_SCOPE Tcl_Obj *	TclFetchLiteral(CompileEnv *envPtr, unsigned int index);
MODULE_SCOPE void	TclFinalizeAuxDataTypeTable(void);
MODULE_SCOPE int	TclFindCompiledLocal(const char *name, int nameChars,
			    int create, CompileEnv *envPtr);


MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void	TclInitAuxDataTypeTable(void);
MODULE_SCOPE void	TclInitByteCodeObj(Tcl_Obj *objPtr,
			    CompileEnv *envPtr);

MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    int numBytes, const CmdFrame *invoker, int word);
MODULE_SCOPE void	TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void	TclInitLiteralTable(LiteralTable *tablePtr);
#ifdef TCL_COMPILE_STATS
MODULE_SCOPE char *	TclLiteralStats(LiteralTable *tablePtr);
................................................................................
#endif
MODULE_SCOPE int	TclPrintInstruction(ByteCode *codePtr,
			    const unsigned char *pc);
MODULE_SCOPE void	TclPrintObject(FILE *outFile,
			    Tcl_Obj *objPtr, int maxChars);
MODULE_SCOPE void	TclPrintSource(FILE *outFile,
			    const char *string, int maxChars);

MODULE_SCOPE int	TclRegisterLiteral(CompileEnv *envPtr,
			    char *bytes, int length, int flags);
MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclInvalidateCmdLiteral(Tcl_Interp *interp, 
			    const char *name, Namespace *nsPtr);
MODULE_SCOPE int	TclSingleOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,

Changes to generic/tclEnsemble.c.

3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
....
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
....
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
	    PushLiteral(envPtr, bytes, length);
	} else if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    int literal = TclRegisterNewLiteral(envPtr,
		    tokPtr[1].start, tokPtr[1].size);

	    if (envPtr->clNext) {
		TclContinuationsEnterDerived(
			envPtr->literalArrayPtr[literal].objPtr,
			tokPtr[1].start - envPtr->source,
			mapPtr->loc[eclIndex].next[i]);
	    }
	    TclEmitPush(literal, envPtr);
	} else {
	    if (envPtr->clNext) {
		SetLineInformation(i);
................................................................................
     * the implementation.
     */

    objPtr = Tcl_NewObj();
    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
    bytes = Tcl_GetStringFromObj(objPtr, &length);
    cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length);
    TclSetCmdNameObj(interp, envPtr->literalArrayPtr[cmdLit].objPtr, cmdPtr);
    TclEmitPush(cmdLit, envPtr);
    TclDecrRefCount(objPtr);

    /*
     * Do the replacing dispatch.
     */

................................................................................
     * the implementation.
     */

    objPtr = Tcl_NewObj();
    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
    bytes = Tcl_GetStringFromObj(objPtr, &length);
    literal = TclRegisterNewCmdLiteral(envPtr, bytes, length);
    TclSetCmdNameObj(interp, envPtr->literalArrayPtr[literal].objPtr, cmdPtr);
    TclEmitPush(literal, envPtr);
    TclDecrRefCount(objPtr);

    /*
     * Push the words of the command.
     */







|







 







|







 







|







3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
....
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
....
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
	    PushLiteral(envPtr, bytes, length);
	} else if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    int literal = TclRegisterNewLiteral(envPtr,
		    tokPtr[1].start, tokPtr[1].size);

	    if (envPtr->clNext) {
		TclContinuationsEnterDerived(
			TclFetchLiteral(envPtr, literal),
			tokPtr[1].start - envPtr->source,
			mapPtr->loc[eclIndex].next[i]);
	    }
	    TclEmitPush(literal, envPtr);
	} else {
	    if (envPtr->clNext) {
		SetLineInformation(i);
................................................................................
     * the implementation.
     */

    objPtr = Tcl_NewObj();
    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
    bytes = Tcl_GetStringFromObj(objPtr, &length);
    cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length);
    TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
    TclEmitPush(cmdLit, envPtr);
    TclDecrRefCount(objPtr);

    /*
     * Do the replacing dispatch.
     */

................................................................................
     * the implementation.
     */

    objPtr = Tcl_NewObj();
    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
    bytes = Tcl_GetStringFromObj(objPtr, &length);
    literal = TclRegisterNewCmdLiteral(envPtr, bytes, length);
    TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, literal), cmdPtr);
    TclEmitPush(literal, envPtr);
    TclDecrRefCount(objPtr);

    /*
     * Push the words of the command.
     */

Changes to generic/tclLiteral.c.

28
29
30
31
32
33
34




35
36
37
38
39
40
41
...
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
...
293
294
295
296
297
298
299



























300
301
302
303
304
305
306
...
410
411
412
413
414
415
416

417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
...
452
453
454
455
456
457
458

459
460
461
462
463
464
465
....
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
 * Function prototypes for static functions in this file:
 */

static int		AddLocalLiteralEntry(CompileEnv *envPtr,
			    Tcl_Obj *objPtr, int localHash);
static void		ExpandLocalLiteralArray(CompileEnv *envPtr);
static unsigned		HashString(const char *string, int length);




static void		RebuildLiteralTable(LiteralTable *tablePtr);
 
/*
 *----------------------------------------------------------------------
 *
 * TclInitLiteralTable --
 *
................................................................................
	objPtr->bytes = bytes;
	objPtr->length = length;
    } else {
	TclInitStringRep(objPtr, bytes, length);
    }

#ifdef TCL_COMPILE_DEBUG
    if (TclLookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
	Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
		"TclRegisterLiteral", (length>60? 60 : length), bytes);
    }
#endif

    globalPtr = ckalloc(sizeof(LiteralEntry));
    globalPtr->objPtr = objPtr;
................................................................................

    if (globalPtrPtr) {
	*globalPtrPtr = globalPtr;
    }
    *newPtr = 1;
    return objPtr;
}



























 
/*
 *----------------------------------------------------------------------
 *
 * TclRegisterLiteral --
 *
 *	Find, or if necessary create, an object in a CompileEnv literal array
................................................................................
		globalPtr->refCount);
    }
    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/
    return objIndex;
}
 

/*
 *----------------------------------------------------------------------
 *
 * TclLookupLiteralEntry --
 *
 *	Finds the LiteralEntry that corresponds to a literal Tcl object
 *	holding a literal.
 *
 * Results:
 *	Returns the matching LiteralEntry if found, otherwise NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

LiteralEntry *
TclLookupLiteralEntry(
    Tcl_Interp *interp,		/* Interpreter for which objPtr was created to
				 * hold a literal. */
    register Tcl_Obj *objPtr)	/* Points to a Tcl object holding a literal
				 * that was previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
................................................................................
	if (entryPtr->objPtr == objPtr) {
	    return entryPtr;
	}
    }
    return NULL;
}
 

/*
 *----------------------------------------------------------------------
 *
 * TclHideLiteral --
 *
 *	Remove a literal entry from the literal hash tables, leaving it in the
 *	literal array so existing references continue to function. This makes
................................................................................
	    count++;
	    if (localPtr->refCount != -1) {
		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
		Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d",
			"TclVerifyLocalLiteralTable",
			(length>60? 60 : length), bytes, localPtr->refCount);
	    }
	    if (TclLookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
		    localPtr->objPtr) == NULL) {
		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
		Tcl_Panic("%s: local literal \"%.*s\" is not global",
			"TclVerifyLocalLiteralTable",
			(length>60? 60 : length), bytes);
	    }
	    if (localPtr->objPtr->bytes == NULL) {






>
>
>
>







 







|







 







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







 







>



|













|
|







 







>







 







|







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
...
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
...
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
...
441
442
443
444
445
446
447
448
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
...
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
....
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
 * Function prototypes for static functions in this file:
 */

static int		AddLocalLiteralEntry(CompileEnv *envPtr,
			    Tcl_Obj *objPtr, int localHash);
static void		ExpandLocalLiteralArray(CompileEnv *envPtr);
static unsigned		HashString(const char *string, int length);
#ifdef TCL_COMPILE_DEBUG
static LiteralEntry *	LookupLiteralEntry(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
#endif
static void		RebuildLiteralTable(LiteralTable *tablePtr);
 
/*
 *----------------------------------------------------------------------
 *
 * TclInitLiteralTable --
 *
................................................................................
	objPtr->bytes = bytes;
	objPtr->length = length;
    } else {
	TclInitStringRep(objPtr, bytes, length);
    }

#ifdef TCL_COMPILE_DEBUG
    if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
	Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
		"TclRegisterLiteral", (length>60? 60 : length), bytes);
    }
#endif

    globalPtr = ckalloc(sizeof(LiteralEntry));
    globalPtr->objPtr = objPtr;
................................................................................

    if (globalPtrPtr) {
	*globalPtrPtr = globalPtr;
    }
    *newPtr = 1;
    return objPtr;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFetchLiteral --
 *
 *	Fetch from a CompileEnv the literal value identified by an index
 *	value, as returned by a prior call to TclRegisterLiteral().
 *
 * Results:
 *	The literal value, or NULL if the index is out of range.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclFetchLiteral(
    CompileEnv *envPtr,		/* Points to the CompileEnv from which to
				 * fetch the registered literal value. */
    unsigned int index)		/* Index of the desired literal, as returned
				 * by prior call to TclRegisterLiteral() */
{
    if (index >= envPtr->literalArrayNext) {
	return NULL;
    }
    return envPtr->literalArrayPtr[index].objPtr;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclRegisterLiteral --
 *
 *	Find, or if necessary create, an object in a CompileEnv literal array
................................................................................
		globalPtr->refCount);
    }
    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/
    return objIndex;
}
 
#ifdef TCL_COMPILE_DEBUG
/*
 *----------------------------------------------------------------------
 *
 * LookupLiteralEntry --
 *
 *	Finds the LiteralEntry that corresponds to a literal Tcl object
 *	holding a literal.
 *
 * Results:
 *	Returns the matching LiteralEntry if found, otherwise NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static LiteralEntry *
LookupLiteralEntry(
    Tcl_Interp *interp,		/* Interpreter for which objPtr was created to
				 * hold a literal. */
    register Tcl_Obj *objPtr)	/* Points to a Tcl object holding a literal
				 * that was previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
................................................................................
	if (entryPtr->objPtr == objPtr) {
	    return entryPtr;
	}
    }
    return NULL;
}
 
#endif
/*
 *----------------------------------------------------------------------
 *
 * TclHideLiteral --
 *
 *	Remove a literal entry from the literal hash tables, leaving it in the
 *	literal array so existing references continue to function. This makes
................................................................................
	    count++;
	    if (localPtr->refCount != -1) {
		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
		Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d",
			"TclVerifyLocalLiteralTable",
			(length>60? 60 : length), bytes, localPtr->refCount);
	    }
	    if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
		    localPtr->objPtr) == NULL) {
		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
		Tcl_Panic("%s: local literal \"%.*s\" is not global",
			"TclVerifyLocalLiteralTable",
			(length>60? 60 : length), bytes);
	    }
	    if (localPtr->objPtr->bytes == NULL) {