Tcl Source Code

Check-in [8338d07129]
Login

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

Overview
Comment:Global replace: CompileBody() -> BODY().
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 8338d07129e181ea7b994a92c3eb5b4e77cc46f6
User & Date: dgp 2013-07-12 18:44:15
Context
2013-07-15
17:07
Prefer CompileWord() over CompileTokens() when possible. check-in: 4790b68c65 user: dgp tags: trunk
2013-07-12
18:44
Global replace: CompileBody() -> BODY(). check-in: 8338d07129 user: dgp tags: trunk
16:25
Tests demonstrating the need for the last two SetLineInformation() calls. check-in: 4b58b335d4 user: dgp tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclCompCmds.c.

606
607
608
609
610
611
612
613
614
615
616
617
618

619
620
621
622
623
624
625
     * Care has to be taken to make sure that substitution happens outside the
     * catch range so that errors in the substitution are not caught.
     * [Bug 219184]
     * 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) {
	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
	ExceptionRangeStarts(envPtr, range);
	CompileBody(envPtr, cmdTokenPtr, interp);
    } else {

	CompileTokens(envPtr, cmdTokenPtr, interp);
	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
	ExceptionRangeStarts(envPtr, range);
	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_EVAL_STK,			envPtr);
    }
    /* Stack at this point:







<



|

>







606
607
608
609
610
611
612

613
614
615
616
617
618
619
620
621
622
623
624
625
     * Care has to be taken to make sure that substitution happens outside the
     * catch range so that errors in the substitution are not caught.
     * [Bug 219184]
     * The reason for duplicating the script is that EVAL_STK would otherwise
     * begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
     */


    if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
	ExceptionRangeStarts(envPtr, range);
	BODY(cmdTokenPtr, 1);
    } else {
	SetLineInformation(1);
	CompileTokens(envPtr, cmdTokenPtr, interp);
	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
	ExceptionRangeStarts(envPtr, range);
	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_EVAL_STK,			envPtr);
    }
    /* Stack at this point:
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
    loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
    ExceptionRangeStarts(envPtr, loopRange);

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

    SetLineInformation(3);
    CompileBody(envPtr, bodyTokenPtr, interp);
    if (collect == TCL_EACH_COLLECT) {
	Emit14Inst(	INST_LOAD_SCALAR, keyVarIndex,		envPtr);
	TclEmitInstInt4(INST_OVER, 1,				envPtr);
	TclEmitInstInt4(INST_DICT_SET, 1,			envPtr);
	TclEmitInt4(		collectVar,			envPtr);
	TclAdjustStackDepth(-1, envPtr);
	TclEmitOpcode(	INST_POP,				envPtr);







<
|







1463
1464
1465
1466
1467
1468
1469

1470
1471
1472
1473
1474
1475
1476
1477
    loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
    ExceptionRangeStarts(envPtr, loopRange);

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


    BODY(bodyTokenPtr, 3);
    if (collect == TCL_EACH_COLLECT) {
	Emit14Inst(	INST_LOAD_SCALAR, keyVarIndex,		envPtr);
	TclEmitInstInt4(INST_OVER, 1,				envPtr);
	TclEmitInstInt4(INST_DICT_SET, 1,			envPtr);
	TclEmitInt4(		collectVar,			envPtr);
	TclAdjustStackDepth(-1, envPtr);
	TclEmitOpcode(	INST_POP,				envPtr);
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
    TclEmitInstInt4(	INST_DICT_UPDATE_START, dictIndex,	envPtr);
    TclEmitInt4(		infoIndex,			envPtr);

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

    ExceptionRangeStarts(envPtr, range);
    SetLineInformation(parsePtr->numWords - 1);
    CompileBody(envPtr, bodyTokenPtr, interp);
    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.
     */








|
<







1646
1647
1648
1649
1650
1651
1652
1653

1654
1655
1656
1657
1658
1659
1660
    TclEmitInstInt4(	INST_DICT_UPDATE_START, dictIndex,	envPtr);
    TclEmitInt4(		infoIndex,			envPtr);

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

    ExceptionRangeStarts(envPtr, range);
    BODY(bodyTokenPtr, parsePtr->numWords - 1);

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

1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
     * Now the body of the [dict with].
     */

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

    ExceptionRangeStarts(envPtr, range);
    SetLineInformation(parsePtr->numWords-1);
    CompileBody(envPtr, tokenPtr, interp);
    ExceptionRangeEnds(envPtr, range);

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

    TclEmitOpcode(		INST_END_CATCH,			envPtr);







|
<







1986
1987
1988
1989
1990
1991
1992
1993

1994
1995
1996
1997
1998
1999
2000
     * Now the body of the [dict with].
     */

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

    ExceptionRangeStarts(envPtr, range);
    BODY(tokenPtr, parsePtr->numWords - 1);

    ExceptionRangeEnds(envPtr, range);

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

    TclEmitOpcode(		INST_END_CATCH,			envPtr);
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
	return TCL_ERROR;
    }

    /*
     * Inline compile the initial command.
     */

    SetLineInformation(1);
    CompileBody(envPtr, startTokenPtr, interp);
    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Jump to the evaluation of the condition. This code uses the "loop
     * rotation" optimisation (which eliminates one branch from the loop).
     * "for start cond next body" produces then:
     *       start







<
|







2261
2262
2263
2264
2265
2266
2267

2268
2269
2270
2271
2272
2273
2274
2275
	return TCL_ERROR;
    }

    /*
     * Inline compile the initial command.
     */


    BODY(startTokenPtr, 1);
    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Jump to the evaluation of the condition. This code uses the "loop
     * rotation" optimisation (which eliminates one branch from the loop).
     * "for start cond next body" produces then:
     *       start
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

    /*
     * Compile the loop body.
     */

    bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
    bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange);
    SetLineInformation(4);
    CompileBody(envPtr, bodyTokenPtr, interp);
    ExceptionRangeEnds(envPtr, bodyRange);
    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Compile the "next" subcommand. Note that this exception range will not
     * have a continueOffset (other than -1) connected to it; it won't trap
     * TCL_CONTINUE but rather just TCL_BREAK.
     */

    nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
    envPtr->exceptAuxArrayPtr[nextRange].supportsContinue = 0;
    nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
    SetLineInformation(3);
    CompileBody(envPtr, nextTokenPtr, interp);
    ExceptionRangeEnds(envPtr, nextRange);
    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Compile the test expression then emit the conditional jump that
     * terminates the for.
     */







<
|












<
|







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

    /*
     * Compile the loop body.
     */

    bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
    bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange);

    BODY(bodyTokenPtr, 4);
    ExceptionRangeEnds(envPtr, bodyRange);
    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Compile the "next" subcommand. Note that this exception range will not
     * have a continueOffset (other than -1) connected to it; it won't trap
     * TCL_CONTINUE but rather just TCL_BREAK.
     */

    nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
    envPtr->exceptAuxArrayPtr[nextRange].supportsContinue = 0;
    nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);

    BODY(nextTokenPtr, 3);
    ExceptionRangeEnds(envPtr, nextRange);
    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Compile the test expression then emit the conditional jump that
     * terminates the for.
     */
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
    TclEmitInstInt4(		INST_FOREACH_STEP4, infoIndex,	envPtr);
    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);

    /*
     * Inline compile the loop body.
     */

    SetLineInformation(numWords - 1);
    ExceptionRangeStarts(envPtr, range);
    CompileBody(envPtr, bodyTokenPtr, interp);
    ExceptionRangeEnds(envPtr, range);

    if (collect == TCL_EACH_COLLECT) {
	Emit14Inst(		INST_LAPPEND_SCALAR, collectVar,envPtr);
    }
    TclEmitOpcode(		INST_POP,			envPtr);








<

|







2672
2673
2674
2675
2676
2677
2678

2679
2680
2681
2682
2683
2684
2685
2686
2687
    TclEmitInstInt4(		INST_FOREACH_STEP4, infoIndex,	envPtr);
    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);

    /*
     * Inline compile the loop body.
     */


    ExceptionRangeStarts(envPtr, range);
    BODY(bodyTokenPtr, numWords - 1);
    ExceptionRangeEnds(envPtr, range);

    if (collect == TCL_EACH_COLLECT) {
	Emit14Inst(		INST_LAPPEND_SCALAR, collectVar,envPtr);
    }
    TclEmitOpcode(		INST_POP,			envPtr);

Changes to generic/tclCompCmdsGR.c.

260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
	}

	/*
	 * Compile the "then" command body.
	 */

	if (compileScripts) {
	    SetLineInformation(wordIdx);
	    CompileBody(envPtr, tokenPtr, interp);
	}

	if (realCond) {
	    /*
	     * Jump to the end of the "if" command. Both jumpFalseFixupArray
	     * and jumpEndFixupArray are indexed by "jumpIndex".
	     */







|
<







260
261
262
263
264
265
266
267

268
269
270
271
272
273
274
	}

	/*
	 * Compile the "then" command body.
	 */

	if (compileScripts) {
	    BODY(tokenPtr, wordIdx);

	}

	if (realCond) {
	    /*
	     * Jump to the end of the "if" command. Both jumpFalseFixupArray
	     * and jumpEndFixupArray are indexed by "jumpIndex".
	     */
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
	}

	if (compileScripts) {
	    /*
	     * Compile the else command body.
	     */

	    SetLineInformation(wordIdx);
	    CompileBody(envPtr, tokenPtr, interp);
	}

	/*
	 * Make sure there are no words after the else clause.
	 */

	wordIdx++;







|
<







340
341
342
343
344
345
346
347

348
349
350
351
352
353
354
	}

	if (compileScripts) {
	    /*
	     * Compile the else command body.
	     */

	    BODY(tokenPtr, wordIdx);

	}

	/*
	 * Make sure there are no words after the else clause.
	 */

	wordIdx++;

Changes to generic/tclCompCmdsSZ.c.

81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
#define OP(name)	TclEmitOpcode(INST_##name, envPtr)
#define OP1(name,val)	TclEmitInstInt1(INST_##name,(val),envPtr)
#define OP4(name,val)	TclEmitInstInt4(INST_##name,(val),envPtr)
#define OP14(name,val1,val2) \
    TclEmitInstInt1(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
#define OP44(name,val1,val2) \
    TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
#define BODY(token,index) \
    SetLineInformation((index));CompileBody(envPtr,(token),interp)
#define PUSH(str) \
    PushStringLiteral(envPtr, str)
#define JUMP4(name,var) \
    (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name##4,0,envPtr)
#define FIXJUMP4(var) \
    TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
#define JUMP1(name,var) \







<
<







81
82
83
84
85
86
87


88
89
90
91
92
93
94
#define OP(name)	TclEmitOpcode(INST_##name, envPtr)
#define OP1(name,val)	TclEmitInstInt1(INST_##name,(val),envPtr)
#define OP4(name,val)	TclEmitInstInt4(INST_##name,(val),envPtr)
#define OP14(name,val1,val2) \
    TclEmitInstInt1(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
#define OP44(name,val1,val2) \
    TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)


#define PUSH(str) \
    PushStringLiteral(envPtr, str)
#define JUMP4(name,var) \
    (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name##4,0,envPtr)
#define FIXJUMP4(var) \
    TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
#define JUMP1(name,var) \
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
	    for (j=0 ; j<contFixCount ; j++) {
		fixupTargetArray[contFixIndex+j] = CurrentOffset(envPtr);
	    }
	    contFixIndex = -1;
	}

	/*
	 * Now do the actual compilation. Note that we do not use CompileBody
	 * because we may have synthesized the tokens in a non-standard
	 * pattern.
	 */

	OP(	POP);
	envPtr->line = bodyLines[i+1];		/* TIP #280 */
	envPtr->clNext = bodyContLines[i+1];	/* TIP #280 */







|







1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
	    for (j=0 ; j<contFixCount ; j++) {
		fixupTargetArray[contFixIndex+j] = CurrentOffset(envPtr);
	    }
	    contFixIndex = -1;
	}

	/*
	 * Now do the actual compilation. Note that we do not use BODY() 
	 * because we may have synthesized the tokens in a non-standard
	 * pattern.
	 */

	OP(	POP);
	envPtr->line = bodyLines[i+1];		/* TIP #280 */
	envPtr->clNext = bodyContLines[i+1];	/* TIP #280 */

Changes to generic/tclCompile.h.

1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417

1418
1419
1420
1421
1422
1423
1424
1425
1426
 * int TclMax(int i, int j);
 */

#define TclMin(i, j)	((((int) i) < ((int) j))? (i) : (j))
#define TclMax(i, j)	((((int) i) > ((int) j))? (i) : (j))

/*
 * Convenience macro for use when compiling bodies of commands. The ANSI C
 * "prototype" for this macro is:
 *
 * static void		CompileBody(CompileEnv *envPtr, Tcl_Token *tokenPtr,
 *			    Tcl_Interp *interp);
 */

#define CompileBody(envPtr, tokenPtr, interp) \

    TclCompileCmdWord((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
	    (envPtr))

/*
 * Convenience macro for use when compiling tokens to be pushed. The ANSI C
 * "prototype" for this macro is:
 *
 * static void		CompileTokens(CompileEnv *envPtr, Tcl_Token *tokenPtr,
 *			    Tcl_Interp *interp);







|
|

|
<


|
>
|
|







1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413

1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
 * int TclMax(int i, int j);
 */

#define TclMin(i, j)	((((int) i) < ((int) j))? (i) : (j))
#define TclMax(i, j)	((((int) i) > ((int) j))? (i) : (j))

/*
 * Convenience macros for use when compiling bodies of commands. The ANSI C
 * "prototype" for these macros are:
 *
 * static void		BODY(Tcl_Token *tokenPtr, int word);

 */

#define BODY(tokenPtr, word)						\
    SetLineInformation((word));						\
    TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents,	\
	    envPtr)

/*
 * Convenience macro for use when compiling tokens to be pushed. The ANSI C
 * "prototype" for this macro is:
 *
 * static void		CompileTokens(CompileEnv *envPtr, Tcl_Token *tokenPtr,
 *			    Tcl_Interp *interp);