Tcl Source Code

Check-in [96352b53af]
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 | dkf-notifier-poll
Files: files | file ages | folders
SHA1: 96352b53af39d06d3ae9a068ac6aaa2a66d2456b
User & Date: dkf 2011-10-13 21:09:28
Context
2011-10-20
14:39
merge trunk check-in: c04c36b0d0 user: dkf tags: dkf-notifier-poll
2011-10-13
21:09
merge trunk check-in: 96352b53af user: dkf tags: dkf-notifier-poll
18:19
Correct botch. check-in: f0486f9bbd user: dgp tags: trunk
2011-10-07
14:48
merge trunk check-in: efd220a1ac user: dkf tags: dkf-notifier-poll
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.












1
2
3
4


5
6
7
8
9
10
11











2011-10-07  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:        Fix gcc warnings (discovered with
	* generic/tclIORChan.c: latest mingw, based on gcc 4.6.1)



2011-10-06  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (TclDictWithInit, TclDictWithFinish):
	* generic/tclCompCmds.c (TclCompileDictWithCmd): Experimental
	compilation for the [dict with] subcommand, using parts factored out
	from the interpreted version of the command.
>
>
>
>
>
>
>
>
>
>
>




>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
2011-10-11  Jan Nijtmans  <[email protected]>

	* win/tclWinFile.c:    [Bug 2935503] Incorrect mode field
	returned by file stat command

2011-10-09  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileDictWithCmd): Corrected handling of
	qualified names, and added spacial cases for empty bodies (used when
	[dict with] is just used for extracting variables).

2011-10-07  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:        Fix gcc warnings (discovered with
	* generic/tclIORChan.c: latest mingw, based on gcc 4.6.1)
	* tests/env.test:       Fix env.test, when running
	under wine 1.3

2011-10-06  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (TclDictWithInit, TclDictWithFinish):
	* generic/tclCompCmds.c (TclCompileDictWithCmd): Experimental
	compilation for the [dict with] subcommand, using parts factored out
	from the interpreted version of the command.

Changes to generic/tclCompCmds.c.

78
79
80
81
82
83
84












85
86
87
88
89
90
91
    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]

#define PushVarNameWord(i,v,e,f,l,s,sc,word) \
    PushVarName(i,v,e,f,l,s,sc,						\
	    mapPtr->loc[eclIndex].line[(word)],				\
	    mapPtr->loc[eclIndex].next[(word)])













/*
 * Flags bits used by PushVarName.
 */

#define TCL_NO_LARGE_INDEX 1	/* Do not return localIndex value > 255 */

/*







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







78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]

#define PushVarNameWord(i,v,e,f,l,s,sc,word) \
    PushVarName(i,v,e,f,l,s,sc,						\
	    mapPtr->loc[eclIndex].line[(word)],				\
	    mapPtr->loc[eclIndex].next[(word)])

/*
 * Often want to issue one of two versions of an instruction based on whether
 * the argument will fit in a single byte or not. This makes it much clearer.
 */

#define Emit14Inst(nm,idx,envPtr) \
    if (idx <= 255) {							\
	TclEmitInstInt1(nm##1,idx,envPtr);				\
    } else {								\
	TclEmitInstInt4(nm##4,idx,envPtr);				\
    }

/*
 * Flags bits used by PushVarName.
 */

#define TCL_NO_LARGE_INDEX 1	/* Do not return localIndex value > 255 */

/*
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
     * Emit instructions to set/get the variable.
     */

    if (simpleVarName) {
	if (isScalar) {
	    if (localIndex < 0) {
		TclEmitOpcode(INST_APPEND_STK, envPtr);
	    } else if (localIndex <= 255) {
		TclEmitInstInt1(INST_APPEND_SCALAR1, localIndex, envPtr);
	    } else {
		TclEmitInstInt4(INST_APPEND_SCALAR4, localIndex, envPtr);
	    }
	} else {
	    if (localIndex < 0) {
		TclEmitOpcode(INST_APPEND_ARRAY_STK, envPtr);
	    } else if (localIndex <= 255) {
		TclEmitInstInt1(INST_APPEND_ARRAY1, localIndex, envPtr);
	    } else {
		TclEmitInstInt4(INST_APPEND_ARRAY4, localIndex, envPtr);
	    }
	}
    } else {
	TclEmitOpcode(INST_APPEND_STK, envPtr);
    }

    return TCL_OK;







<
<

|




<
<

|







194
195
196
197
198
199
200


201
202
203
204
205
206


207
208
209
210
211
212
213
214
215
     * Emit instructions to set/get the variable.
     */

    if (simpleVarName) {
	if (isScalar) {
	    if (localIndex < 0) {
		TclEmitOpcode(INST_APPEND_STK, envPtr);


	    } else {
		Emit14Inst(INST_APPEND_SCALAR, localIndex, envPtr);
	    }
	} else {
	    if (localIndex < 0) {
		TclEmitOpcode(INST_APPEND_ARRAY_STK, envPtr);


	    } else {
		Emit14Inst(INST_APPEND_ARRAY, localIndex, envPtr);
	    }
	}
    } else {
	TclEmitOpcode(INST_APPEND_STK, envPtr);
    }

    return TCL_OK;
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
     * The reason for duplicating the script is that EVAL_STK would otherwise
     * begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
     */

    SetLineInformation(1);
    if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	savedStackDepth = envPtr->currStackDepth;
	TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
	ExceptionRangeStarts(envPtr, range);
	CompileBody(envPtr, cmdTokenPtr, interp);
    } else {
	CompileTokens(envPtr, cmdTokenPtr, interp);
	savedStackDepth = envPtr->currStackDepth;
	TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
	ExceptionRangeStarts(envPtr, range);
	TclEmitOpcode(INST_DUP, envPtr);
	TclEmitOpcode(INST_EVAL_STK, envPtr);
    }
    /* Stack at this point:
     *    nonsimple:  script <mark> result
     *    simple:            <mark> result
     */

    /*







|





|

|
|







370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
     * The reason for duplicating the script is that EVAL_STK would otherwise
     * begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
     */

    SetLineInformation(1);
    if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	savedStackDepth = envPtr->currStackDepth;
	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
	ExceptionRangeStarts(envPtr, range);
	CompileBody(envPtr, cmdTokenPtr, interp);
    } else {
	CompileTokens(envPtr, cmdTokenPtr, interp);
	savedStackDepth = envPtr->currStackDepth;
	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
	ExceptionRangeStarts(envPtr, range);
	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_EVAL_STK,			envPtr);
    }
    /* Stack at this point:
     *    nonsimple:  script <mark> result
     *    simple:            <mark> result
     */

    /*
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
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
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
475
476
477
478
479
480
481
482
483
484
     * Emit the "error case" epilogue. Push the interpreter result
     * and the return code.
     */

    envPtr->currStackDepth = savedStackDepth;
    ExceptionRangeTarget(envPtr, range, catchOffset);
    /* Stack at this point:  ?script? */
    TclEmitOpcode(INST_PUSH_RESULT, envPtr);
    TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);

    /*
     * Update the target of the jump after the "no errors" code. 
     */

    /* Stack at this point: ?script? result returnCode */
    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }

    /* Push the return options if the caller wants them */

    if (optsIndex != -1) {
	TclEmitOpcode(INST_PUSH_RETURN_OPTIONS, envPtr);
    }

    /*
     * End the catch
     */

    ExceptionRangeEnds(envPtr, range);
    TclEmitOpcode(INST_END_CATCH, envPtr);

    /*
     * At this point, the top of the stack is inconveniently ordered:
     *		?script? result returnCode ?returnOptions?
     * Reverse the stack to bring the result to the top.
     */

    if (optsIndex != -1) {
	TclEmitInstInt4(INST_REVERSE, 3, envPtr);
    } else {
	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
    }

    /*
     * Store the result if requested, and remove it from the stack
     */

    if (resultIndex != -1) {
	if (resultIndex <= 255) {
	    TclEmitInstInt1(INST_STORE_SCALAR1, resultIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_STORE_SCALAR4, resultIndex, envPtr);
	}
    }
    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Stack is now ?script? ?returnOptions? returnCode.
     * If the options dict has been requested, it is buried on the stack
     * under the return code. Reverse the stack to bring it to the top,
     * store it and remove it from the stack.
     */

    if (optsIndex != -1) {
	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
	if (optsIndex <= 255) {
	    TclEmitInstInt1(INST_STORE_SCALAR1, optsIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_STORE_SCALAR4, optsIndex, envPtr);
	}
	TclEmitOpcode(INST_POP, envPtr);
    }

    /* 
     * Stack is now ?script? result. Get rid of the subst'ed script
     * if it's hanging arond.
     */

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








|
|














|







|








|

|







<
|
<
<
|
<
|









|
<
|
<
<
<
|








|
|







403
404
405
406
407
408
409
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
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
475
476
477
478
479
480
481
482
483
484
     * Emit the "error case" epilogue. Push the interpreter result
     * and the return code.
     */

    envPtr->currStackDepth = savedStackDepth;
    ExceptionRangeTarget(envPtr, range, catchOffset);
    /* Stack at this point:  ?script? */
    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);

    /*
     * Update the target of the jump after the "no errors" code. 
     */

    /* Stack at this point: ?script? result returnCode */
    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
		(int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }

    /* Push the return options if the caller wants them */

    if (optsIndex != -1) {
	TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
    }

    /*
     * End the catch
     */

    ExceptionRangeEnds(envPtr, range);
    TclEmitOpcode(		INST_END_CATCH,			envPtr);

    /*
     * At this point, the top of the stack is inconveniently ordered:
     *		?script? result returnCode ?returnOptions?
     * Reverse the stack to bring the result to the top.
     */

    if (optsIndex != -1) {
	TclEmitInstInt4(	INST_REVERSE, 3,		envPtr);
    } else {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
    }

    /*
     * Store the result if requested, and remove it from the stack
     */

    if (resultIndex != -1) {

	Emit14Inst(		INST_STORE_SCALAR, resultIndex,	envPtr);


    }

    TclEmitOpcode(		INST_POP,			envPtr);

    /*
     * Stack is now ?script? ?returnOptions? returnCode.
     * If the options dict has been requested, it is buried on the stack
     * under the return code. Reverse the stack to bring it to the top,
     * store it and remove it from the stack.
     */

    if (optsIndex != -1) {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);

	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);



	TclEmitOpcode(		INST_POP,			envPtr);
    }

    /* 
     * Stack is now ?script? result. Get rid of the subst'ed script
     * if it's hanging arond.
     */

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

840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
     * fixed-sized jumps. That simplifies things a lot!
     *
     * First up, get the dictionary and start the iteration. No catching of
     * errors at this point.
     */

    CompileWord(envPtr, dictTokenPtr, interp, 3);
    TclEmitInstInt4( INST_DICT_FIRST, infoIndex,		envPtr);
    emptyTargetOffset = CurrentOffset(envPtr);
    TclEmitInstInt4( INST_JUMP_TRUE4, 0,			envPtr);

    /*
     * Now we catch errors from here on so that we can finalize the search
     * started by Tcl_DictObjFirst above.
     */

    catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
    TclEmitInstInt4( INST_BEGIN_CATCH4, catchRange,		envPtr);
    ExceptionRangeStarts(envPtr, catchRange);

    /*
     * Inside the iteration, write the loop variables.
     */

    bodyTargetOffset = CurrentOffset(envPtr);
    TclEmitInstInt4( INST_STORE_SCALAR4, keyVarIndex,		envPtr);
    TclEmitOpcode(   INST_POP,					envPtr);
    TclEmitInstInt4( INST_STORE_SCALAR4, valueVarIndex,		envPtr);
    TclEmitOpcode(   INST_POP,					envPtr);

    /*
     * Set up the loop exception targets.
     */

    loopRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
    ExceptionRangeStarts(envPtr, loopRange);

    /*
     * Compile the loop body itself. It should be stack-neutral.
     */

    SetLineInformation(4);
    CompileBody(envPtr, bodyTokenPtr, interp);
    TclEmitOpcode(   INST_POP,					envPtr);

    /*
     * Both exception target ranges (error and loop) end here.
     */

    ExceptionRangeEnds(envPtr, loopRange);
    ExceptionRangeEnds(envPtr, catchRange);

    /*
     * Continue (or just normally process) by getting the next pair of items
     * from the dictionary and jumping back to the code to write them into
     * variables if there is another pair.
     */

    ExceptionRangeTarget(envPtr, loopRange, continueOffset);
    TclEmitInstInt4( INST_DICT_NEXT, infoIndex,			envPtr);
    jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
    TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement,	envPtr);
    TclEmitOpcode(   INST_POP,					envPtr);
    TclEmitOpcode(   INST_POP,					envPtr);

    /*
     * Now do the final cleanup for the no-error case (this is where we break
     * out of the loop to) by force-terminating the iteration (if not already
     * terminated), ditching the exception info and jumping to the last
     * instruction for this command. In theory, this could be done using the
     * "finally" clause (next generated) but this is faster.
     */

    ExceptionRangeTarget(envPtr, loopRange, breakOffset);
    TclEmitInstInt1( INST_UNSET_SCALAR, 0,			envPtr);
    TclEmitInt4(     infoIndex,					envPtr);
    TclEmitOpcode(   INST_END_CATCH,				envPtr);
    endTargetOffset = CurrentOffset(envPtr);
    TclEmitInstInt4( INST_JUMP4, 0,				envPtr);

    /*
     * Error handler "finally" clause, which force-terminates the iteration
     * and rethrows the error.
     */

    ExceptionRangeTarget(envPtr, catchRange, catchOffset);
    TclEmitOpcode(   INST_PUSH_RETURN_OPTIONS,			envPtr);
    TclEmitOpcode(   INST_PUSH_RESULT,				envPtr);
    TclEmitInstInt1( INST_UNSET_SCALAR, 0,			envPtr);
    TclEmitInt4(     infoIndex,					envPtr);
    TclEmitOpcode(   INST_END_CATCH,				envPtr);
    TclEmitOpcode(   INST_RETURN_STK,				envPtr);

    /*
     * Otherwise we're done (the jump after the DICT_FIRST points here) and we
     * need to pop the bogus key/value pair (pushed to keep stack calculations
     * easy!) Note that we skip the END_CATCH. [Bug 1382528]
     */

    envPtr->currStackDepth = savedStackDepth+2;
    jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset;
    TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
	    envPtr->codeStart + emptyTargetOffset);
    TclEmitOpcode(   INST_POP,					envPtr);
    TclEmitOpcode(   INST_POP,					envPtr);
    TclEmitInstInt1( INST_UNSET_SCALAR, 0,			envPtr);
    TclEmitInt4(     infoIndex,					envPtr);

    /*
     * Final stage of the command (normal case) is that we push an empty
     * object. This is done last to promote peephole optimization when it's
     * dropped immediately.
     */








|

|







|







|
|
|
|














|















|

|
|
|










|
|
|

|







|
|
|
|
|
|











|
|
|
|







840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
     * fixed-sized jumps. That simplifies things a lot!
     *
     * First up, get the dictionary and start the iteration. No catching of
     * errors at this point.
     */

    CompileWord(envPtr, dictTokenPtr, interp, 3);
    TclEmitInstInt4(	INST_DICT_FIRST, infoIndex,		envPtr);
    emptyTargetOffset = CurrentOffset(envPtr);
    TclEmitInstInt4(	INST_JUMP_TRUE4, 0,			envPtr);

    /*
     * Now we catch errors from here on so that we can finalize the search
     * started by Tcl_DictObjFirst above.
     */

    catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
    TclEmitInstInt4(	INST_BEGIN_CATCH4, catchRange,		envPtr);
    ExceptionRangeStarts(envPtr, catchRange);

    /*
     * Inside the iteration, write the loop variables.
     */

    bodyTargetOffset = CurrentOffset(envPtr);
    Emit14Inst(		INST_STORE_SCALAR, keyVarIndex,		envPtr);
    TclEmitOpcode(	INST_POP,				envPtr);
    Emit14Inst(		INST_STORE_SCALAR, valueVarIndex,	envPtr);
    TclEmitOpcode(	INST_POP,				envPtr);

    /*
     * Set up the loop exception targets.
     */

    loopRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
    ExceptionRangeStarts(envPtr, loopRange);

    /*
     * Compile the loop body itself. It should be stack-neutral.
     */

    SetLineInformation(4);
    CompileBody(envPtr, bodyTokenPtr, interp);
    TclEmitOpcode(	INST_POP,				envPtr);

    /*
     * Both exception target ranges (error and loop) end here.
     */

    ExceptionRangeEnds(envPtr, loopRange);
    ExceptionRangeEnds(envPtr, catchRange);

    /*
     * Continue (or just normally process) by getting the next pair of items
     * from the dictionary and jumping back to the code to write them into
     * variables if there is another pair.
     */

    ExceptionRangeTarget(envPtr, loopRange, continueOffset);
    TclEmitInstInt4(	INST_DICT_NEXT, infoIndex,		envPtr);
    jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
    TclEmitInstInt4(	INST_JUMP_FALSE4, jumpDisplacement,	envPtr);
    TclEmitOpcode(	INST_POP,				envPtr);
    TclEmitOpcode(	INST_POP,				envPtr);

    /*
     * Now do the final cleanup for the no-error case (this is where we break
     * out of the loop to) by force-terminating the iteration (if not already
     * terminated), ditching the exception info and jumping to the last
     * instruction for this command. In theory, this could be done using the
     * "finally" clause (next generated) but this is faster.
     */

    ExceptionRangeTarget(envPtr, loopRange, breakOffset);
    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
    TclEmitInt4(	infoIndex,				envPtr);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);
    endTargetOffset = CurrentOffset(envPtr);
    TclEmitInstInt4(	INST_JUMP4, 0,				envPtr);

    /*
     * Error handler "finally" clause, which force-terminates the iteration
     * and rethrows the error.
     */

    ExceptionRangeTarget(envPtr, catchRange, catchOffset);
    TclEmitOpcode(	INST_PUSH_RETURN_OPTIONS,		envPtr);
    TclEmitOpcode(	INST_PUSH_RESULT,			envPtr);
    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
    TclEmitInt4(	infoIndex,				envPtr);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);
    TclEmitOpcode(	INST_RETURN_STK,			envPtr);

    /*
     * Otherwise we're done (the jump after the DICT_FIRST points here) and we
     * need to pop the bogus key/value pair (pushed to keep stack calculations
     * easy!) Note that we skip the END_CATCH. [Bug 1382528]
     */

    envPtr->currStackDepth = savedStackDepth+2;
    jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset;
    TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
	    envPtr->codeStart + emptyTargetOffset);
    TclEmitOpcode(	INST_POP,				envPtr);
    TclEmitOpcode(	INST_POP,				envPtr);
    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
    TclEmitInt4(	infoIndex,				envPtr);

    /*
     * Final stage of the command (normal case) is that we push an empty
     * object. This is done last to promote peephole optimization when it's
     * dropped immediately.
     */

1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
     */

    infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr);

    for (i=0 ; i<numVars ; i++) {
	CompileWord(envPtr, keyTokenPtrs[i], interp, i);
    }
    TclEmitInstInt4( INST_LIST, numVars,			envPtr);
    TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex,		envPtr);
    TclEmitInt4(     infoIndex,					envPtr);

    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
    TclEmitInstInt4( INST_BEGIN_CATCH4, range,			envPtr);

    ExceptionRangeStarts(envPtr, range);
    envPtr->currStackDepth++;
    CompileBody(envPtr, bodyTokenPtr, interp);
    envPtr->currStackDepth = savedStackDepth;
    ExceptionRangeEnds(envPtr, range);

    /*
     * Normal termination code: the stack has the key list below the result of
     * the body evaluation: swap them and finish the update code.
     */

    TclEmitOpcode(   INST_END_CATCH,				envPtr);
    TclEmitInstInt4( INST_REVERSE, 2,				envPtr);
    TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex,		envPtr);
    TclEmitInt4(     infoIndex,					envPtr);

    /*
     * Jump around the exceptional termination code.
     */

    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);

    /*
     * Termination code for non-ok returns: stash the result and return
     * options in the stack, bring up the key list, finish the update code,
     * and finally return with the catched return data
     */

    ExceptionRangeTarget(envPtr, range, catchOffset);
    TclEmitOpcode(   INST_PUSH_RESULT,				envPtr);
    TclEmitOpcode(   INST_PUSH_RETURN_OPTIONS,			envPtr);
    TclEmitOpcode(   INST_END_CATCH,				envPtr);
    TclEmitInstInt4( INST_REVERSE, 3,				envPtr);

    TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex,		envPtr);
    TclEmitInt4(     infoIndex,					envPtr);
    TclEmitOpcode(   INST_RETURN_STK,				envPtr);

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }
    TclStackFree(interp, keyTokenPtrs);
    return TCL_OK;







|
|
|


|












|
|
|
|














|
|
|
|

|
|
|







1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
     */

    infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr);

    for (i=0 ; i<numVars ; i++) {
	CompileWord(envPtr, keyTokenPtrs[i], interp, i);
    }
    TclEmitInstInt4(	INST_LIST, numVars,			envPtr);
    TclEmitInstInt4(	INST_DICT_UPDATE_START, dictIndex,	envPtr);
    TclEmitInt4(	infoIndex,				envPtr);

    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
    TclEmitInstInt4(	INST_BEGIN_CATCH4, range,		envPtr);

    ExceptionRangeStarts(envPtr, range);
    envPtr->currStackDepth++;
    CompileBody(envPtr, bodyTokenPtr, interp);
    envPtr->currStackDepth = savedStackDepth;
    ExceptionRangeEnds(envPtr, range);

    /*
     * Normal termination code: the stack has the key list below the result of
     * the body evaluation: swap them and finish the update code.
     */

    TclEmitOpcode(	INST_END_CATCH,				envPtr);
    TclEmitInstInt4(	INST_REVERSE, 2,			envPtr);
    TclEmitInstInt4(	INST_DICT_UPDATE_END, dictIndex,	envPtr);
    TclEmitInt4(	infoIndex,				envPtr);

    /*
     * Jump around the exceptional termination code.
     */

    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);

    /*
     * Termination code for non-ok returns: stash the result and return
     * options in the stack, bring up the key list, finish the update code,
     * and finally return with the catched return data
     */

    ExceptionRangeTarget(envPtr, range, catchOffset);
    TclEmitOpcode(	INST_PUSH_RESULT,			envPtr);
    TclEmitOpcode(	INST_PUSH_RETURN_OPTIONS,		envPtr);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);
    TclEmitInstInt4(	INST_REVERSE, 3,			envPtr);

    TclEmitInstInt4(	INST_DICT_UPDATE_END, dictIndex,	envPtr);
    TclEmitInt4(	infoIndex,				envPtr);
    TclEmitOpcode(	INST_RETURN_STK,			envPtr);

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }
    TclStackFree(interp, keyTokenPtrs);
    return TCL_OK;
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248

1249
1250
1251

1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279




1280












1281
1282
1283
1284

1285
1286

1287







1288



1289


1290
1291














1292













1293

1294

1295







1296




1297









1298
1299
1300
1301
1302

1303
1304








1305
1306
1307
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
    }
    dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
    if (dictVarIndex < 0) {
	return TCL_ERROR;
    }
    CompileWord(envPtr, keyTokenPtr, interp, 3);
    CompileWord(envPtr, valueTokenPtr, interp, 4);
    TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr);
    return TCL_OK;
}

int
TclCompileDictWithCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    int i, range, varNameTmp, pathTmp, keysTmp, gotPath, dictVar = -1;

    Tcl_Token *dictVarTokenPtr, *tokenPtr;
    int savedStackDepth = envPtr->currStackDepth;
    JumpFixup jumpFixup;


    /*
     * There must be at least one argument after the command and we must be in
     * a procedure so we can have local temporaries.
     */

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }
    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }

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

    dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr);
    tokenPtr = TokenAfter(dictVarTokenPtr);
    for (i=3 ; i<parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
    }
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	return TCL_ERROR;
    }

    /*




     * Allocate local (unnamed, untraced) working variables.












     */

    gotPath = (parsePtr->numWords > 3);
    if (dictVarTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {

	const char *ptr = dictVarTokenPtr[1].start;
	const char *end = ptr + dictVarTokenPtr[1].size;

	int notArray = 1;











	/*


	 * A conservative check for if we're working with an array since we
	 * have a reasonable fallback if things are tricky.














	 */















	for (; ptr<end ; ptr++) {

	    if (*ptr == '(' || *ptr == ')') {







		notArray = 0;




		break;









	    }
	}
	if (notArray) {
	    dictVar = TclFindCompiledLocal(dictVarTokenPtr[1].start,
		    dictVarTokenPtr[1].size, 1, envPtr);

	}
    }








    if (dictVar == -1) {
	varNameTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
    } else {
	varNameTmp = -1;
    }
    if (gotPath) {
	pathTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
    } else {
	pathTmp = -1;
    }
    keysTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);

    /*
     * Issue instructions. First, the part to expand the dictionary.
     */

    tokenPtr = dictVarTokenPtr;
    if (varNameTmp > -1) {
	CompileWord(envPtr, tokenPtr, interp, 0);
	if (varNameTmp <= 255) {
	    TclEmitInstInt1(	INST_STORE_SCALAR1, varNameTmp,	envPtr);
	} else {
	    TclEmitInstInt4(	INST_STORE_SCALAR4, varNameTmp,	envPtr);
	}
    }
    tokenPtr = TokenAfter(tokenPtr);
    if (gotPath) {
	for (i=2 ; i<parsePtr->numWords-1 ; i++) {
	    CompileWord(envPtr, tokenPtr, interp, i-1);
	    tokenPtr = TokenAfter(tokenPtr);
	}
	TclEmitInstInt4(	INST_LIST, parsePtr->numWords-3,envPtr);
	if (pathTmp <= 255) {
	    TclEmitInstInt1(	INST_STORE_SCALAR1, pathTmp,	envPtr);
	} else {
	    TclEmitInstInt4(	INST_STORE_SCALAR4, pathTmp,	envPtr);
	}
	TclEmitOpcode(		INST_POP,			envPtr);
    }
    if (dictVar == -1) {
	TclEmitOpcode(		INST_LOAD_STK,			envPtr);
    } else if (dictVar <= 255) {
	TclEmitInstInt1(	INST_LOAD_SCALAR1, dictVar,	envPtr);
    } else {
	TclEmitInstInt4(	INST_LOAD_SCALAR4, dictVar,	envPtr);
    }
    if (gotPath) {
	if (pathTmp <= 255) {
	    TclEmitInstInt1(	INST_LOAD_SCALAR1, pathTmp,	envPtr);
	} else {
	    TclEmitInstInt4(	INST_LOAD_SCALAR4, pathTmp,	envPtr);
	}
    } else {
	PushLiteral(envPtr, "", 0);
    }
    TclEmitOpcode(		INST_DICT_EXPAND,		envPtr);
    if (keysTmp <= 255) {
	TclEmitInstInt1(	INST_STORE_SCALAR1, keysTmp,	envPtr);
    } else {
	TclEmitInstInt4(	INST_STORE_SCALAR4, keysTmp,	envPtr);
    }
    TclEmitOpcode(		INST_POP,			envPtr);

    /*
     * Now the body of the [dict with].
     */

    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);







|














>
|


>


|
<


<
<
<









|
|








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



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

>
>
>
|
>
>
|
<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>

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


<
<
<
>
|
|
>
>
>
>
>
>
>
>
















<

|
<
|
<
<
|
<
|






<
|
<
<
<




<
<

|


<
|
<
<
<




<
|
<
<
<







1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256

1257
1258



1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
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
1395
1396
1397
1398
1399
1400
1401
1402

1403
1404

1405


1406

1407
1408
1409
1410
1411
1412
1413

1414



1415
1416
1417
1418


1419
1420
1421
1422

1423



1424
1425
1426
1427

1428



1429
1430
1431
1432
1433
1434
1435
    }
    dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
    if (dictVarIndex < 0) {
	return TCL_ERROR;
    }
    CompileWord(envPtr, keyTokenPtr, interp, 3);
    CompileWord(envPtr, valueTokenPtr, interp, 4);
    TclEmitInstInt4(	INST_DICT_LAPPEND, dictVarIndex,	envPtr);
    return TCL_OK;
}

int
TclCompileDictWithCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    int i, range, varNameTmp, pathTmp, keysTmp, gotPath, dictVar = -1;
    int bodyIsEmpty = 1;
    Tcl_Token *varTokenPtr, *tokenPtr;
    int savedStackDepth = envPtr->currStackDepth;
    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>
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    tokenPtr = TokenAfter(varTokenPtr);
    for (i=3 ; i<parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
    }
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	return TCL_ERROR;
    }

    /*
     * Test if the last word is an empty script; if so, we can compile it in
     * all cases, but if it is non-empty we need local variable table entries
     * to hold the temporary variables (used to keep stack usage simple).
     */

    for (ptr=tokenPtr[1].start,end=ptr+tokenPtr[1].size ; ptr!=end ; ptr++) {
	if (*ptr!=' ' && *ptr!='\t' && *ptr!='\n' && *ptr!='\r') {
	    if (envPtr->procPtr == NULL) {
		return TCL_ERROR;
	    }
	    bodyIsEmpty = 0;
	    break;
	}
    }

    /*
     * Determine if we're manipulating a dict in a simple local variable.
     */

    gotPath = (parsePtr->numWords > 3);
    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD &&
	    TclIsLocalScalar(varTokenPtr[1].start, varTokenPtr[1].size)) {
	dictVar = TclFindCompiledLocal(varTokenPtr[1].start,
		varTokenPtr[1].size, 1, envPtr);
    }

    /*
     * Special case: an empty body means we definitely have no need to issue
     * try-finally style code or to allocate local variable table entries for
     * storing temporaries. Still need to do both INST_DICT_EXPAND and
     * INST_DICT_RECOMBINE_* though, because we can't determine if we're free
     * of traces.
     */

    if (bodyIsEmpty) {
	if (dictVar >= 0) {
	    if (gotPath) {
		/*
		 * Case: Path into dict in LVT with empty body.
		 */


		tokenPtr = TokenAfter(varTokenPtr);
		for (i=2 ; i<parsePtr->numWords-1 ; i++) {
		    CompileWord(envPtr, tokenPtr, interp, i-1);
		    tokenPtr = TokenAfter(tokenPtr);
		}
		TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
		Emit14Inst(	INST_LOAD_SCALAR, dictVar,	envPtr);
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
		TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
		PushLiteral(envPtr, "", 0);
	    } else {
		/*
		 * Case: Direct dict in LVT with empty body.
		 */

		PushLiteral(envPtr, "", 0);
		Emit14Inst(	INST_LOAD_SCALAR, dictVar,	envPtr);
		PushLiteral(envPtr, "", 0);
		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
		TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
		PushLiteral(envPtr, "", 0);
	    }
	} else {
	    if (gotPath) {
		/*
		 * Case: Path into dict in non-simple var with empty body.
		 */

		tokenPtr = varTokenPtr;
		for (i=1 ; i<parsePtr->numWords-1 ; i++) {
		    CompileWord(envPtr, tokenPtr, interp, i-1);
		    tokenPtr = TokenAfter(tokenPtr);
		}
		TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitOpcode(	INST_LOAD_STK,			envPtr);
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
		TclEmitOpcode(	INST_DICT_RECOMBINE_STK,	envPtr);
		PushLiteral(envPtr, "", 0);
	    } else {
		/*
		 * Case: Direct dict in non-simple var with empty body.
		 */

		CompileWord(envPtr, varTokenPtr, interp, 0);
		TclEmitOpcode(	INST_DUP,			envPtr);
		TclEmitOpcode(	INST_LOAD_STK,			envPtr);
		PushLiteral(envPtr, "", 0);
		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
		PushLiteral(envPtr, "", 0);
		TclEmitInstInt4(INST_REVERSE, 2,		envPtr);
		TclEmitOpcode(	INST_DICT_RECOMBINE_STK,	envPtr);
		PushLiteral(envPtr, "", 0);
	    }
	}



	return TCL_OK;
    }

    /*
     * OK, we have a non-trivial body. This means that the focus is on
     * generating a try-finally structure where the INST_DICT_RECOMBINE_* goes
     * in the 'finally' clause.
     *
     * Start by allocating local (unnamed, untraced) working variables.
     */

    if (dictVar == -1) {
	varNameTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
    } else {
	varNameTmp = -1;
    }
    if (gotPath) {
	pathTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);
    } else {
	pathTmp = -1;
    }
    keysTmp = TclFindCompiledLocal(NULL, 0, 1, envPtr);

    /*
     * Issue instructions. First, the part to expand the dictionary.
     */


    if (varNameTmp > -1) {
	CompileWord(envPtr, varTokenPtr, interp, 0);

	Emit14Inst(		INST_STORE_SCALAR, varNameTmp,	envPtr);


    }

    tokenPtr = TokenAfter(varTokenPtr);
    if (gotPath) {
	for (i=2 ; i<parsePtr->numWords-1 ; i++) {
	    CompileWord(envPtr, tokenPtr, interp, i-1);
	    tokenPtr = TokenAfter(tokenPtr);
	}
	TclEmitInstInt4(	INST_LIST, parsePtr->numWords-3,envPtr);

	Emit14Inst(		INST_STORE_SCALAR, pathTmp,	envPtr);



	TclEmitOpcode(		INST_POP,			envPtr);
    }
    if (dictVar == -1) {
	TclEmitOpcode(		INST_LOAD_STK,			envPtr);


    } else {
	Emit14Inst(		INST_LOAD_SCALAR, dictVar,	envPtr);
    }
    if (gotPath) {

	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);



    } else {
	PushLiteral(envPtr, "", 0);
    }
    TclEmitOpcode(		INST_DICT_EXPAND,		envPtr);

    Emit14Inst(			INST_STORE_SCALAR, keysTmp,	envPtr);



    TclEmitOpcode(		INST_POP,			envPtr);

    /*
     * Now the body of the [dict with].
     */

    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
    ExceptionRangeEnds(envPtr, range);

    /*
     * Now fold the results back into the dictionary in the OK case.
     */

    TclEmitOpcode(		INST_END_CATCH,			envPtr);
    if (varNameTmp > -1 && varNameTmp <= 255) {
	TclEmitInstInt1(	INST_LOAD_SCALAR1, varNameTmp,	envPtr);
    } else if (varNameTmp > -1) {
	TclEmitInstInt4(	INST_LOAD_SCALAR4, varNameTmp,	envPtr);
    }
    if (gotPath) {
	if (pathTmp <= 255) {
	    TclEmitInstInt1(	INST_LOAD_SCALAR1, pathTmp,	envPtr);
	} else {
	    TclEmitInstInt4(	INST_LOAD_SCALAR4, pathTmp,	envPtr);
	}
    } else {
	PushLiteral(envPtr, "", 0);
    }
    if (keysTmp <= 255) {
	TclEmitInstInt1(	INST_LOAD_SCALAR1, keysTmp,	envPtr);
    } else {
	TclEmitInstInt4(	INST_LOAD_SCALAR4, keysTmp,	envPtr);
    }
    if (dictVar == -1) {
	TclEmitOpcode(		INST_DICT_RECOMBINE_STK,	envPtr);
    } else {
	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
    }
    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);

    /*
     * Now fold the results back into the dictionary in the exception case.
     */

    ExceptionRangeTarget(envPtr, range, catchOffset);
    TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    TclEmitOpcode(		INST_END_CATCH,			envPtr);
    if (varNameTmp > -1 && varNameTmp <= 255) {
	TclEmitInstInt1(	INST_LOAD_SCALAR1, varNameTmp,	envPtr);
    } else if (varNameTmp > -1) {
	TclEmitInstInt4(	INST_LOAD_SCALAR4, varNameTmp,	envPtr);
    }
    if (parsePtr->numWords > 3) {
	if (pathTmp <= 255) {
	    TclEmitInstInt1(	INST_LOAD_SCALAR1, pathTmp,	envPtr);
	} else {
	    TclEmitInstInt4(	INST_LOAD_SCALAR4, pathTmp,	envPtr);
	}
    } else {
	PushLiteral(envPtr, "", 0);
    }
    if (keysTmp <= 255) {
	TclEmitInstInt1(	INST_LOAD_SCALAR1, keysTmp,	envPtr);
    } else {
	TclEmitInstInt4(	INST_LOAD_SCALAR4, keysTmp,	envPtr);
    }
    if (dictVar == -1) {
	TclEmitOpcode(		INST_DICT_RECOMBINE_STK,	envPtr);
    } else {
	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
    }
    TclEmitOpcode(		INST_RETURN_STK,		envPtr);








|
|
<
<


<
|
<
<
<



<
|
<
<
<















|
|
<
<


<
|
<
<
<



<
|
<
<
<







1443
1444
1445
1446
1447
1448
1449
1450
1451


1452
1453

1454



1455
1456
1457

1458



1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475


1476
1477

1478



1479
1480
1481

1482



1483
1484
1485
1486
1487
1488
1489
    ExceptionRangeEnds(envPtr, range);

    /*
     * Now fold the results back into the dictionary in the OK case.
     */

    TclEmitOpcode(		INST_END_CATCH,			envPtr);
    if (varNameTmp > -1) {
	Emit14Inst(		INST_LOAD_SCALAR, varNameTmp,	envPtr);


    }
    if (gotPath) {

	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);



    } else {
	PushLiteral(envPtr, "", 0);
    }

    Emit14Inst(			INST_LOAD_SCALAR, keysTmp,	envPtr);



    if (dictVar == -1) {
	TclEmitOpcode(		INST_DICT_RECOMBINE_STK,	envPtr);
    } else {
	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
    }
    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);

    /*
     * Now fold the results back into the dictionary in the exception case.
     */

    ExceptionRangeTarget(envPtr, range, catchOffset);
    TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    TclEmitOpcode(		INST_END_CATCH,			envPtr);
    if (varNameTmp > -1) {
	Emit14Inst(		INST_LOAD_SCALAR, varNameTmp,	envPtr);


    }
    if (parsePtr->numWords > 3) {

	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);



    } else {
	PushLiteral(envPtr, "", 0);
    }

    Emit14Inst(			INST_LOAD_SCALAR, keysTmp,	envPtr);



    if (dictVar == -1) {
	TclEmitOpcode(		INST_DICT_RECOMBINE_STK,	envPtr);
    } else {
	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
    }
    TclEmitOpcode(		INST_RETURN_STK,		envPtr);

1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
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
    for (i = 0, tokenPtr = parsePtr->tokenPtr;
	    i < numWords-1;
	    i++, tokenPtr = TokenAfter(tokenPtr)) {
	if ((i%2 == 0) && (i > 0)) {
	    SetLineInformation(i);
	    CompileTokens(envPtr, tokenPtr, interp);
	    tempVar = (firstValueTemp + loopIndex);
	    if (tempVar <= 255) {
		TclEmitInstInt1(INST_STORE_SCALAR1, tempVar, envPtr);
	    } else {
		TclEmitInstInt4(INST_STORE_SCALAR4, tempVar, envPtr);
	    }
	    TclEmitOpcode(INST_POP, envPtr);
	    loopIndex++;
	}
    }

    /*
     * Initialize the temporary var that holds the count of loop iterations.
     */

    TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);

    /*
     * Top of loop code: assign each loop variable and check whether
     * to terminate the loop.
     */

    ExceptionRangeTarget(envPtr, range, continueOffset);
    TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);

    /*
     * Inline compile the loop body.
     */

    SetLineInformation(bodyIndex);
    ExceptionRangeStarts(envPtr, range);
    CompileBody(envPtr, bodyTokenPtr, interp);
    ExceptionRangeEnds(envPtr, range);
    envPtr->currStackDepth = savedStackDepth + 1;
    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Jump back to the test at the top of the loop. Generate a 4 byte jump if
     * the distance to the test is > 120 bytes. This is conservative and
     * ensures that we won't have to replace this jump if we later need to
     * replace the ifFalse jump with a 4 byte jump.
     */







<
|
<
<
<
|








|







|











|







2029
2030
2031
2032
2033
2034
2035

2036



2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
    for (i = 0, tokenPtr = parsePtr->tokenPtr;
	    i < numWords-1;
	    i++, tokenPtr = TokenAfter(tokenPtr)) {
	if ((i%2 == 0) && (i > 0)) {
	    SetLineInformation(i);
	    CompileTokens(envPtr, tokenPtr, interp);
	    tempVar = (firstValueTemp + loopIndex);

	    Emit14Inst(		INST_STORE_SCALAR, tempVar,	envPtr);



	    TclEmitOpcode(	INST_POP,			envPtr);
	    loopIndex++;
	}
    }

    /*
     * Initialize the temporary var that holds the count of loop iterations.
     */

    TclEmitInstInt4(		INST_FOREACH_START4, infoIndex,	envPtr);

    /*
     * Top of loop code: assign each loop variable and check whether
     * to terminate the loop.
     */

    ExceptionRangeTarget(envPtr, range, continueOffset);
    TclEmitInstInt4(		INST_FOREACH_STEP4, infoIndex,	envPtr);
    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);

    /*
     * Inline compile the loop body.
     */

    SetLineInformation(bodyIndex);
    ExceptionRangeStarts(envPtr, range);
    CompileBody(envPtr, bodyTokenPtr, interp);
    ExceptionRangeEnds(envPtr, range);
    envPtr->currStackDepth = savedStackDepth + 1;
    TclEmitOpcode(		INST_POP,			envPtr);

    /*
     * Jump back to the test at the top of the loop. Generate a 4 byte jump if
     * the distance to the test is > 120 bytes. This is conservative and
     * ensures that we won't have to replace this jump if we later need to
     * replace the ifFalse jump with a 4 byte jump.
     */
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);

	if (localIndex < 0) {
	    return TCL_ERROR;
	}

	CompileWord(envPtr, varTokenPtr, interp, 1);
	TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr);
    }

    /*
     * Pop the namespace, and set the result to empty
     */

    TclEmitOpcode(INST_POP, envPtr);
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|






|







2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);

	if (localIndex < 0) {
	    return TCL_ERROR;
	}

	CompileWord(envPtr, varTokenPtr, interp, 1);
	TclEmitInstInt4(	INST_NSUPVAR, localIndex,	envPtr);
    }

    /*
     * Pop the namespace, and set the result to empty
     */

    TclEmitOpcode(		INST_POP,			envPtr);
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
2701
2702
2703
2704
2705
2706
2707
2708





2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
	haveImmValue = 1;
    }

    /*
     * Emit the instruction to increment the variable.
     */

    if (simpleVarName) {





	if (isScalar) {
	    if (localIndex >= 0) {
		if (haveImmValue) {
		    TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
		    TclEmitInt1(immValue, envPtr);
		} else {
		    TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr);
		}
	    } else {
		if (haveImmValue) {
		    TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr);
		} else {
		    TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
		}
	    }
	} else {
	    if (localIndex >= 0) {
		if (haveImmValue) {
		    TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
		    TclEmitInt1(immValue, envPtr);
		} else {
		    TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr);
		}
	    } else {
		if (haveImmValue) {
		    TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
		} else {
		    TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
		}
	    }
	}
    } else {			/* Non-simple variable name. */
	if (haveImmValue) {
	    TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
	} else {
	    TclEmitOpcode(INST_INCR_STK, envPtr);
	}
    }

    return TCL_OK;
}

/*







|
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
<
<
<
<
<
<







2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781







2782
2783
2784
2785
2786
2787
2788
	haveImmValue = 1;
    }

    /*
     * Emit the instruction to increment the variable.
     */

    if (!simpleVarName) {
	if (haveImmValue) {
	    TclEmitInstInt1(	INST_INCR_STK_IMM, immValue,	envPtr);
	} else {
	    TclEmitOpcode(	INST_INCR_STK,			envPtr);
	}
    } else if (isScalar) {	/* Simple scalar variable. */
	if (localIndex >= 0) {
	    if (haveImmValue) {
		TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
		TclEmitInt1(immValue, envPtr);
	    } else {
		TclEmitInstInt1(INST_INCR_SCALAR1, localIndex,	envPtr);
	    }
	} else {
	    if (haveImmValue) {
		TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr);
	    } else {
		TclEmitOpcode(	INST_INCR_SCALAR_STK,		envPtr);
	    }
	}
    } else {			/* Simple array variable. */
	if (localIndex >= 0) {
	    if (haveImmValue) {
		TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
		TclEmitInt1(immValue, envPtr);
	    } else {
		TclEmitInstInt1(INST_INCR_ARRAY1, localIndex,	envPtr);
	    }
	} else {
	    if (haveImmValue) {
		TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
	    } else {
		TclEmitOpcode(	INST_INCR_ARRAY_STK,		envPtr);
	    }







	}
    }

    return TCL_OK;
}

/*
2795
2796
2797
2798
2799
2800
2801
2802

2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
    PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex,
	    &simpleVarName, &isScalar, 1);

    /*
     * Emit instruction to check the variable for existence.
     */

    if (simpleVarName) {

	if (isScalar) {
	    if (localIndex < 0) {
		TclEmitOpcode(INST_EXIST_STK, envPtr);
	    } else {
		TclEmitInstInt4(INST_EXIST_SCALAR, localIndex, envPtr);
	    }
	} else {
	    if (localIndex < 0) {
		TclEmitOpcode(INST_EXIST_ARRAY_STK, envPtr);
	    } else {
		TclEmitInstInt4(INST_EXIST_ARRAY, localIndex, envPtr);
	    }
	}
    } else {
	TclEmitOpcode(INST_EXIST_STK, envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------







|
>
|
|
|
|
|
|
|
|
|
|
|
|
<
<
<







2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852



2853
2854
2855
2856
2857
2858
2859
    PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex,
	    &simpleVarName, &isScalar, 1);

    /*
     * Emit instruction to check the variable for existence.
     */

    if (!simpleVarName) {
	TclEmitOpcode(		INST_EXIST_STK,			envPtr);
    } else if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_EXIST_STK,			envPtr);
	} else {
	    TclEmitInstInt4(	INST_EXIST_SCALAR, localIndex,	envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_EXIST_ARRAY_STK,		envPtr);
	} else {
	    TclEmitInstInt4(	INST_EXIST_ARRAY, localIndex,	envPtr);
	}



    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
2900
2901
2902
2903
2904
2905
2906
2907

2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
     */

    /*
     * The *_STK opcodes should be refactored to make better use of existing
     * LOAD/STORE instructions.
     */

    if (simpleVarName) {

	if (isScalar) {
	    if (localIndex < 0) {
		TclEmitOpcode(INST_LAPPEND_STK, envPtr);
	    } else if (localIndex <= 255) {
		TclEmitInstInt1(INST_LAPPEND_SCALAR1, localIndex, envPtr);
	    } else {
		TclEmitInstInt4(INST_LAPPEND_SCALAR4, localIndex, envPtr);
	    }
	} else {
	    if (localIndex < 0) {
		TclEmitOpcode(INST_LAPPEND_ARRAY_STK, envPtr);
	    } else if (localIndex <= 255) {
		TclEmitInstInt1(INST_LAPPEND_ARRAY1, localIndex, envPtr);
	    } else {
		TclEmitInstInt4(INST_LAPPEND_ARRAY4, localIndex, envPtr);
	    }
	}
    } else {
	TclEmitOpcode(INST_LAPPEND_STK, envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------







|
>
|
|
|
<
<
|
|
|
|
|
|
<
<
|
|
|
<
<
<







2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946


2947
2948
2949
2950
2951
2952


2953
2954
2955



2956
2957
2958
2959
2960
2961
2962
     */

    /*
     * The *_STK opcodes should be refactored to make better use of existing
     * LOAD/STORE instructions.
     */

    if (!simpleVarName) {
	TclEmitOpcode(		INST_LAPPEND_STK,		envPtr);
    } else if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_LAPPEND_STK,		envPtr);


	} else {
	    Emit14Inst(		INST_LAPPEND_SCALAR, localIndex, envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_LAPPEND_ARRAY_STK,		envPtr);


	} else {
	    Emit14Inst(		INST_LAPPEND_ARRAY, localIndex,	envPtr);
	}



    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
2992
2993
2994
2995
2996
2997
2998
2999




3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012

3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026

3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
		&simpleVarName, &isScalar, idx+2);

	/*
	 * Emit instructions to get the idx'th item out of the list value on
	 * the stack and assign it to the variable.
	 */

	if (simpleVarName) {




	    if (isScalar) {
		if (localIndex >= 0) {
		    TclEmitOpcode(INST_DUP, envPtr);
		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
		    if (localIndex <= 255) {
			TclEmitInstInt1(INST_STORE_SCALAR1,localIndex,envPtr);
		    } else {
			TclEmitInstInt4(INST_STORE_SCALAR4,localIndex,envPtr);
		    }
		} else {
		    TclEmitInstInt4(INST_OVER, 1, envPtr);
		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
		    TclEmitOpcode(INST_STORE_SCALAR_STK, envPtr);

		}
	    } else {
		if (localIndex >= 0) {
		    TclEmitInstInt4(INST_OVER, 1, envPtr);
		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
		    if (localIndex <= 255) {
			TclEmitInstInt1(INST_STORE_ARRAY1, localIndex, envPtr);
		    } else {
			TclEmitInstInt4(INST_STORE_ARRAY4, localIndex, envPtr);
		    }
		} else {
		    TclEmitInstInt4(INST_OVER, 2, envPtr);
		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
		    TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);

		}
	    }
	} else {
	    TclEmitInstInt4(INST_OVER, 1, envPtr);
	    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
	    TclEmitOpcode(INST_STORE_STK, envPtr);
	}
	TclEmitOpcode(INST_POP, envPtr);
    }

    /*
     * Generate code to leave the rest of the list on the stack.
     */

    TclEmitInstInt4(INST_LIST_RANGE_IMM, idx, envPtr);
    TclEmitInt4(-2, envPtr);	/* -2 == "end" */

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|
>
>
>
>
|
|
|
|
<
|
<
|
<
|
|
|
|
>
|
|
|
|
|
<
|
<
|
<
|
|
|
|
>
|
|
<
<
<
<
<
<






|
|







3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036

3037

3038

3039
3040
3041
3042
3043
3044
3045
3046
3047
3048

3049

3050

3051
3052
3053
3054
3055
3056
3057






3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
		&simpleVarName, &isScalar, idx+2);

	/*
	 * Emit instructions to get the idx'th item out of the list value on
	 * the stack and assign it to the variable.
	 */

	if (!simpleVarName) {
	    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
	    TclEmitInstInt4(	INST_LIST_INDEX_IMM, idx,	envPtr);
	    TclEmitOpcode(	INST_STORE_STK,			envPtr);
	    TclEmitOpcode(	INST_POP,			envPtr);
	} else if (isScalar) {
	    if (localIndex >= 0) {
		TclEmitOpcode(	INST_DUP,			envPtr);
		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);

		Emit14Inst(	INST_STORE_SCALAR, localIndex,	envPtr);

		TclEmitOpcode(	INST_POP,			envPtr);

	    } else {
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
		TclEmitOpcode(	INST_STORE_SCALAR_STK,		envPtr);
		TclEmitOpcode(	INST_POP,			envPtr);
	    }
	} else {
	    if (localIndex >= 0) {
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);

		Emit14Inst(	INST_STORE_ARRAY, localIndex,	envPtr);

		TclEmitOpcode(	INST_POP,			envPtr);

	    } else {
		TclEmitInstInt4(INST_OVER, 2,			envPtr);
		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
		TclEmitOpcode(	INST_STORE_ARRAY_STK,		envPtr);
		TclEmitOpcode(	INST_POP,			envPtr);
	    }
	}






    }

    /*
     * Generate code to leave the rest of the list on the stack.
     */

    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx,	envPtr);
    TclEmitInt4(		-2 /* == "end" */,		envPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
	     * construct:
	     *	 lindex <arbitraryValue> <posInt>
	     * This is best compiled as a push of the arbitrary value followed
	     * by an "immediate lindex" which is the most efficient variety.
	     */

	    CompileWord(envPtr, valTokenPtr, interp, 1);
	    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
	    return TCL_OK;
	}

	/*
	 * If the conversion failed or the value was negative, we just keep on
	 * going with the more complex compilation.
	 */







|







3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
	     * construct:
	     *	 lindex <arbitraryValue> <posInt>
	     * This is best compiled as a push of the arbitrary value followed
	     * by an "immediate lindex" which is the most efficient variety.
	     */

	    CompileWord(envPtr, valTokenPtr, interp, 1);
	    TclEmitInstInt4(	INST_LIST_INDEX_IMM, idx,	envPtr);
	    return TCL_OK;
	}

	/*
	 * If the conversion failed or the value was negative, we just keep on
	 * going with the more complex compilation.
	 */
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145

    /*
     * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI if there are
     * multiple index args.
     */

    if (numWords == 3) {
	TclEmitOpcode(INST_LIST_INDEX, envPtr);
    } else {
	TclEmitInstInt4(INST_LIST_INDEX_MULTI, numWords-1, envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------







|

|







3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168

    /*
     * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI if there are
     * multiple index args.
     */

    if (numWords == 3) {
	TclEmitOpcode(		INST_LIST_INDEX,		envPtr);
    } else {
	TclEmitInstInt4(	INST_LIST_INDEX_MULTI, numWords-1, envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
3165
3166
3167
3168
3169
3170
3171


3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */



    /*
     * If we're not in a procedure, don't compile.
     */

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

    if (parsePtr->numWords == 1) {
	/*
	 * [list] without arguments just pushes an empty object.
	 */

	PushLiteral(envPtr, "", 0);
    } else {
	/*
	 * Push the all values onto the stack.
	 */

	Tcl_Token *valueTokenPtr;
	int i, numWords;

	numWords = parsePtr->numWords;

	valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
	for (i = 1; i < numWords; i++) {
	    CompileWord(envPtr, valueTokenPtr, interp, i);
	    valueTokenPtr = TokenAfter(valueTokenPtr);
	}
	TclEmitInstInt4(INST_LIST, numWords - 1, envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------







>
>




















<
<
<

<





|







3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216



3217

3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *valueTokenPtr;
    int i, numWords;

    /*
     * If we're not in a procedure, don't compile.
     */

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

    if (parsePtr->numWords == 1) {
	/*
	 * [list] without arguments just pushes an empty object.
	 */

	PushLiteral(envPtr, "", 0);
    } else {
	/*
	 * Push the all values onto the stack.
	 */




	numWords = parsePtr->numWords;

	valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
	for (i = 1; i < numWords; i++) {
	    CompileWord(envPtr, valueTokenPtr, interp, i);
	    valueTokenPtr = TokenAfter(valueTokenPtr);
	}
	TclEmitInstInt4(	INST_LIST, numWords - 1,	envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    varTokenPtr = TokenAfter(parsePtr->tokenPtr);

    CompileWord(envPtr, varTokenPtr, interp, 1);
    TclEmitOpcode(INST_LIST_LENGTH, envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLsetCmd --







|







3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    varTokenPtr = TokenAfter(parsePtr->tokenPtr);

    CompileWord(envPtr, varTokenPtr, interp, 1);
    TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLsetCmd --
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427

    if (!simpleVarName || localIndex < 0) {
	if (!simpleVarName || isScalar) {
	    tempDepth = parsePtr->numWords - 2;
	} else {
	    tempDepth = parsePtr->numWords - 1;
	}
	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
    }

    /*
     * Duplicate an array index if one's been pushed.
     */

    if (simpleVarName && !isScalar) {
	if (localIndex < 0) {
	    tempDepth = parsePtr->numWords - 1;
	} else {
	    tempDepth = parsePtr->numWords - 2;
	}
	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
    }

    /*
     * Emit code to load the variable's value.
     */

    if (!simpleVarName) {
	TclEmitOpcode(INST_LOAD_STK, envPtr);
    } else if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
	} else if (localIndex < 0x100) {
	    TclEmitInstInt1(INST_LOAD_SCALAR1, localIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_LOAD_SCALAR4, localIndex, envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
	} else if (localIndex < 0x100) {
	    TclEmitInstInt1(INST_LOAD_ARRAY1, localIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_LOAD_ARRAY4, localIndex, envPtr);
	}
    }

    /*
     * Emit the correct variety of 'lset' instruction.
     */

    if (parsePtr->numWords == 4) {
	TclEmitOpcode(INST_LSET_LIST, envPtr);
    } else {
	TclEmitInstInt4(INST_LSET_FLAT, parsePtr->numWords-1, envPtr);
    }

    /*
     * Emit code to put the value back in the variable.
     */

    if (!simpleVarName) {
	TclEmitOpcode(INST_STORE_STK, envPtr);
    } else if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(INST_STORE_SCALAR_STK, envPtr);
	} else if (localIndex < 0x100) {
	    TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
	} else if (localIndex < 0x100) {
	    TclEmitInstInt1(INST_STORE_ARRAY1, localIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_STORE_ARRAY4, localIndex, envPtr);
	}
    }

    return TCL_OK;
}

/*







|












|







|


|
<
<

|



|
<
<

|








|

|







|


|
<
<

|



|
<
<

|







3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395


3396
3397
3398
3399
3400
3401


3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425


3426
3427
3428
3429
3430
3431


3432
3433
3434
3435
3436
3437
3438
3439
3440

    if (!simpleVarName || localIndex < 0) {
	if (!simpleVarName || isScalar) {
	    tempDepth = parsePtr->numWords - 2;
	} else {
	    tempDepth = parsePtr->numWords - 1;
	}
	TclEmitInstInt4(	INST_OVER, tempDepth,		envPtr);
    }

    /*
     * Duplicate an array index if one's been pushed.
     */

    if (simpleVarName && !isScalar) {
	if (localIndex < 0) {
	    tempDepth = parsePtr->numWords - 1;
	} else {
	    tempDepth = parsePtr->numWords - 2;
	}
	TclEmitInstInt4(	INST_OVER, tempDepth,		envPtr);
    }

    /*
     * Emit code to load the variable's value.
     */

    if (!simpleVarName) {
	TclEmitOpcode(		INST_LOAD_STK,			envPtr);
    } else if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_LOAD_SCALAR_STK,		envPtr);


	} else {
	    Emit14Inst(		INST_LOAD_SCALAR, localIndex,	envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_LOAD_ARRAY_STK,		envPtr);


	} else {
	    Emit14Inst(		INST_LOAD_ARRAY, localIndex,	envPtr);
	}
    }

    /*
     * Emit the correct variety of 'lset' instruction.
     */

    if (parsePtr->numWords == 4) {
	TclEmitOpcode(		INST_LSET_LIST,			envPtr);
    } else {
	TclEmitInstInt4(	INST_LSET_FLAT, parsePtr->numWords-1, envPtr);
    }

    /*
     * Emit code to put the value back in the variable.
     */

    if (!simpleVarName) {
	TclEmitOpcode(		INST_STORE_STK,			envPtr);
    } else if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_STORE_SCALAR_STK,		envPtr);


	} else {
	    Emit14Inst(		INST_STORE_SCALAR, localIndex,	envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_STORE_ARRAY_STK,		envPtr);


	} else {
	    Emit14Inst(		INST_STORE_ARRAY, localIndex,	envPtr);
	}
    }

    return TCL_OK;
}

/*
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
	CompileWord(envPtr, otherTokenPtr, interp, 1);
	PushVarNameWord(interp, localTokenPtr, envPtr, 0,
		&localIndex, &simpleVarName, &isScalar, 1);

	if ((localIndex < 0) || !isScalar) {
	    return TCL_ERROR;
	}
	TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr);
    }

    /*
     * Pop the namespace, and set the result to empty
     */

    TclEmitOpcode(INST_POP, envPtr);
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|






|







3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
	CompileWord(envPtr, otherTokenPtr, interp, 1);
	PushVarNameWord(interp, localTokenPtr, envPtr, 0,
		&localIndex, &simpleVarName, &isScalar, 1);

	if ((localIndex < 0) || !isScalar) {
	    return TCL_ERROR;
	}
	TclEmitInstInt4(	INST_NSUPVAR, localIndex,	envPtr);
    }

    /*
     * Pop the namespace, and set the result to empty
     */

    TclEmitOpcode(		INST_POP,			envPtr);
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
     */

    varTokenPtr = TokenAfter(varTokenPtr);
    CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1);

    if (simple) {
	if (exact && !nocase) {
	    TclEmitOpcode(INST_STR_EQ, envPtr);
	} else {
	    TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
	}
    } else {
	/*
	 * Pass correct RE compile flags.  We use only Int1 (8-bit), but
	 * that handles all the flags we want to pass.
	 * Don't use TCL_REG_NOSUB as we may have backrefs.
	 */

	int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0);

	TclEmitInstInt1(INST_REGEXP, cflags, envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------







|

|










|







3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
     */

    varTokenPtr = TokenAfter(varTokenPtr);
    CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1);

    if (simple) {
	if (exact && !nocase) {
	    TclEmitOpcode(	INST_STR_EQ,			envPtr);
	} else {
	    TclEmitInstInt1(	INST_STR_MATCH, nocase,		envPtr);
	}
    } else {
	/*
	 * Pass correct RE compile flags.  We use only Int1 (8-bit), but
	 * that handles all the flags we want to pass.
	 * Don't use TCL_REG_NOSUB as we may have backrefs.
	 */

	int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0);

	TclEmitInstInt1(	INST_REGEXP, cflags,		envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
    Tcl_Obj *msg = Tcl_GetObjResult(interp);
    int numBytes;
    const char *bytes = TclGetStringFromObj(msg, &numBytes);

    TclErrorStackResetIf(interp, bytes, numBytes);
    TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
    CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
			  TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileUpvarCmd --
 *







|







3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
    Tcl_Obj *msg = Tcl_GetObjResult(interp);
    int numBytes;
    const char *bytes = TclGetStringFromObj(msg, &numBytes);

    TclErrorStackResetIf(interp, bytes, numBytes);
    TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
    CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
	    TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileUpvarCmd --
 *
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
	CompileWord(envPtr, otherTokenPtr, interp, 1);
	PushVarNameWord(interp, localTokenPtr, envPtr, 0,
		&localIndex, &simpleVarName, &isScalar, 1);

	if ((localIndex < 0) || !isScalar) {
	    return TCL_ERROR;
	}
	TclEmitInstInt4(INST_UPVAR, localIndex, envPtr);
    }

    /*
     * Pop the frame index, and set the result to empty
     */

    TclEmitOpcode(INST_POP, envPtr);
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|






|







3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
	CompileWord(envPtr, otherTokenPtr, interp, 1);
	PushVarNameWord(interp, localTokenPtr, envPtr, 0,
		&localIndex, &simpleVarName, &isScalar, 1);

	if ((localIndex < 0) || !isScalar) {
	    return TCL_ERROR;
	}
	TclEmitInstInt4(	INST_UPVAR, localIndex,		envPtr);
    }

    /*
     * Pop the frame index, and set the result to empty
     */

    TclEmitOpcode(		INST_POP,			envPtr);
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);

	if (localIndex < 0) {
	    return TCL_ERROR;
	}

	CompileWord(envPtr, varTokenPtr, interp, 1);
	TclEmitInstInt4(INST_VARIABLE, localIndex, envPtr);

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

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

    /*
     * Set the result to empty
     */








|







<
|
<
<
<
|







4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059

4060



4061
4062
4063
4064
4065
4066
4067
4068
	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);

	if (localIndex < 0) {
	    return TCL_ERROR;
	}

	CompileWord(envPtr, varTokenPtr, interp, 1);
	TclEmitInstInt4(	INST_VARIABLE, localIndex,	envPtr);

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

	    CompileWord(envPtr, valueTokenPtr, interp, 1);

	    Emit14Inst(		INST_STORE_SCALAR, localIndex,	envPtr);



	    TclEmitOpcode(	INST_POP,			envPtr);
	}
    }

    /*
     * Set the result to empty
     */

Changes to generic/tclCompile.h.

672
673
674
675
676
677
678

679
680
681
682
683
684
685

/* For [unset] compilation */
#define INST_UNSET_SCALAR		134
#define INST_UNSET_ARRAY		135
#define INST_UNSET_ARRAY_STK		136
#define INST_UNSET_STK			137


#define INST_DICT_EXPAND		138
#define INST_DICT_RECOMBINE_STK		139
#define INST_DICT_RECOMBINE_IMM		140

/* The last opcode */
#define LAST_INST_OPCODE		140








>







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

/* For [unset] compilation */
#define INST_UNSET_SCALAR		134
#define INST_UNSET_ARRAY		135
#define INST_UNSET_ARRAY_STK		136
#define INST_UNSET_STK			137

/* For [dict with] compilation */
#define INST_DICT_EXPAND		138
#define INST_DICT_RECOMBINE_STK		139
#define INST_DICT_RECOMBINE_IMM		140

/* The last opcode */
#define LAST_INST_OPCODE		140


Changes to generic/tclNamesp.c.

166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
    {"delete",          NamespaceDeleteCmd, NULL, NULL, NULL, 0},
    {"ensemble",        TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0},
    {"eval",            NamespaceEvalCmd,       NULL, NRNamespaceEvalCmd, NULL, 0},
    {"exists",          NamespaceExistsCmd, NULL, NULL, NULL, 0},
    {"export",          NamespaceExportCmd, NULL, NULL, NULL, 0},
    {"forget",          NamespaceForgetCmd, NULL, NULL, NULL, 0},
    {"import",          NamespaceImportCmd, NULL, NULL, NULL, 0},
    {"inscope",         NamespaceInscopeCmd,    NULL, NULL, NRNamespaceInscopeCmd, 0},
    {"origin",          NamespaceOriginCmd, NULL, NULL, NULL, 0},
    {"parent",          NamespaceParentCmd, NULL, NULL, NULL, 0},
    {"path",            NamespacePathCmd, NULL, NULL, NULL, 0},
    {"qualifiers",      NamespaceQualifiersCmd, NULL, NULL, NULL, 0},
    {"tail",            NamespaceTailCmd, NULL, NULL, NULL, 0},
    {"unknown",         NamespaceUnknownCmd, NULL, NULL, NULL, 0},
    {"upvar",           NamespaceUpvarCmd,      TclCompileNamespaceUpvarCmd, NULL, NULL, 0},







|







166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
    {"delete",          NamespaceDeleteCmd, NULL, NULL, NULL, 0},
    {"ensemble",        TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0},
    {"eval",            NamespaceEvalCmd,       NULL, NRNamespaceEvalCmd, NULL, 0},
    {"exists",          NamespaceExistsCmd, NULL, NULL, NULL, 0},
    {"export",          NamespaceExportCmd, NULL, NULL, NULL, 0},
    {"forget",          NamespaceForgetCmd, NULL, NULL, NULL, 0},
    {"import",          NamespaceImportCmd, NULL, NULL, NULL, 0},
    {"inscope",         NamespaceInscopeCmd,    NULL, NRNamespaceInscopeCmd, NULL, 0},
    {"origin",          NamespaceOriginCmd, NULL, NULL, NULL, 0},
    {"parent",          NamespaceParentCmd, NULL, NULL, NULL, 0},
    {"path",            NamespacePathCmd, NULL, NULL, NULL, 0},
    {"qualifiers",      NamespaceQualifiersCmd, NULL, NULL, NULL, 0},
    {"tail",            NamespaceTailCmd, NULL, NULL, NULL, 0},
    {"unknown",         NamespaceUnknownCmd, NULL, NULL, NULL, 0},
    {"upvar",           NamespaceUpvarCmd,      TclCompileNamespaceUpvarCmd, NULL, NULL, 0},

Changes to generic/tclTest.c.

71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
    Tcl_AsyncHandler handler;	/* Tcl's token for the handler. */
    char *command;		/* Command to invoke when the handler is
				 * invoked. */
    struct TestAsyncHandler *nextPtr;
				/* Next is list of handlers. */
} TestAsyncHandler;

TCL_DECLARE_MUTEX(asyncTestMutex);

static TestAsyncHandler *firstHandler = NULL;

/*
 * The dynamic string below is used by the "testdstring" command to test the
 * dynamic string facilities.
 */







|







71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
    Tcl_AsyncHandler handler;	/* Tcl's token for the handler. */
    char *command;		/* Command to invoke when the handler is
				 * invoked. */
    struct TestAsyncHandler *nextPtr;
				/* Next is list of handlers. */
} TestAsyncHandler;

TCL_DECLARE_MUTEX(asyncTestMutex)

static TestAsyncHandler *firstHandler = NULL;

/*
 * The dynamic string below is used by the "testdstring" command to test the
 * dynamic string facilities.
 */
7105
7106
7107
7108
7109
7110
7111

7112
7113
7114
7115
7116
7117
7118

7119
7120
7121
7122
7123
7124
7125
static int
TestparseargsCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Arguments. */
{

    int count = objc, foo = 0;
    Tcl_Obj **remObjv, *result[3];
    Tcl_ArgvInfo argTable[] = {
        {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL},
        TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
    };


    if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
        return TCL_ERROR;
    }
    result[0] = Tcl_NewIntObj(foo);
    result[1] = Tcl_NewIntObj(count);
    result[2] = Tcl_NewListObj(count, remObjv);
    Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));







>
|






>







7105
7106
7107
7108
7109
7110
7111
7112
7113
7114
7115
7116
7117
7118
7119
7120
7121
7122
7123
7124
7125
7126
7127
static int
TestparseargsCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Arguments. */
{
    static int foo = 0;
    int count = objc;
    Tcl_Obj **remObjv, *result[3];
    Tcl_ArgvInfo argTable[] = {
        {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL},
        TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
    };

    foo = 0;
    if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
        return TCL_ERROR;
    }
    result[0] = Tcl_NewIntObj(foo);
    result[1] = Tcl_NewIntObj(count);
    result[2] = Tcl_NewListObj(count, remObjv);
    Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));

Changes to tests/dict.test.

1420
1421
1422
1423
1424
1425
1426
















































1427
1428
1429
1430
1431
1432
1433
	set d($i) {p {q {a 1 b 2}}}
	dict with d($i) p q {
	    set a $b.$a
	}
	array get d
    }} e
} {e {p {q {a 2.1 b 2}}}}

















































# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl







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







1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
	set d($i) {p {q {a 1 b 2}}}
	dict with d($i) p q {
	    set a $b.$a
	}
	array get d
    }} e
} {e {p {q {a 2.1 b 2}}}}
test dict-22.18 {dict with: compiled} {
    set ::d {a 1 b 2}
    apply {{} {
	dict with ::d {
	    set a $b.$a
	}
	return $::d
    }}
} {a 2.1 b 2}
test dict-22.19 {dict with: compiled} {
    set ::d {p {q {r {a 1 b 2}}}}
    apply {{} {
	dict with ::d p q r {
	    set a $b.$a
	}
	return $::d
    }}
} {p {q {r {a 2.1 b 2}}}}
test dict-22.20 {dict with: compiled} {
    apply {d {
	dict with d {
	}
	return $a,$b
    }} {a 1 b 2}
} 1,2
test dict-22.21 {dict with: compiled} {
    apply {d {
	dict with d p q {
	}
	return $a,$b
    }} {p {q {a 1 b 2}}}
} 1,2
test dict-22.22 {dict with: compiled} {
    set ::d {a 1 b 2}
    apply {{} {
	dict with ::d {
	}
	return $a,$b
    }}
} 1,2
test dict-22.23 {dict with: compiled} {
    set ::d {p {q {a 1 b 2}}}
    apply {{} {
	dict with ::d p q {
	}
	return $a,$b
    }}
} 1,2

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl

Changes to tests/env.test.

85
86
87
88
89
90
91

92
93
94
95
96
97
98
99

100
101
102
103
104
105
106
	lrem names ""
    }
    foreach name {
	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
	SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
	__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM

    } {
	lrem names $name
    }
    foreach p $names {
	puts "[mangle $p]=[mangle $env($p)]"
    }
    exit
} printenv]

# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
    global printenvScript tcltest
    catch {exec [interpreter] $printenvScript} out
    if {$out eq "child process exited abnormally"} {
	set out {}







>








>







85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
	lrem names ""
    }
    foreach name {
	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
	SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
	__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
	CommonProgramFiles ProgramFiles
    } {
	lrem names $name
    }
    foreach p $names {
	puts "[mangle $p]=[mangle $env($p)]"
    }
    exit
} printenv]

# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
    global printenvScript tcltest
    catch {exec [interpreter] $printenvScript} out
    if {$out eq "child process exited abnormally"} {
	set out {}
115
116
117
118
119
120
121

122
123
124
125
126
127
128
    # Keep some environment variables that support operation of the tcltest
    # package.
    if {[string toupper $name] ni {
	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH
	SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
	SECURITYSESSIONID LANG WINDIR TERM

    }} {
	unset env($name)
    }
}

# Need to run 'getenv' in known encoding, so save the current one here...
set sysenc [encoding system]







>







117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
    # Keep some environment variables that support operation of the tcltest
    # package.
    if {[string toupper $name] ni {
	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH
	SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
	SECURITYSESSIONID LANG WINDIR TERM
	CommonProgramFiles ProgramFiles
    }} {
	unset env($name)
    }
}

# Need to run 'getenv' in known encoding, so save the current one here...
set sysenc [encoding system]

Changes to tests/io.test.

5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
    set f [open $path(test3) r]
    lappend x [gets $f]
    close $f
    set x
} {zzy abzzy}
test io-40.2 {POSIX open access modes: CREAT} {unix} {
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT} 0600]
    file stat $path(test3) stats
    set x [format "0%o" [expr $stats(mode)&0o777]]
    puts $f "line 1"
    close $f
    set f [open $path(test3) r]
    lappend x [gets $f]
    close $f
    set x
} {0600 {line 1}}
test io-40.3 {POSIX open access modes: CREAT} {unix umask} {
    # This test only works if your umask is 2, like ouster's.
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT}]
    close $f
    file stat $path(test3) stats
    format "0%o" [expr $stats(mode)&0o777]







|

|






|







5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
    set f [open $path(test3) r]
    lappend x [gets $f]
    close $f
    set x
} {zzy abzzy}
test io-40.2 {POSIX open access modes: CREAT} {unix} {
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT} 0o600]
    file stat $path(test3) stats
    set x [format "0o%o" [expr $stats(mode)&0o777]]
    puts $f "line 1"
    close $f
    set f [open $path(test3) r]
    lappend x [gets $f]
    close $f
    set x
} {0o600 {line 1}}
test io-40.3 {POSIX open access modes: CREAT} {unix umask} {
    # This test only works if your umask is 2, like ouster's.
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT}]
    close $f
    file stat $path(test3) stats
    format "0%o" [expr $stats(mode)&0o777]

Changes to win/tclWinFile.c.

1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
 *
 * NativeMatchType --
 *
 *	This function needs a special case for a path which is a root volume,
 *	because for NTFS root volumes, the getFileAttributesProc returns a
 *	'hidden' attribute when it should not.
 *
 *	We never make any calss to a 'get attributes' routine here, since we
 *	have arranged things so that our caller already knows such
 *	information.
 *
 * Results:
 *	0 = file doesn't match
 *	1 = file matches
 *







|







1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
 *
 * NativeMatchType --
 *
 *	This function needs a special case for a path which is a root volume,
 *	because for NTFS root volumes, the getFileAttributesProc returns a
 *	'hidden' attribute when it should not.
 *
 *	We never make any calls to a 'get attributes' routine here, since we
 *	have arranged things so that our caller already knows such
 *	information.
 *
 * Results:
 *	0 = file doesn't match
 *	1 = file matches
 *
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
    }

    /*
     * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and other
     * positions.
     */

    mode |= (mode & 0x0700) >> 3;
    mode |= (mode & 0x0700) >> 6;
    return (unsigned short) mode;
}

/*
 *------------------------------------------------------------------------
 *
 * ToCTime --







|
|







2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
    }

    /*
     * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and other
     * positions.
     */

    mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 3;
    mode |= (mode & (S_IREAD|S_IWRITE|S_IEXEC)) >> 6;
    return (unsigned short) mode;
}

/*
 *------------------------------------------------------------------------
 *
 * ToCTime --