Tcl Source Code

Check-in [396ccb299c]
Login

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 | novem
Files: files | file ages | folders
SHA1: 396ccb299c1e0c338717c05364e26ce8a3a7e9a7
User & Date: jan.nijtmans 2013-08-02 10:33:28
Context
2013-08-13
19:26
[0aa8f12dcc] Restore minimum code to stop failing tests. check-in: a64f1e873a user: dgp tags: novem
2013-08-02
10:33
merge trunk check-in: 396ccb299c user: jan.nijtmans tags: novem
2013-08-01
19:18
[1905562] [8d2c0da36d] Raise the recursion limits on regexps to allow existing regexps "in the wild"... check-in: b7100ded1f user: dgp tags: trunk
2013-07-23
09:49
merge trunk check-in: 2dd21b756d user: jan.nijtmans tags: novem
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.







1
2
3
4
5
6
7






2013-07-05  Kevin B. Kenny  <[email protected]>

	* library/tzdata/Africa/Casablanca:
	* library/tzdata/America/Asuncion:
	* library/tzdata/Antarctica/Macquarie:
	* library/tzdata/Asia/Gaza:
	* library/tzdata/Asia/Hebron:
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
2013-08-01  Harald Oehlmann  <[email protected]>

	* tclUnixNotify.c Tcl_InitNotifier: Bug [a0bc856dcd]
	  Start notifier thread again if we were forked, to solve Rivet bug
	  55153.

2013-07-05  Kevin B. Kenny  <[email protected]>

	* library/tzdata/Africa/Casablanca:
	* library/tzdata/America/Asuncion:
	* library/tzdata/Antarctica/Macquarie:
	* library/tzdata/Asia/Gaza:
	* library/tzdata/Asia/Hebron:

Changes to generic/regc_nfa.c.

820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
    }

    /*
     * Arbitrary depth limit. Needs tuning, but this value is sufficient to
     * make all normal tests (not reg-33.14) pass.
     */
#ifndef DUPTRAVERSE_MAX_DEPTH
#define DUPTRAVERSE_MAX_DEPTH 700
#endif

    if (depth++ > DUPTRAVERSE_MAX_DEPTH) {
	NERR(REG_ESPACE);
    }

    for (a=s->outs ; a!=NULL && !NISERR() ; a=a->outchain) {







|







820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
    }

    /*
     * Arbitrary depth limit. Needs tuning, but this value is sufficient to
     * make all normal tests (not reg-33.14) pass.
     */
#ifndef DUPTRAVERSE_MAX_DEPTH
#define DUPTRAVERSE_MAX_DEPTH 15000
#endif

    if (depth++ > DUPTRAVERSE_MAX_DEPTH) {
	NERR(REG_ESPACE);
    }

    for (a=s->outs ; a!=NULL && !NISERR() ; a=a->outchain) {

Changes to generic/regexec.c.

500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
		    return REG_OKAY;
		}
		if (er != REG_NOMATCH) {
		    ERR(er);
		    return er;
		}
		if ((shorter) ? end == estop : end == begin) {
		    /*
		     * No point in trying again.
		     */

		    *coldp = cold;
		    return REG_NOMATCH;
		}

		/*
		 * Go around and try again
		 */

		if (shorter) {







<
<
<
|
<
<







500
501
502
503
504
505
506



507


508
509
510
511
512
513
514
		    return REG_OKAY;
		}
		if (er != REG_NOMATCH) {
		    ERR(er);
		    return er;
		}
		if ((shorter) ? end == estop : end == begin) {



		    break;


		}

		/*
		 * Go around and try again
		 */

		if (shorter) {

Changes to generic/tclAssembly.c.

926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;	/* Token in the input script */

#if 1
    int numCommands = envPtr->numCommands;
    int offset = envPtr->codeNext - envPtr->codeStart;
    int depth = envPtr->currStackDepth;
#endif

    /*
     * Make sure that the command has a single arg that is a simple word.
     */

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;







<



<







926
927
928
929
930
931
932

933
934
935

936
937
938
939
940
941
942
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;	/* Token in the input script */


    int numCommands = envPtr->numCommands;
    int offset = envPtr->codeNext - envPtr->codeStart;
    int depth = envPtr->currStackDepth;


    /*
     * Make sure that the command has a single arg that is a simple word.
     */

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
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
978
     * Compile the code and convert any error from the compilation into
     * bytecode reporting the error;
     */

    if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
	    tokenPtr[1].size, TCL_EVAL_DIRECT)) {

#if 1
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"%.*s\" body, line %d)",
		parsePtr->tokenPtr->size, parsePtr->tokenPtr->start,
		Tcl_GetErrorLine(interp)));
	envPtr->numCommands = numCommands;
	envPtr->codeNext = envPtr->codeStart + offset;
	envPtr->currStackDepth = depth;
	TclCompileSyntaxError(interp, envPtr);
#else
	Tcl_ResetResult(interp);
	return TCL_ERROR;
#endif
    }
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *







<








<
<
<
<







950
951
952
953
954
955
956

957
958
959
960
961
962
963
964




965
966
967
968
969
970
971
     * Compile the code and convert any error from the compilation into
     * bytecode reporting the error;
     */

    if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
	    tokenPtr[1].size, TCL_EVAL_DIRECT)) {


	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"%.*s\" body, line %d)",
		parsePtr->tokenPtr->size, parsePtr->tokenPtr->start,
		Tcl_GetErrorLine(interp)));
	envPtr->numCommands = numCommands;
	envPtr->codeNext = envPtr->codeStart + offset;
	envPtr->currStackDepth = depth;
	TclCompileSyntaxError(interp, envPtr);




    }
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
    BasicBlock* jumpTargetBBPtr;
				/* Basic block that the jump proceeds to */
    int junk;

    auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1);
    DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n",
	    bbPtr, bbPtr->jumpOffset, auxDataIndex);
    realJumpTablePtr = envPtr->auxDataArrayPtr[auxDataIndex].clientData;
    realJumpHashPtr = &realJumpTablePtr->hashTable;

    /*
     * Look up every jump target in the jump hash.
     */

    DEBUG_PRINT("resolve jump table {\n");







|







3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
    BasicBlock* jumpTargetBBPtr;
				/* Basic block that the jump proceeds to */
    int junk;

    auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1);
    DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n",
	    bbPtr, bbPtr->jumpOffset, auxDataIndex);
    realJumpTablePtr = TclFetchAuxData(envPtr, auxDataIndex);
    realJumpHashPtr = &realJumpTablePtr->hashTable;

    /*
     * Look up every jump target in the jump hash.
     */

    DEBUG_PRINT("resolve jump table {\n");

Changes to generic/tclCompCmds.c.

83
84
85
86
87
88
89

90
91
92
93
94
95
96
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int isScalar, localIndex, numWords, i;
    DefineLineInformation;	/* TIP #280 */


    numWords = parsePtr->numWords;
    if (numWords == 1) {
	return TCL_ERROR;
    } else if (numWords == 2) {
	/*
	 * append varName == set varName
	 */







>







83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int isScalar, localIndex, numWords, i;
    DefineLineInformation;	/* TIP #280 */

    /* TODO: Consider support for compiling expanded args. */
    numWords = parsePtr->numWords;
    if (numWords == 1) {
	return TCL_ERROR;
    } else if (numWords == 2) {
	/*
	 * append varName == set varName
	 */
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    JumpFixup jumpFixup;
    Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
    int resultIndex, optsIndex, range;
    int initStackDepth = envPtr->currStackDepth;
    DefineLineInformation;	/* TIP #280 */

    /*
     * If syntax does not match what we expect for [catch], do not compile.
     * Let runtime checks determine if syntax has changed.
     */








<







541
542
543
544
545
546
547

548
549
550
551
552
553
554
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    JumpFixup jumpFixup;
    Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
    int resultIndex, optsIndex, range;

    DefineLineInformation;	/* TIP #280 */

    /*
     * If syntax does not match what we expect for [catch], do not compile.
     * Let runtime checks determine if syntax has changed.
     */

738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
     */

    if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
    }

    /* 
     * Result of all this, on either branch, should have been to leave one
     * operand -- the return code -- on the stack.
     */

    if (envPtr->currStackDepth != initStackDepth + 1) {
	Tcl_Panic("in TclCompileCatchCmd, currStackDepth = %d should be %d",
		  envPtr->currStackDepth, initStackDepth+1);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileContinueCmd --







<
<
<
<
<
<
<
<
<







738
739
740
741
742
743
744









745
746
747
748
749
750
751
     */

    if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
    }










    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileContinueCmd --
979
980
981
982
983
984
985

986
987
988
989
990
991
992
    DefineLineInformation;	/* TIP #280 */

    /*
     * There must be at least two arguments after the command (the single-arg
     * case is legal, but too special and magic for us to deal with here).
     */


    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    numWords = parsePtr->numWords-1;

    /*







>







970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
    DefineLineInformation;	/* TIP #280 */

    /*
     * There must be at least two arguments after the command (the single-arg
     * case is legal, but too special and magic for us to deal with here).
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    numWords = parsePtr->numWords-1;

    /*
1016
1017
1018
1019
1020
1021
1022

1023
1024
1025
1026
1027
1028
1029
    DefineLineInformation;	/* TIP #280 */

    /*
     * There must be at least two arguments after the command (the single-arg
     * case is legal, but too special and magic for us to deal with here).
     */


    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    numWords = parsePtr->numWords-1;

    /*







>







1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
    DefineLineInformation;	/* TIP #280 */

    /*
     * There must be at least two arguments after the command (the single-arg
     * case is legal, but too special and magic for us to deal with here).
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    numWords = parsePtr->numWords-1;

    /*
1053
1054
1055
1056
1057
1058
1059

1060
1061
1062
1063
1064
1065
1066
    int i, dictVarIndex;

    /*
     * There must be at least one argument after the variable name for us to
     * compile to bytecode.
     */


    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }

    /*
     * The dictionary variable must be a local scalar that is knowable at
     * compile time; anything else exceeds the complexity of the opcode. So







>







1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
    int i, dictVarIndex;

    /*
     * There must be at least one argument after the variable name for us to
     * compile to bytecode.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }

    /*
     * The dictionary variable must be a local scalar that is knowable at
     * compile time; anything else exceeds the complexity of the opcode. So
1198
1199
1200
1201
1202
1203
1204

1205
1206
1207
1208
1209
1210
1211
    int i, workerIndex, infoIndex, outLoop;

    /*
     * Deal with some special edge cases. Note that in the case with one
     * argument, the only thing to do is to verify the dict-ness.
     */


    if (parsePtr->numWords < 2) {
	PushStringLiteral(envPtr, "");
	return TCL_OK;
    } else if (parsePtr->numWords == 2) {
	tokenPtr = TokenAfter(parsePtr->tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 1);
	TclEmitOpcode(		INST_DUP,			envPtr);







>







1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
    int i, workerIndex, infoIndex, outLoop;

    /*
     * Deal with some special edge cases. Note that in the case with one
     * argument, the only thing to do is to verify the dict-ness.
     */

    /* TODO: Consider support for compiling expanded args. (less likely) */
    if (parsePtr->numWords < 2) {
	PushStringLiteral(envPtr, "");
	return TCL_OK;
    } else if (parsePtr->numWords == 2) {
	tokenPtr = TokenAfter(parsePtr->tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 1);
	TclEmitOpcode(		INST_DUP,			envPtr);
1718
1719
1720
1721
1722
1723
1724

1725
1726
1727
1728
1729
1730
1731

    /*
     * There must be at least two argument after the command. And we impose an
     * (arbirary) safe limit; anyone exceeding it should stop worrying about
     * speed quite so much. ;-)
     */


    if (parsePtr->numWords<4 || parsePtr->numWords>100) {
	return TCL_ERROR;
    }

    /*
     * Get the index of the local variable that we will be working with.
     */







>







1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727

    /*
     * There must be at least two argument after the command. And we impose an
     * (arbirary) safe limit; anyone exceeding it should stop worrying about
     * speed quite so much. ;-)
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords<4 || parsePtr->numWords>100) {
	return TCL_ERROR;
    }

    /*
     * Get the index of the local variable that we will be working with.
     */
1770
1771
1772
1773
1774
1775
1776


1777
1778
1779
1780
1781
1782
1783
    Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr;
    int dictVarIndex;

    /*
     * There must be three arguments after the command.
     */



    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }

    /*
     * Parse the arguments.
     */







>
>







1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
    Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr;
    int dictVarIndex;

    /*
     * There must be three arguments after the command.
     */

    /* TODO: Consider support for compiling expanded args. */
    /* Probably not.  Why is INST_DICT_LAPPEND limited to one value? */
    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }

    /*
     * Parse the arguments.
     */
1816
1817
1818
1819
1820
1821
1822

1823
1824
1825
1826
1827
1828
1829
    JumpFixup jumpFixup;
    const char *ptr, *end;

    /*
     * There must be at least one argument after the command.
     */


    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }

    /*
     * Parse the command (trivially). Expect the following:
     *   dict with <any (varName)> ?<any> ...? <literal>







>







1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
    JumpFixup jumpFixup;
    const char *ptr, *end;

    /*
     * There must be at least one argument after the command.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }

    /*
     * Parse the command (trivially). Expect the following:
     *   dict with <any (varName)> ?<any> ...? <literal>

Changes to generic/tclCompCmdsGR.c.

56
57
58
59
60
61
62

63
64
65
66
67
68
69
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr;
    int localIndex, numWords, i;
    DefineLineInformation;	/* TIP #280 */


    numWords = parsePtr->numWords;
    if (numWords < 2) {
	return TCL_ERROR;
    }

    /*
     * 'global' has no effect outside of proc bodies; handle that at runtime







>







56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr;
    int localIndex, numWords, i;
    DefineLineInformation;	/* TIP #280 */

    /* TODO: Consider support for compiling expanded args. */
    numWords = parsePtr->numWords;
    if (numWords < 2) {
	return TCL_ERROR;
    }

    /*
     * 'global' has no effect outside of proc bodies; handle that at runtime
816
817
818
819
820
821
822

823
824
825
826
827
828
829
     * If we're not in a procedure, don't compile.
     */

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }


    numWords = parsePtr->numWords;
    if (numWords == 1) {
	return TCL_ERROR;
    }
    if (numWords != 3) {
	/*
	 * LAPPEND instructions currently only handle one value, but we can







>







817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
     * If we're not in a procedure, don't compile.
     */

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    /* TODO: Consider support for compiling expanded args. */
    numWords = parsePtr->numWords;
    if (numWords == 1) {
	return TCL_ERROR;
    }
    if (numWords != 3) {
	/*
	 * LAPPEND instructions currently only handle one value, but we can
1057
1058
1059
1060
1061
1062
1063

1064
1065
1066
1067
1068
1069
1070
    int i, numWords = parsePtr->numWords;
    DefineLineInformation;	/* TIP #280 */

    /*
     * Quit if too few args.
     */


    if (numWords <= 1) {
	return TCL_ERROR;
    }

    valTokenPtr = TokenAfter(parsePtr->tokenPtr);
    if (numWords != 3) {
	goto emitComplexLindex;







>







1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
    int i, numWords = parsePtr->numWords;
    DefineLineInformation;	/* TIP #280 */

    /*
     * Quit if too few args.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (numWords <= 1) {
	return TCL_ERROR;
    }

    valTokenPtr = TokenAfter(parsePtr->tokenPtr);
    if (numWords != 3) {
	goto emitComplexLindex;
1579
1580
1581
1582
1583
1584
1585

1586
1587
1588
1589
1590
1591
1592
    int i;
    DefineLineInformation;	/* TIP #280 */

    /*
     * Check argument count.
     */


    if (parsePtr->numWords < 3) {
	/*
	 * Fail at run time, not in compilation.
	 */

	return TCL_ERROR;
    }







>







1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
    int i;
    DefineLineInformation;	/* TIP #280 */

    /*
     * Check argument count.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords < 3) {
	/*
	 * Fail at run time, not in compilation.
	 */

	return TCL_ERROR;
    }

Changes to generic/tclCompCmdsSZ.c.

987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
 *	semantics right, or when we know for sure that it is an error but need
 *	the error to happen at the right time).
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "switch" command at
 *	runtime.
 *
 * FIXME:
 *	Stack depths are probably not calculated correctly.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileSwitchCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command







<
<
<







987
988
989
990
991
992
993



994
995
996
997
998
999
1000
 *	semantics right, or when we know for sure that it is an error but need
 *	the error to happen at the right time).
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "switch" command at
 *	runtime.
 *



 *----------------------------------------------------------------------
 */

int
TclCompileSwitchCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
2817
2818
2819
2820
2821
2822
2823

2824
2825
2826
2827
2828
2829
2830
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr;
    int isScalar, localIndex, numWords, flags, i;
    Tcl_Obj *leadingWord;
    DefineLineInformation;	/* TIP #280 */


    numWords = parsePtr->numWords-1;
    flags = 1;
    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    leadingWord = Tcl_NewObj();
    if (numWords > 0 && TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
	int len;
	const char *bytes = Tcl_GetStringFromObj(leadingWord, &len);







>







2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr;
    int isScalar, localIndex, numWords, flags, i;
    Tcl_Obj *leadingWord;
    DefineLineInformation;	/* TIP #280 */

    /* TODO: Consider support for compiling expanded args. */
    numWords = parsePtr->numWords-1;
    flags = 1;
    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    leadingWord = Tcl_NewObj();
    if (numWords > 0 && TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
	int len;
	const char *bytes = Tcl_GetStringFromObj(leadingWord, &len);
3172
3173
3174
3175
3176
3177
3178

3179
3180
3181
3182
3183
3184
3185
    int instruction,
    CompileEnv *envPtr)
{
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int words;


    for (words=1 ; words<parsePtr->numWords ; words++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, words);
    }
    if (parsePtr->numWords <= 2) {
	PushLiteral(envPtr, identity, -1);
	words++;







>







3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
    int instruction,
    CompileEnv *envPtr)
{
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int words;

    /* TODO: Consider support for compiling expanded args. */
    for (words=1 ; words<parsePtr->numWords ; words++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, words);
    }
    if (parsePtr->numWords <= 2) {
	PushLiteral(envPtr, identity, -1);
	words++;
3255
3256
3257
3258
3259
3260
3261

3262
3263
3264
3265
3266
3267
3268
    Tcl_Parse *parsePtr,
    int instruction,
    CompileEnv *envPtr)
{
    Tcl_Token *tokenPtr;
    DefineLineInformation;	/* TIP #280 */


    if (parsePtr->numWords < 3) {
	PUSH("1");
    } else if (parsePtr->numWords == 3) {
	tokenPtr = TokenAfter(parsePtr->tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 1);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 2);







>







3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
    Tcl_Parse *parsePtr,
    int instruction,
    CompileEnv *envPtr)
{
    Tcl_Token *tokenPtr;
    DefineLineInformation;	/* TIP #280 */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords < 3) {
	PUSH("1");
    } else if (parsePtr->numWords == 3) {
	tokenPtr = TokenAfter(parsePtr->tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 1);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 2);
3592
3593
3594
3595
3596
3597
3598

3599
3600
3601
3602
3603
3604
3605
				 * compiled. */
    CompileEnv *envPtr)
{
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int words;


    if (parsePtr->numWords == 1) {
	/*
	 * Fallback to direct eval to report syntax error.
	 */

	return TCL_ERROR;
    }







>







3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
				 * compiled. */
    CompileEnv *envPtr)
{
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int words;

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords == 1) {
	/*
	 * Fallback to direct eval to report syntax error.
	 */

	return TCL_ERROR;
    }
3637
3638
3639
3640
3641
3642
3643

3644
3645
3646
3647
3648
3649
3650
				 * compiled. */
    CompileEnv *envPtr)
{
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int words;


    if (parsePtr->numWords == 1) {
	/*
	 * Fallback to direct eval to report syntax error.
	 */

	return TCL_ERROR;
    }







>







3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
				 * compiled. */
    CompileEnv *envPtr)
{
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int words;

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords == 1) {
	/*
	 * Fallback to direct eval to report syntax error.
	 */

	return TCL_ERROR;
    }

Changes to generic/tclCompile.c.

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <assert.h>

#define REWRITE

/*
 * Table of all AuxData types.
 */

static Tcl_HashTable auxDataTypeTable;
static int auxDataTypeTableInitialized; /* 0 means not yet initialized. */








<
<







12
13
14
15
16
17
18


19
20
21
22
23
24
25
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"
#include <assert.h>



/*
 * Table of all AuxData types.
 */

static Tcl_HashTable auxDataTypeTable;
static int auxDataTypeTableInitialized; /* 0 means not yet initialized. */

560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
			    Tcl_Obj *copyPtr);
static unsigned char *	EncodeCmdLocMap(CompileEnv *envPtr,
			    ByteCode *codePtr, unsigned char *startPtr);
static void		EnterCmdExtentData(CompileEnv *envPtr,
			    int cmdNumber, int numSrcBytes, int numCodeBytes);
static void		EnterCmdStartData(CompileEnv *envPtr,
			    int cmdNumber, int srcOffset, int codeOffset);
#ifndef REWRITE
static Command *	FindCompiledCommandFromToken(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr);
#endif
static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
static int		IsCompactibleCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS
static void		RecordByteCodeStats(ByteCode *codePtr);







<
<
<
<







558
559
560
561
562
563
564




565
566
567
568
569
570
571
			    Tcl_Obj *copyPtr);
static unsigned char *	EncodeCmdLocMap(CompileEnv *envPtr,
			    ByteCode *codePtr, unsigned char *startPtr);
static void		EnterCmdExtentData(CompileEnv *envPtr,
			    int cmdNumber, int numSrcBytes, int numCodeBytes);
static void		EnterCmdStartData(CompileEnv *envPtr,
			    int cmdNumber, int srcOffset, int codeOffset);




static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
static int		IsCompactibleCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS
static void		RecordByteCodeStats(ByteCode *codePtr);
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
    if (valuePtr != NULL) {
	Tcl_AppendObjToObj(valuePtr, tempPtr);
	Tcl_DecrRefCount(tempPtr);
    }
    return 1;
}

#ifndef REWRITE
/*
 * ---------------------------------------------------------------------
 *
 * FindCompiledCommandFromToken --
 *
 *	A simple helper that looks up a command's compiler from its token.
 *
 * ---------------------------------------------------------------------
 */

static Command *
FindCompiledCommandFromToken(
    Tcl_Interp *interp,
    Tcl_Token *tokenPtr)
{
    Tcl_DString ds;
    Command *cmdPtr;

    /*
     * If we have a non-trivial token or are suppressing compilation, we stop
     * right now.
     */

    if ((tokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
	    || (((Interp *) interp)->flags & DONT_COMPILE_CMDS_INLINE)) {
	return NULL;
    }

    /*
     * We copy the string before trying to find the command by name. We used
     * to modify the string in place, but this is not safe because the name
     * resolution handlers could have side effects that rely on the unmodified
     * string.
     */

    Tcl_DStringInit(&ds);
    TclDStringAppendToken(&ds, &tokenPtr[1]);
    cmdPtr = (Command *) Tcl_FindCommand(interp, Tcl_DStringValue(&ds), NULL,
	    /*flags*/ 0);
    if (cmdPtr != NULL && (cmdPtr->compileProc == NULL
	    || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION)
	    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES))) {
	cmdPtr = NULL;
    }
    Tcl_DStringFree(&ds);
    return cmdPtr;
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclCompileScript --
 *
 *	Compile a Tcl script in a string.
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the script at runtime.
 *
 *----------------------------------------------------------------------
 */

#ifdef REWRITE

static int
ExpandRequested(
    Tcl_Token *tokenPtr,
    int numWords)
{
    /* Determine whether any words of the command require expansion */
    while (numWords--) {







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


















<
<







1662
1663
1664
1665
1666
1667
1668


















































1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686


1687
1688
1689
1690
1691
1692
1693
    if (valuePtr != NULL) {
	Tcl_AppendObjToObj(valuePtr, tempPtr);
	Tcl_DecrRefCount(tempPtr);
    }
    return 1;
}



















































/*
 *----------------------------------------------------------------------
 *
 * TclCompileScript --
 *
 *	Compile a Tcl script in a string.
 *
 * Results:
 *	The return value is TCL_OK on a successful compilation and TCL_ERROR
 *	on failure. If TCL_ERROR is returned, then the interpreter's result
 *	contains an error message.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the script at runtime.
 *
 *----------------------------------------------------------------------
 */



static int
ExpandRequested(
    Tcl_Token *tokenPtr,
    int numWords)
{
    /* Determine whether any words of the command require expansion */
    while (numWords--) {
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
    ckfree(eclPtr->loc[wlineat].line);
    ckfree(eclPtr->loc[wlineat].next);
    eclPtr->loc[wlineat].line = wlines;
    eclPtr->loc[wlineat].next = NULL;

    return cmdIdx;
}
#endif

void
TclCompileScript(
    Tcl_Interp *interp,		/* Used for error and status reporting. Also
				 * serves as context for finding and compiling
				 * commands. May not be NULL. */
    const char *script,		/* The source script to compile. */
    int numBytes,		/* Number of bytes in script. If < 0, the
				 * script consists of all bytes up to the
				 * first null character. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
#ifdef REWRITE
    int lastCmdIdx = -1;	/* Index into envPtr->cmdMapPtr of the last
				 * command this routine compiles into bytecode.
				 * Initial value of -1 indicates this routine
				 * has not yet generated any bytecode. */
    const char *p = script;	/* Where we are in our compile. */

    if (envPtr->iPtr == NULL) {







<












<







2009
2010
2011
2012
2013
2014
2015

2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027

2028
2029
2030
2031
2032
2033
2034
    ckfree(eclPtr->loc[wlineat].line);
    ckfree(eclPtr->loc[wlineat].next);
    eclPtr->loc[wlineat].line = wlines;
    eclPtr->loc[wlineat].next = NULL;

    return cmdIdx;
}


void
TclCompileScript(
    Tcl_Interp *interp,		/* Used for error and status reporting. Also
				 * serves as context for finding and compiling
				 * commands. May not be NULL. */
    const char *script,		/* The source script to compile. */
    int numBytes,		/* Number of bytes in script. If < 0, the
				 * script consists of all bytes up to the
				 * first null character. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{

    int lastCmdIdx = -1;	/* Index into envPtr->cmdMapPtr of the last
				 * command this routine compiles into bytecode.
				 * Initial value of -1 indicates this routine
				 * has not yet generated any bytecode. */
    const char *p = script;	/* Where we are in our compile. */

    if (envPtr->iPtr == NULL) {
2111
2112
2113
2114
2115
2116
2117

2118
2119
2120
2121
2122
2123
2124
	    TclCompileSyntaxError(interp, envPtr);
	    return;
	}

#ifdef TCL_COMPILE_DEBUG
	/*
	 * If tracing, print a line for each top level command compiled.

	 */

	if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
	    int commandLength = parse.term - parse.commandStart;
	    fprintf(stdout, "  Compiling: ");
	    TclPrintSource(stdout, parse.commandStart,
		    TclMin(commandLength, 55));







>







2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
	    TclCompileSyntaxError(interp, envPtr);
	    return;
	}

#ifdef TCL_COMPILE_DEBUG
	/*
	 * If tracing, print a line for each top level command compiled.
	 * TODO: Suppress when numWords == 0 ?
	 */

	if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
	    int commandLength = parse.term - parse.commandStart;
	    fprintf(stdout, "  Compiling: ");
	    TclPrintSource(stdout, parse.commandStart,
		    TclMin(commandLength, 55));
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
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
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
	 * so that the result of the last command becomes the result of
	 * the script.  The code here removes that trailing INST_POP.
	 */
	envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--;
	envPtr->codeNext--;
	envPtr->currStackDepth++;
    }
#else
    int lastTopLevelCmdIndex = -1;
				/* Index of most recent toplevel command in
				 * the command location table. Initialized to
				 * avoid compiler warning. */
    int startCodeOffset = -1;	/* Offset of first byte of current command's
				 * code. Init. to avoid compiler warning. */
    unsigned char *entryCodeNext = envPtr->codeNext;
    const char *p, *next;
    Command *cmdPtr;
    Tcl_Token *tokenPtr;
    int bytesLeft, isFirstCmd, wordIdx, currCmdIndex, commandLength, objIndex;
    /* TIP #280 */
    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
    int *wlines, wlineat, cmdLine, *clNext;
    Tcl_Parse parse, *parsePtr = &parse;

    if (envPtr->iPtr == NULL) {
	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
    }

    if (numBytes < 0) {
	numBytes = strlen(script);
    }
    Tcl_ResetResult(interp);
    isFirstCmd = 1;

    /*
     * Each iteration through the following loop compiles the next command
     * from the script.
     */

    p = script;
    bytesLeft = numBytes;
    cmdLine = envPtr->line;
    clNext = envPtr->clNext;
    do {
	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
	    /*
	     * Compile bytecodes to report the parse error at runtime.
	     */

	    Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
		    parsePtr->term + 1 - parsePtr->commandStart);
	    TclCompileSyntaxError(interp, envPtr);
	    break;
	}

	/*
	 * TIP #280: We have to count newlines before the command even in the
	 * degenerate case when the command has no words. (See test
	 * info-30.33).
	 * So make that counting here, and not in the (numWords > 0) branch
	 * below.
	 */

	TclAdvanceLines(&cmdLine, p, parsePtr->commandStart);
	TclAdvanceContinuations(&cmdLine, &clNext,
		parsePtr->commandStart - envPtr->source);

	if (parsePtr->numWords > 0) {
	    int expand = 0;	/* Set if there are dynamic expansions to
				 * handle */

	    /*
	     * If not the first command, pop the previous command's result
	     * and, if we're compiling a top level command, update the last
	     * command's code size to account for the pop instruction.
	     */

	    if (!isFirstCmd) {
		TclEmitOpcode(INST_POP, envPtr);
		envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
			(envPtr->codeNext - envPtr->codeStart)
			- startCodeOffset;
	    }

	    /*
	     * Determine the actual length of the command.
	     */

	    commandLength = parsePtr->commandSize;
	    if (parsePtr->term == parsePtr->commandStart + commandLength-1) {
		/*
		 * The command terminator character (such as ; or ]) is the
		 * last character in the parsed command. Reduce the length by
		 * one so that the trace message doesn't include the
		 * terminator character.
		 */

		commandLength -= 1;
	    }

#ifdef TCL_COMPILE_DEBUG
	    /*
	     * If tracing, print a line for each top level command compiled.
	     */

	    if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
		fprintf(stdout, "  Compiling: ");
		TclPrintSource(stdout, parsePtr->commandStart,
			TclMin(commandLength, 55));
		fprintf(stdout, "\n");
	    }
#endif

	    /*
	     * Check whether expansion has been requested for any of the
	     * words.
	     */

	    for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr;
		    wordIdx < parsePtr->numWords;
		    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
		    expand = 1;
		    break;
		}
	    }

	    /*
	     * If expansion was requested, check if the command declares that
	     * it knows how to compile it. Note that if expansion is requested
	     * for the first word, this check will fail as the token type will
	     * inhibit it. (Checked inside FindCompiledCommandFromToken.) This
	     * is as it should be.
	     */

	    if (expand) {
		cmdPtr = FindCompiledCommandFromToken(interp,
			parsePtr->tokenPtr);
		if (cmdPtr && (cmdPtr->flags & CMD_COMPILES_EXPANDED)) {
		    expand = 0;
		}
	    }

	    envPtr->numCommands++;
	    currCmdIndex = envPtr->numCommands - 1;
	    lastTopLevelCmdIndex = currCmdIndex;
	    startCodeOffset = envPtr->codeNext - envPtr->codeStart;
	    EnterCmdStartData(envPtr, currCmdIndex,
		    parsePtr->commandStart - envPtr->source, startCodeOffset);

	    /*
	     * Should only start issuing instructions after the "command has
	     * started" so that the command range is correct in the bytecode.
	     */

	    if (expand) {
		StartExpanding(envPtr);
	    }

	    /*
	     * TIP #280. Scan the words and compute the extended location
	     * information. The map first contain full per-word line
	     * information for use by the compiler. This is later replaced by
	     * a reduced form which signals non-literal words, stored in
	     * 'wlines'.
	     */

	    EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
		    parsePtr->tokenPtr, parsePtr->commandStart,
		    parsePtr->commandSize, parsePtr->numWords, cmdLine,
		    clNext, &wlines, envPtr);
	    wlineat = eclPtr->nuloc - 1;

	    /*
	     * Each iteration of the following loop compiles one word from the
	     * command.
	     */

	    for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr;
		    wordIdx < parsePtr->numWords; wordIdx++,
		    tokenPtr += tokenPtr->numComponents + 1) {
		/*
		 * Note the parse location information.
		 */

		envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
		envPtr->clNext = eclPtr->loc[wlineat].next[wordIdx];

		if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
		    /*
		     * The word is not a simple string of characters.
		     */

		    CompileTokens(envPtr, tokenPtr, interp);
		    if (expand && tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
			TclEmitInstInt4(INST_EXPAND_STKTOP,
				envPtr->currStackDepth, envPtr);
		    }
		    continue;
		}

		/*
		 * This is a simple string of literal characters (i.e. we know
		 * it absolutely and can use it directly). If this is the
		 * first word and the command has a compile procedure, let it
		 * compile the command.
		 */

		if ((wordIdx == 0) && !expand) {
		    cmdPtr = FindCompiledCommandFromToken(interp, tokenPtr);
		    if (cmdPtr) {
			int savedNumCmds = envPtr->numCommands;
			unsigned savedCodeNext =
				envPtr->codeNext - envPtr->codeStart;
			int update = 0;
			int startStackDepth = envPtr->currStackDepth;

			/*
			 * Mark the start of the command; the proper bytecode
			 * length will be updated later. There is no need to
			 * do this for the first bytecode in the compile env,
			 * as the check is done before calling
			 * TclNRExecuteByteCode(). Do emit an INST_START_CMD
			 * in special cases where the first bytecode is in a
			 * loop, to insure that the corresponding command is
			 * counted properly. Compilers for commands able to
			 * produce such a beast (currently 'while 1' only) set
			 * envPtr->atCmdStart to 0 in order to signal this
			 * case. [Bug 1752146]
			 *
			 * Note that the environment is initialised with
			 * atCmdStart=1 to avoid emitting ISC for the first
			 * command.
			 */

			if (envPtr->atCmdStart == 1) {
			    if (savedCodeNext != 0) {
				/*
				 * Increase the number of commands being
				 * started at the current point. Note that
				 * this depends on the exact layout of the
				 * INST_START_CMD's operands, so be careful!
				 */

				TclIncrUInt4AtPtr(envPtr->codeNext - 4, 1)
			    }
			} else if (envPtr->atCmdStart == 0) {
			    TclEmitInstInt4(INST_START_CMD, 0, envPtr);
			    TclEmitInt4(1, envPtr);
			    update = 1;
			}

			if (cmdPtr->compileProc(interp, parsePtr, cmdPtr,
				envPtr) == TCL_OK) {
			    /*
			     * Confirm that the command compiler generated a
			     * single value on the stack as its result. This
			     * is only done in debugging mode, as it *should*
			     * be correct and normal users have no reasonable
			     * way to fix it anyway.
			     */

#ifdef TCL_COMPILE_DEBUG
			    int diff = envPtr->currStackDepth-startStackDepth;

			    if (diff != 1) {
				Tcl_Panic("bad stack adjustment when compiling"
					" %.*s (was %d instead of 1)",
					parsePtr->tokenPtr->size,
					parsePtr->tokenPtr->start, diff);
			    }
#endif
			    if (update) {
				/*
				 * Fix the bytecode length.
				 */

				unsigned char *fixPtr = envPtr->codeStart
					+ savedCodeNext + 1;
				unsigned fixLen = envPtr->codeNext
					- envPtr->codeStart - savedCodeNext;

				TclStoreInt4AtPtr(fixLen, fixPtr);
			    }
			    goto finishCommand;
			}

			if (envPtr->atCmdStart == 1 && savedCodeNext != 0) {
			    /*
			     * Decrease the number of commands being started
			     * at the current point. Note that this depends on
			     * the exact layout of the INST_START_CMD's
			     * operands, so be careful!
			     */

			    TclIncrUInt4AtPtr(envPtr->codeNext - 4, -1);
			}

			/*
			 * Restore numCommands and codeNext to their correct
			 * values, removing any commands compiled before the
			 * failure to produce bytecode got reported. [Bugs
			 * 705406 and 735055]
			 */

			envPtr->numCommands = savedNumCmds;
			envPtr->codeNext = envPtr->codeStart + savedCodeNext;

			/*
			 * And the stack depth too!!  [Bug 3614102].
			 */

			envPtr->currStackDepth = startStackDepth;
		    }

		    /*
		     * 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) {
			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
		     * unmodified. We care only if the we are in a context
		     * which already allows absolute counting.
		     */

		    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 */

	    /*
	     * Emit an invoke instruction for the command. We skip this if a
	     * compile procedure was found for the command.
	     */
	    assert(wordIdx > 0);

	    if (expand) {
		/*
		 * The stack depth during argument expansion can only be
		 * managed at runtime, as the number of elements in the
		 * expanded lists is not known at compile time. We adjust here
		 * the stack depth estimate so that it is correct after the
		 * command with expanded arguments returns.
		 *
		 * The end effect of this command's invocation is that all the
		 * words of the command are popped from the stack, and the
		 * result is pushed: the stack top changes by (1-wordIdx).
		 *
		 * Note that the estimates are not correct while the command
		 * is being prepared and run, INST_EXPAND_STKTOP is not
		 * stack-neutral in general.
		 */

		TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
		envPtr->expandCount--;
		TclAdjustStackDepth(1 - wordIdx, envPtr);
	    } else {
		/*
		 * Save PC -> command map for the TclArgumentBC* functions.
		 */

		int isnew;
		Tcl_HashEntry *hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo,
			INT2PTR(envPtr->codeNext - envPtr->codeStart),
			&isnew);

		Tcl_SetHashValue(hePtr, INT2PTR(wlineat));
		if (wordIdx <= 255) {
		    TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
		} else {
		    TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
		}
	    }

	    /*
	     * Update the compilation environment structure and record the
	     * offsets of the source and code for the command.
	     */

	finishCommand:
	    EnterCmdExtentData(envPtr, currCmdIndex, commandLength,
		    (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
	    isFirstCmd = 0;

	    /*
	     * TIP #280: Free full form of per-word line data and insert the
	     * reduced form now
	     */

	    ckfree(eclPtr->loc[wlineat].line);
	    ckfree(eclPtr->loc[wlineat].next);
	    eclPtr->loc[wlineat].line = wlines;
	    eclPtr->loc[wlineat].next = NULL;
	} /* end if parsePtr->numWords > 0 */

	/*
	 * Advance to the next command in the script.
	 */

	next = parsePtr->commandStart + parsePtr->commandSize;
	bytesLeft -= next - p;
	p = next;

	/*
	 * TIP #280: Track lines in the just compiled command.
	 */

	TclAdvanceLines(&cmdLine, parsePtr->commandStart, p);
	TclAdvanceContinuations(&cmdLine, &clNext, p - envPtr->source);
	Tcl_FreeParse(parsePtr);
    } while (bytesLeft > 0);

    /*
     * TIP #280: Bring the line counts in the CompEnv up to date.
     *	See tests info-30.33,34,35 .
     */

    envPtr->line = cmdLine;
    envPtr->clNext = clNext;

    /*
     * If the source script yielded no instructions (e.g., if it was empty),
     * push an empty string as the command's result.
     */

    if (envPtr->codeNext == entryCodeNext) {
	PushStringLiteral(envPtr, "");
    }
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileTokens --
 *







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







2135
2136
2137
2138
2139
2140
2141



























































































































































































































































































































































































































































2142
2143
2144
2145
2146
2147
2148
	 * so that the result of the last command becomes the result of
	 * the script.  The code here removes that trailing INST_POP.
	 */
	envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--;
	envPtr->codeNext--;
	envPtr->currStackDepth++;
    }



























































































































































































































































































































































































































































}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileTokens --
 *

Changes to generic/tclCompile.h.

1109
1110
1111
1112
1113
1114
1115









1116
1117
1118
1119
1120
1121
1122
/*
 *----------------------------------------------------------------
 * 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.
 *







>
>
>
>
>
>
>
>
>







1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
/*
 *----------------------------------------------------------------
 * Macros and flag values used by Tcl bytecode compilation and execution
 * modules inside the Tcl core but not used outside.
 *----------------------------------------------------------------
 */

/*
 * Simplified form to access AuxData.
 *
 * ClientData TclFetchAuxData(CompileEng *envPtr, int index);
 */

#define TclFetchAuxData(envPtr, index) \
    (envPtr)->auxDataArrayPtr[(index)].clientData

#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.
 *

Changes to generic/tclEnsemble.c.

3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
#if 1
    Tcl_Obj *objPtr = Tcl_NewObj();

    Tcl_IncrRefCount(objPtr);
    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
    TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr,
	    parsePtr->numWords, envPtr);
    Tcl_DecrRefCount(objPtr);
#else
    Tcl_Token *tokenPtr;
    Tcl_Obj *objPtr;
    char *bytes;
    int length, i, literal;
    DefineLineInformation;

    /*
     * Push the name of the command we're actually dispatching to as part of
     * 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.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    for (i=1 ; i<parsePtr->numWords ; i++) {
	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    PushLiteral(envPtr, tokenPtr[1].start, tokenPtr[1].size);
	} else {
	    SetLineInformation(i);
	    CompileTokens(envPtr, tokenPtr, interp);
	}
	tokenPtr = TokenAfter(tokenPtr);
    }

    /*
     * Do the standard dispatch.
     */

    if (i <= 255) {
	TclEmitInstInt1(INST_INVOKE_STK1, i, envPtr);
    } else {
	TclEmitInstInt4(INST_INVOKE_STK4, i, envPtr);
    }
#endif
    return TCL_OK;
}

int
TclCompileBasic0ArgCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command







<







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







3201
3202
3203
3204
3205
3206
3207

3208
3209
3210
3211
3212
3213
3214













































3215
3216
3217
3218
3219
3220
3221
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{

    Tcl_Obj *objPtr = Tcl_NewObj();

    Tcl_IncrRefCount(objPtr);
    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
    TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr,
	    parsePtr->numWords, envPtr);
    Tcl_DecrRefCount(objPtr);













































    return TCL_OK;
}

int
TclCompileBasic0ArgCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command

Changes to generic/tclParse.c.

1563
1564
1565
1566
1567
1568
1569

1570
1571
1572
1573
1574
1575
1576

	TclStackFree(interp, parsePtr);
	return "$";
    }

    code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens,
	    NULL, 1, NULL, NULL);

    TclStackFree(interp, parsePtr);
    if (code != TCL_OK) {
	return NULL;
    }
    objPtr = Tcl_GetObjResult(interp);

    /*







>







1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577

	TclStackFree(interp, parsePtr);
	return "$";
    }

    code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens,
	    NULL, 1, NULL, NULL);
    Tcl_FreeParse(parsePtr);
    TclStackFree(interp, parsePtr);
    if (code != TCL_OK) {
	return NULL;
    }
    objPtr = Tcl_GetObjResult(interp);

    /*

Changes to generic/tclUtf.c.

1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
     * standard C function, otherwise consult the Unicode table.
     */

    if (((Tcl_UniChar) ch) < ((Tcl_UniChar) 0x80)) {
	return TclIsSpaceProc((char) ch);
    } else if ((Tcl_UniChar) ch == 0x0085 || (Tcl_UniChar) ch == 0x180e
	    || (Tcl_UniChar) ch == 0x200b || (Tcl_UniChar) ch == 0x2060
	    || (Tcl_UniChar) ch == 0xfeff) {
	return 1;
    } else {
	return ((SPACE_BITS >> GetCategory(ch)) & 1);
    }
}

/*







|







1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
     * standard C function, otherwise consult the Unicode table.
     */

    if (((Tcl_UniChar) ch) < ((Tcl_UniChar) 0x80)) {
	return TclIsSpaceProc((char) ch);
    } else if ((Tcl_UniChar) ch == 0x0085 || (Tcl_UniChar) ch == 0x180e
	    || (Tcl_UniChar) ch == 0x200b || (Tcl_UniChar) ch == 0x2060
	    || (Tcl_UniChar) ch == 0x202f || (Tcl_UniChar) ch == 0xfeff) {
	return 1;
    } else {
	return ((SPACE_BITS >> GetCategory(ch)) & 1);
    }
}

/*

Changes to tests/parse.test.

23
24
25
26
27
28
29

30
31
32
33
34
35
36
testConstraint testevalobjv [llength [info commands testevalobjv]]
testConstraint testevalex [llength [info commands testevalex]]
testConstraint testparsevarname [llength [info commands testparsevarname]]
testConstraint testparsevar [llength [info commands testparsevar]]
testConstraint testasync [llength [info commands testasync]]
testConstraint testcmdtrace [llength [info commands testcmdtrace]]
testConstraint testevent [llength [info commands testevent]]


test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser {
    testparser [bytestring "foo\0 bar"] -1
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-1.2 {Tcl_ParseCommand procedure, computing string length} testparser {
    testparser "foo bar" -1
} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}







>







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
testConstraint testevalobjv [llength [info commands testevalobjv]]
testConstraint testevalex [llength [info commands testevalex]]
testConstraint testparsevarname [llength [info commands testparsevarname]]
testConstraint testparsevar [llength [info commands testparsevar]]
testConstraint testasync [llength [info commands testasync]]
testConstraint testcmdtrace [llength [info commands testcmdtrace]]
testConstraint testevent [llength [info commands testevent]]
testConstraint memory [llength [info commands memory]]

test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser {
    testparser [bytestring "foo\0 bar"] -1
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-1.2 {Tcl_ParseCommand procedure, computing string length} testparser {
    testparser "foo bar" -1
} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
674
675
676
677
678
679
680




















681
682
683
684
685
686
687
    unset -nocomplain abc
    list [catch {testparsevar {$abc}} msg] $msg
} {1 {can't read "abc": no such variable}}
test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar {
    unset -nocomplain abc
    list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg
} {1 {invalid command name "bogus"}}





















test parse-14.1 {Tcl_ParseBraces procedure, computing string length} testparser {
    testparser [bytestring "foo\0 bar"] -1
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-14.2 {Tcl_ParseBraces procedure, computing string length} testparser {
    testparser "foo bar" -1
} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}







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







675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
    unset -nocomplain abc
    list [catch {testparsevar {$abc}} msg] $msg
} {1 {can't read "abc": no such variable}}
test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar {
    unset -nocomplain abc
    list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg
} {1 {invalid command name "bogus"}}
test parse-13.6 {Tcl_ParseVar memory leak} -constraints memory -setup {
    proc getbytes {} {
	return [lindex [split [memory info] \n] 3 3]
    }
} -body {
    set a() foo
    set end [getbytes]
    for {set i 0} {$i < 5} {incr i} {
	set vn {}
	set res [testparsevar [append vn $ a([string repeat {[]} 19]) bar]]
	if {$res ne {foo bar}} {error "Unexpected result: $res"}

	set tmp $end
	set end [getbytes]
    }
    expr {$end - $tmp}
} -cleanup {
    unset -nocomplain a end i vn res tmp
    rename getbytes {}
} -result 0

test parse-14.1 {Tcl_ParseBraces procedure, computing string length} testparser {
    testparser [bytestring "foo\0 bar"] -1
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-14.2 {Tcl_ParseBraces procedure, computing string length} testparser {
    testparser "foo bar" -1
} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}

Changes to tests/reg.test.

1145
1146
1147
1148
1149
1150
1151



1152
1153
1154
1155
1156
1157
1158
	([0-7])					# MinPriority
	([[:blank:]]+)				# Pad
	(PASS|TRUE|FAIL|FALSE)			# ExtdSrvcsEnabled
	([[:blank:]]+)				# Pad
	(.*)					# ConditionalFields
    }] 0
} 68




# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl







>
>
>







1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
	([0-7])					# MinPriority
	([[:blank:]]+)				# Pad
	(PASS|TRUE|FAIL|FALSE)			# ExtdSrvcsEnabled
	([[:blank:]]+)				# Pad
	(.*)					# ConditionalFields
    }] 0
} 68
test reg-33.16 {Bug [8d2c0da36d]- another "in the wild" RE} {
    lindex [regexp -about "^MRK:client1: =1339 14HKelly Talisman 10011000 (\[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]*) \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 8 0 8 0 0 0 77 77 1 1 2 0 11 { 1 3 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 13HC6 My Creator 2 3 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 31HC7 Slightly offensive name, huh 3 8 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 23HE-mail:[email protected] 4 9 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 17Hcompface must die 5 10 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 3HAir 6 12 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 14HPGP public key 7 13 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 [email protected] 8 30 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 12H2 text/plain 9 30 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 13H2 x-kom/basic 10 33 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 1H0 11 14 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 1H3 }\r?"] 0
} 1

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl

Changes to tests/regexp.test.

872
873
874
875
876
877
878




879
880
881
882
883
884
885
	append e [format %c [incr cp]]
    }
} -body {
    regexp -about $e
} -cleanup {
    unset -nocomplain e cp
} -returnCodes error  -match glob -result {*too many colors*}





test regexp-23.1 {regexp -all and -line} {
    set string ""
    list \
	[regexp -all -inline -indices -line -- {^} $string] \
	[regexp -all -inline -indices -line -- {^$} $string] \
	[regexp -all -inline -indices -line -- {$} $string]







>
>
>
>







872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
	append e [format %c [incr cp]]
    }
} -body {
    regexp -about $e
} -cleanup {
    unset -nocomplain e cp
} -returnCodes error  -match glob -result {*too many colors*}
test regexp-22.6 {Bug 6585b21ca8} {
    expr {[regexp {(\w).*?\1} Programmer m] ? $m : "<NONE>"}
} rogr


test regexp-23.1 {regexp -all and -line} {
    set string ""
    list \
	[regexp -all -inline -indices -line -- {^} $string] \
	[regexp -all -inline -indices -line -- {^$} $string] \
	[regexp -all -inline -indices -line -- {$} $string]

Changes to tests/subst.test.

289
290
291
292
293
294
295




296
297
298
299
300
301
302
	}
    }
    slave eval [list source $script]
    interp delete slave
} -cleanup {
    removeFile subst13.tcl
}





# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl







>
>
>
>







289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
	}
    }
    slave eval [list source $script]
    interp delete slave
} -cleanup {
    removeFile subst13.tcl
}
test subst-13.2 {Test for segfault} -body {
    subst {[}
} -returnCodes error -result * -match glob


# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl

Added tests/unixForkEvent.test.



























































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
# This file contains a collection of tests for the procedures in the file
# tclUnixNotify.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2
namespace import -force ::tcltest::*

testConstraint testfork [llength [info commands testfork]]

# Test if the notifier thread is well initialized in a forked interpreter
# by Tcl_InitNotifier
test unixforkevent-1.1 {fork and test writeable event} \
    -constraints testfork \
    -body {
	set myFolder [makeDirectory unixtestfork]
	set pid [testfork]
	if {$pid == 0} {
	    # we are the forked process
	    set result initialized
	    set h [open [file join $myFolder test.txt] w]
	    fileevent $h writable\
		    "set result writable;\
		    after cancel [after 1000 {set result timeout}]"
	    vwait result
	    close $h
	    makeFile $result result.txt $myFolder
	    exit
	}
	# we are the original process
	while {![file readable [file join $myFolder result.txt]]} {}
	viewFile result.txt $myFolder
    } \
    -result {writable} \
    -cleanup { 
	catch { removeFolder $myFolder }
    }

::tcltest::cleanupTests
return

Changes to unix/Makefile.in.

331
332
333
334
335
336
337
338



339
340
341
342
343
344
345
346
347


348
349
350
351
352
353
354
	bn_mp_shrink.o \
	bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \
        bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \
	bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix_n.o \
	bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
        bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o

STUB_LIB_OBJS = tclStubLib.o tclTomMathStubLib.o tclOOStubLib.o ${COMPAT_OBJS}




UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
	tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
	tclUnixTime.o tclUnixInit.o tclUnixThrd.o \
	tclUnixCompat.o

NOTIFY_OBJS = tclUnixNotfy.o

MAC_OSX_OBJS = tclMacOSXBundle.o tclMacOSXFCmd.o tclMacOSXNotify.o



DTRACE_OBJ = tclDTrace.o

ZLIB_OBJS = Zadler32.o Zcompress.o Zcrc32.o Zdeflate.o Zinfback.o \
	Zinffast.o Zinflate.o Zinftrees.o Ztrees.o Zuncompr.o Zzutil.o

TCL_OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \







|
>
>
>









>
>







331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
	bn_mp_shrink.o \
	bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \
        bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \
	bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix_n.o \
	bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
        bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o

STUB_LIB_OBJS = tclStubLib.o \
	tclTomMathStubLib.o \
	tclOOStubLib.o \
	${COMPAT_OBJS}

UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
	tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
	tclUnixTime.o tclUnixInit.o tclUnixThrd.o \
	tclUnixCompat.o

NOTIFY_OBJS = tclUnixNotfy.o

MAC_OSX_OBJS = tclMacOSXBundle.o tclMacOSXFCmd.o tclMacOSXNotify.o

CYGWIN_OBJS = tclWinError.o

DTRACE_OBJ = tclDTrace.o

ZLIB_OBJS = Zadler32.o Zcompress.o Zcrc32.o Zdeflate.o Zinfback.o \
	Zinffast.o Zinflate.o Zinftrees.o Ztrees.o Zuncompr.o Zzutil.o

TCL_OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \
571
572
573
574
575
576
577



578
579
580
581
582
583
584
	$(UNIX_DIR)/tclLoadShl.c

MAC_OSX_SRCS = \
	$(MAC_OSX_DIR)/tclMacOSXBundle.c \
	$(MAC_OSX_DIR)/tclMacOSXFCmd.c \
	$(MAC_OSX_DIR)/tclMacOSXNotify.c




DTRACE_HDR = tclDTrace.h

DTRACE_SRC = $(GENERIC_DIR)/tclDTrace.d

ZLIB_SRCS = \
	$(ZLIB_DIR)/adler32.c \
	$(ZLIB_DIR)/compress.c \







>
>
>







576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
	$(UNIX_DIR)/tclLoadShl.c

MAC_OSX_SRCS = \
	$(MAC_OSX_DIR)/tclMacOSXBundle.c \
	$(MAC_OSX_DIR)/tclMacOSXFCmd.c \
	$(MAC_OSX_DIR)/tclMacOSXNotify.c

CYGWIN_SRCS = \
	$(TOP_DIR)/win/tclWinError.c

DTRACE_HDR = tclDTrace.h

DTRACE_SRC = $(GENERIC_DIR)/tclDTrace.d

ZLIB_SRCS = \
	$(ZLIB_DIR)/adler32.c \
	$(ZLIB_DIR)/compress.c \

Changes to unix/configure.

4817
4818
4819
4820
4821
4822
4823

4824
4825
4826
4827
4828
4829
4830
4831
		fi
	    fi
	fi

	# Does the pthread-implementation provide
	# 'pthread_attr_setstacksize' ?


for ac_func in pthread_attr_setstacksize
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
echo "$as_me:$LINENO: checking for $ac_func" >&5
echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
if eval "test \"\${$as_ac_var+set}\" = set"; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else







>
|







4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
		fi
	    fi
	fi

	# Does the pthread-implementation provide
	# 'pthread_attr_setstacksize' ?


for ac_func in pthread_attr_setstacksize pthread_atfork
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
echo "$as_me:$LINENO: checking for $ac_func" >&5
echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
if eval "test \"\${$as_ac_var+set}\" = set"; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
5045
5046
5047
5048
5049
5050
5051
5052
5053
5054
5055
5056
5057
5058
5059
    else
	echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
    fi




for ac_func in pthread_atfork
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
echo "$as_me:$LINENO: checking for $ac_func" >&5
echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
if eval "test \"\${$as_ac_var+set}\" = set"; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
   For example, HP-UX 11i <limits.h> declares gettimeofday.  */
#define $ac_func innocuous_$ac_func

/* System header to define __stub macros and hopefully few prototypes,
    which can conflict with char $ac_func (); below.
    Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
    <limits.h> exists even on freestanding compilers.  */

#ifdef __STDC__
# include <limits.h>
#else
# include <assert.h>
#endif

#undef $ac_func

/* Override any gcc2 internal prototype to avoid an error.  */
#ifdef __cplusplus
extern "C"
{
#endif
/* We use char because int might match the return type of a gcc2
   builtin and then its argument prototype would still apply.  */
char $ac_func ();
/* The GNU C library defines this for functions which it implements
    to always fail with ENOSYS.  Some functions are actually named
    something starting with __ and the normal name is an alias.  */
#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
choke me
#else
char (*f) () = $ac_func;
#endif
#ifdef __cplusplus
}
#endif

int
main ()
{
return f != $ac_func;
  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
  (eval $ac_link) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest$ac_exeext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  eval "$as_ac_var=yes"
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

eval "$as_ac_var=no"
fi
rm -f conftest.err conftest.$ac_objext \
      conftest$ac_exeext conftest.$ac_ext
fi
echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
if test `eval echo '${'$as_ac_var'}'` = yes; then
  cat >>confdefs.h <<_ACEOF
#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF

fi
done


#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------










<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







4945
4946
4947
4948
4949
4950
4951






































































































4952
4953
4954
4955
4956
4957
4958
    else
	echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
    fi










































































































#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------



7166
7167
7168
7169
7170
7171
7172
7173


7174
7175
7176
7177
7178
7179
7180
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	CYGWIN_*|MINGW32*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".dll"
	    DL_OBJS="tclLoadDl.o tclWinError.o"


	    DL_LIBS="-ldl"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    TCL_NEEDS_EXP_FILE=1
	    TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a'
	    TCL_SHLIB_LD_EXTRAS='-Wl,--out-implib,[email protected]'
	    echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5







|
>
>







7065
7066
7067
7068
7069
7070
7071
7072
7073
7074
7075
7076
7077
7078
7079
7080
7081
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	CYGWIN_*|MINGW32*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".dll"
	    DL_OBJS="tclLoadDl.o"
	    PLAT_OBJS='${CYGWIN_OBJS}'
	    PLAT_SRCS='${CYGWIN_SRCS}'
	    DL_LIBS="-ldl"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    TCL_NEEDS_EXP_FILE=1
	    TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a'
	    TCL_SHLIB_LD_EXTRAS='-Wl,--out-implib,[email protected]'
	    echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5

Changes to unix/configure.in.

117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
fi

#------------------------------------------------------------------------
# Threads support
#------------------------------------------------------------------------

SC_ENABLE_THREADS
AC_CHECK_FUNCS(pthread_atfork)

#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------

SC_TCL_CFG_ENCODING








<







117
118
119
120
121
122
123

124
125
126
127
128
129
130
fi

#------------------------------------------------------------------------
# Threads support
#------------------------------------------------------------------------

SC_ENABLE_THREADS


#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------

SC_TCL_CFG_ENCODING

Changes to unix/tcl.m4.

672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
		    fi
		fi
	    fi
	fi

	# Does the pthread-implementation provide
	# 'pthread_attr_setstacksize' ?
	AC_CHECK_FUNCS(pthread_attr_setstacksize)
    else
	TCL_THREADS=0
    fi
    # Do checking message here to not mess up interleaved configure output
    AC_MSG_CHECKING([for building with threads])
    if test "${TCL_THREADS}" = 1; then
	AC_DEFINE(TCL_THREADS, 1, [Are we building with threads enabled?])







|







672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
		    fi
		fi
	    fi
	fi

	# Does the pthread-implementation provide
	# 'pthread_attr_setstacksize' ?
	AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork)
    else
	TCL_THREADS=0
    fi
    # Do checking message here to not mess up interleaved configure output
    AC_MSG_CHECKING([for building with threads])
    if test "${TCL_THREADS}" = 1; then
	AC_DEFINE(TCL_THREADS, 1, [Are we building with threads enabled?])
1220
1221
1222
1223
1224
1225
1226
1227


1228
1229
1230
1231
1232
1233
1234
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	CYGWIN_*|MINGW32*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".dll"
	    DL_OBJS="tclLoadDl.o tclWinError.o"


	    DL_LIBS="-ldl"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    TCL_NEEDS_EXP_FILE=1
	    TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a'
	    TCL_SHLIB_LD_EXTRAS='-Wl,--out-implib,$[@].a'
	    AC_CACHE_CHECK(for Cygwin version of gcc,







|
>
>







1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	CYGWIN_*|MINGW32*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".dll"
	    DL_OBJS="tclLoadDl.o"
	    PLAT_OBJS='${CYGWIN_OBJS}'
	    PLAT_SRCS='${CYGWIN_SRCS}'
	    DL_LIBS="-ldl"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    TCL_NEEDS_EXP_FILE=1
	    TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a'
	    TCL_SHLIB_LD_EXTRAS='-Wl,--out-implib,$[@].a'
	    AC_CACHE_CHECK(for Cygwin version of gcc,

Changes to unix/tclUnixNotfy.c.

115
116
117
118
119
120
121









122
123
124
125
126
127
128
 * notifiers.
 *
 * You must hold the notifierMutex lock before accessing this variable.
 */

static int notifierCount = 0;










/*
 * The following variable points to the head of a doubly-linked list of
 * ThreadSpecificData structures for all threads that are currently waiting on
 * an event.
 *
 * You must hold the notifierMutex lock before accessing this list.
 */







>
>
>
>
>
>
>
>
>







115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
 * notifiers.
 *
 * You must hold the notifierMutex lock before accessing this variable.
 */

static int notifierCount = 0;

/*
 * The following static stores the process ID of the initialized notifier
 * thread. If it changes, we have passed a fork and we should start a new
 * notifier thread.
 *
 * You must hold the notifierMutex lock before accessing this variable.
 */
static pid_t processIDInitialized = 0;

/*
 * The following variable points to the head of a doubly-linked list of
 * ThreadSpecificData structures for all threads that are currently waiting on
 * an event.
 *
 * You must hold the notifierMutex lock before accessing this list.
 */
181
182
183
184
185
186
187






188
189
190
191
192
193
194
195

/*
 * Static routines defined in this file.
 */

#ifdef TCL_THREADS
static void	NotifierThreadProc(ClientData clientData);






#endif
static int	FileHandlerEventProc(Tcl_Event *evPtr, int flags);

/*
 * Import of Windows API when building threaded with Cygwin.
 */

#if defined(TCL_THREADS) && defined(__CYGWIN__)







>
>
>
>
>
>
|







190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210

/*
 * Static routines defined in this file.
 */

#ifdef TCL_THREADS
static void	NotifierThreadProc(ClientData clientData);
#ifdef HAVE_PTHREAD_ATFORK
static int	atForkInit = 0;
static void	AtForkPrepare(void);
static void	AtForkParent(void);
static void	AtForkChild(void);
#endif /* HAVE_PTHREAD_ATFORK */
#endif /* TCL_THREADS */
static int	FileHandlerEventProc(Tcl_Event *evPtr, int flags);

/*
 * Import of Windows API when building threaded with Cygwin.
 */

#if defined(TCL_THREADS) && defined(__CYGWIN__)
271
272
273
274
275
276
277


























278
279
280
281
282

283
284
285
286
287
288
289
	tsdPtr->eventReady = 0;

	/*
	 * Start the Notifier thread if necessary.
	 */

	Tcl_MutexLock(&notifierMutex);


























	if (notifierCount == 0) {
	    if (TclpThreadCreate(&notifierThread, NotifierThreadProc, NULL,
		    TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
		Tcl_Panic("Tcl_InitNotifier: unable to start notifier thread");
	    }

	}
	notifierCount++;

	/*
	 * Wait for the notifier pipe to be created.
	 */








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





>







286
287
288
289
290
291
292
293
294
295
296
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
	tsdPtr->eventReady = 0;

	/*
	 * Start the Notifier thread if necessary.
	 */

	Tcl_MutexLock(&notifierMutex);
#ifdef HAVE_PTHREAD_ATFORK
	/*
	 * Install pthread_atfork handlers to reinitialize the notifier in the
	 * child of a fork.
	 */

	if (!atForkInit) {
	    int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild);

	    if (result) {
		Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
	    }
	    atForkInit = 1;
	}
#endif
	/*
	 * Check if my process id changed, e.g. I was forked
	 * In this case, restart the notifier thread and close the
	 * pipe to the original notifier thread
	 */
	if (notifierCount > 0 && processIDInitialized != getpid()) {
	    notifierCount = 0;
	    processIDInitialized = 0;
	    close(triggerPipe);
	    triggerPipe = -1;
	}
	if (notifierCount == 0) {
	    if (TclpThreadCreate(&notifierThread, NotifierThreadProc, NULL,
		    TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
		Tcl_Panic("Tcl_InitNotifier: unable to start notifier thread");
	    }
	    processIDInitialized = getpid();
	}
	notifierCount++;

	/*
	 * Wait for the notifier pipe to be created.
	 */

1266
1267
1268
1269
1270
1271
1272





































































1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
    Tcl_MutexLock(&notifierMutex);
    triggerPipe = -1;
    Tcl_ConditionNotify(&notifierCV);
    Tcl_MutexUnlock(&notifierMutex);

    TclpThreadExit(0);
}





































































#endif /* TCL_THREADS */

#endif /* !HAVE_COREFOUNDATION */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







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











1308
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
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
    Tcl_MutexLock(&notifierMutex);
    triggerPipe = -1;
    Tcl_ConditionNotify(&notifierCV);
    Tcl_MutexUnlock(&notifierMutex);

    TclpThreadExit(0);
}

#ifdef HAVE_PTHREAD_ATFORK
/*
 *----------------------------------------------------------------------
 *
 * AtForkPrepare --
 *
 *	Lock the notifier in preparation for a fork.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
AtForkPrepare(void)
{
}

/*
 *----------------------------------------------------------------------
 *
 * AtForkParent --
 *
 *	Unlock the notifier in the parent after a fork.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
AtForkParent(void)
{
}

/*
 *----------------------------------------------------------------------
 *
 * AtForkChild --
 *
 *	Unlock and reinstall the notifier in the child after a fork.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
AtForkChild(void)
{
    notifierMutex = NULL;
    notifierCV = NULL;
    Tcl_InitNotifier();
}
#endif /* HAVE_PTHREAD_ATFORK */

#endif /* TCL_THREADS */

#endif /* !HAVE_COREFOUNDATION */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to unix/tclUnixThrd.c.

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#ifdef TCL_THREADS

typedef struct {
    char nabuf[16];
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * masterLock is used to serialize creation of mutexes, condition variables,
 * and thread local storage. This is the only place that can count on the
 * ability to statically initialize the mutex.
 */

static pthread_mutex_t masterLock = PTHREAD_MUTEX_INITIALIZER;







<
<
<
<
<
<







11
12
13
14
15
16
17






18
19
20
21
22
23
24
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#ifdef TCL_THREADS







/*
 * masterLock is used to serialize creation of mutexes, condition variables,
 * and thread local storage. This is the only place that can count on the
 * ability to statically initialize the mutex.
 */

static pthread_mutex_t masterLock = PTHREAD_MUTEX_INITIALIZER;