Tcl Source Code

Check-in [bd1fb54305]
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki

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

Overview
Comment:And the last bits that need fixing; the code is still less efficient than desired but should now not crash.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | dkf-loop-exception-range-work
Files: files | file ages | folders
SHA1: bd1fb54305b2f19c408ca2bd7224a0dd5c0dfe1f
User & Date: dkf 2013-10-20 18:11:35.289
Context
2013-10-20
18:15
[2835313] Ensure correct stack balance when break and continue exceptions are about: the hard cases ... check-in: 582877d8ab user: dkf tags: trunk
18:11
And the last bits that need fixing; the code is still less efficient than desired but should now not... Closed-Leaf check-in: bd1fb54305 user: dkf tags: dkf-loop-exception-range-work
2013-10-19
14:11
Fix handling of 'invokeExpanded' and start to do 'returnStk'. check-in: 7e41c534a9 user: dkf tags: dkf-loop-exception-range-work
Changes
Side-by-Side Diff Ignore Whitespace Patch
Changes to generic/tclAssembly.c.
︙
242
243
244
245
246
247
248


249
250
251
252
253
254
255

242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257








+
+








			    int count);
static void		BBEmitInstInt1(AssemblyEnv* assemEnvPtr, int tblIdx,
			    int opnd, int count);
static void		BBEmitInstInt4(AssemblyEnv* assemEnvPtr, int tblIdx,
			    int opnd, int count);
static void		BBEmitInst1or4(AssemblyEnv* assemEnvPtr, int tblIdx,
			    int param, int count);
static void		BBEmitInvoke1or4(AssemblyEnv* assemEnvPtr, int tblIdx,
			    int param, int count);
static void		BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblIdx,
			    int count);
static int		BuildExceptionRanges(AssemblyEnv* assemEnvPtr);
static int		CalculateJumpRelocations(AssemblyEnv*, int*);
static int		CheckForUnclosedCatches(AssemblyEnv*);
static int		CheckForThrowInWrongContext(AssemblyEnv*);
static int		CheckNonThrowingBlock(AssemblyEnv*, BasicBlock*);
︙
675
676
677
678
679
680
681
682

683
684
685




686
687
688
689
690
691
692

677
678
679
680
681
682
683

684
685
686

687
688
689
690
691
692
693
694
695
696
697








-
+


-
+
+
+
+








    BBEmitOpcode(assemEnvPtr, tblIdx, count);
    TclEmitInt4(opnd, assemEnvPtr->envPtr);
}

/*
 *-----------------------------------------------------------------------------
 *
 * BBEmitInst1or4 --
 * BBEmitInst1or4, BBEmitInvoke1or4 --
 *
 *	Emits a 1- or 4-byte operation according to the magnitude of the
 *	operand
 *	operand. The Invoke variant generates wrapping stack-balance
 *	management if necessary (which is not normally required in assembled
 *	code, as loop exception ranges, expansions, breaks and continues can't
 *	be issued currently).
 *
 *-----------------------------------------------------------------------------
 */

static void
BBEmitInst1or4(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
︙
707
708
709
710
711
712
713























714
715
716
717
718
719
720

712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








    }
    TclEmitInt1(op, envPtr);
    if (param <= 0xff) {
	TclEmitInt1(param, envPtr);
    } else {
	TclEmitInt4(param, envPtr);
    }
    TclUpdateAtCmdStart(op, envPtr);
    BBUpdateStackReqs(bbPtr, tblIdx, count);
}

static void
BBEmitInvoke1or4(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    int tblIdx,			/* Index in TalInstructionTable of op */
    int param,			/* Variable-length parameter */
    int count)			/* Arity if variadic */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    BasicBlock* bbPtr = assemEnvPtr->curr_bb;
				/* Current basic block */
    int op = TalInstructionTable[tblIdx].tclInstCode;

    if (param <= 0xff) {
	op >>= 8;
    } else {
	op &= 0xff;
    }
    TclEmitInvoke(envPtr, op, param);
    TclUpdateAtCmdStart(op, envPtr);
    BBUpdateStackReqs(bbPtr, tblIdx, count);
}

/*
 *-----------------------------------------------------------------------------
 *
︙
1446
1447
1448
1449
1450
1451
1452
1453
1454

1455
1456
1457
1458
1459
1460
1461

1474
1475
1476
1477
1478
1479
1480


1481
1482
1483
1484
1485
1486
1487
1488








-
-
+








	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}

	// FIXME - use TclEmitInvoke
	BBEmitInst1or4(assemEnvPtr, tblIdx, opnd, opnd);
	BBEmitInvoke1or4(assemEnvPtr, tblIdx, opnd, opnd);
	break;

    case ASSEM_JUMP:
    case ASSEM_JUMP4:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "label");
	    goto cleanup;
︙
Changes to generic/tclCompCmds.c.
︙
1671
1672
1673
1674
1675
1676
1677
1678

1679
1680
1681
1682
1683
1684
1685

1671
1672
1673
1674
1675
1676
1677

1678
1679
1680
1681
1682
1683
1684
1685








-
+








    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);
    TclEmitInvoke(envPtr,INST_RETURN_STK);

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }
    TclStackFree(interp, keyTokenPtrs);
    return TCL_OK;
︙
2029
2030
2031
2032
2033
2034
2035
2036

2037
2038
2039
2040
2041
2042
2043

2029
2030
2031
2032
2033
2034
2035

2036
2037
2038
2039
2040
2041
2042
2043








-
+








    }
    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);
    TclEmitInvoke(envPtr,	INST_RETURN_STK);

    /*
     * Prepare for the start of the next command.
     */

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
︙
Changes to generic/tclCompCmdsGR.c.
︙
2377
2378
2379
2380
2381
2382
2383




2384
2385
2386
2387
2388
2389
2390
2391

2392
2393
2394
2395
2396
2397
2398

2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394

2395
2396
2397
2398
2399
2400
2401
2402








+
+
+
+







-
+









    objv = TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *));

    /*
     * Scan through the return options. If any are unknown at compile time,
     * there is no value in bytecompiling. Save the option values known in an
     * objv array for merging into a return options dictionary.
     *
     * TODO: There is potential for improvement if all option keys are known
     * at compile time and all option values relating to '-code' and '-level'
     * are known at compile time.
     */

    for (objc = 0; objc < numOptionWords; objc++) {
	objv[objc] = Tcl_NewObj();
	Tcl_IncrRefCount(objv[objc]);
	if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
	    /*
	     * Non-literal, so punt to run-time.
	     * Non-literal, so punt to run-time assembly of the dictionary.
	     */

	    for (; objc>=0 ; objc--) {
		TclDecrRefCount(objv[objc]);
	    }
	    TclStackFree(interp, objv);
	    goto issueRuntimeReturn;
︙
Changes to generic/tclCompCmdsSZ.c.
︙
95
96
97
98
99
100
101


102
103
104
105
106
107
108

95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110








+
+








    (var) = CurrentOffset(envPtr);TclEmitInstInt1(INST_##name##1,0,envPtr)
#define FIXJUMP1(var) \
    TclStoreInt1AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
#define LOAD(idx) \
    if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
#define STORE(idx) \
    if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
#define INVOKE(name) \
    TclEmitInvoke(envPtr,INST_##name)

/*
 *----------------------------------------------------------------------
 *
 * TclCompileSetCmd --
 *
 *	Procedure called to compile the "set" command.
︙
869
870
871
872
873
874
875
876

877
878
879
880
881
882
883

871
872
873
874
875
876
877

878
879
880
881
882
883
884
885








-
+








	ExceptionRangeTarget(envPtr, catchRange, catchOffset);
	OP(	PUSH_RETURN_OPTIONS);
	OP(	PUSH_RESULT);
	OP(	PUSH_RETURN_CODE);
	OP(	END_CATCH);
	OP(	RETURN_CODE_BRANCH);

	/* ERROR -> reraise it */
	/* ERROR -> reraise it; NB: can't require BREAK/CONTINUE handling */
	OP(	RETURN_STK);
	OP(	NOP);

	/* RETURN */
	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &returnFixup);

	/* BREAK */
︙
2392
2393
2394
2395
2396
2397
2398
2399

2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418

2419
2420
2421
2422
2423
2424
2425

2394
2395
2396
2397
2398
2399
2400

2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419

2420
2421
2422
2423
2424
2425
2426
2427








-
+


















-
+








	    OP(				POP);
	    PUSH(			"-during");
	    OP4(			REVERSE, 2);
	    OP44(			DICT_SET, 1, optionsVar);
	    TclAdjustStackDepth(-1, envPtr);
	    FIXJUMP1(		dontChangeOptions);
	    OP4(			REVERSE, 2);
	    OP(				RETURN_STK);
	    INVOKE(			RETURN_STK);
	}

	JUMP4(				JUMP, addrsToFix[i]);
	if (matchClauses[i]) {
	    FIXJUMP4(	notECJumpSource);
	}
	FIXJUMP4(	notCodeJumpSource);
    }

    /*
     * Drop the result code since it didn't match any clause, and reissue the
     * exception. Note also that INST_RETURN_STK can proceed to the next
     * instruction.
     */

    OP(					POP);
    LOAD(				optionsVar);
    LOAD(				resultVar);
    OP(					RETURN_STK);
    INVOKE(				RETURN_STK);

    /*
     * Fix all the jumps from taken clauses to here (which is the end of the
     * [try]).
     */

    if (!trapZero) {
︙
2720
2721
2722
2723
2724
2725
2726
2727

2728
2729
2730
2731
2732
2733
2734

2722
2723
2724
2725
2726
2727
2728

2729
2730
2731
2732
2733
2734
2735
2736








-
+








    OP(					POP);
    FIXJUMP1(			finalError);
    STORE(				resultVar);
    OP(					POP);
    FIXJUMP1(			finalOK);
    LOAD(				optionsVar);
    LOAD(				resultVar);
    OP(					RETURN_STK);
    INVOKE(				RETURN_STK);

    return TCL_OK;
}

static int
IssueTryFinallyInstructions(
    Tcl_Interp *interp,
︙
2779
2780
2781
2782
2783
2784
2785
2786

2787
2788
2789
2790
2791
2792
2793

2781
2782
2783
2784
2785
2786
2787

2788
2789
2790
2791
2792
2793
2794
2795








-
+








    FIXJUMP1(		jumpSplice);
    OP4(				REVERSE, 4);
    OP(					POP);
    OP(					POP);
    OP1(				JUMP1, 7);
    FIXJUMP1(		jumpOK);
    OP4(				REVERSE, 2);
    OP(					RETURN_STK);
    INVOKE(				RETURN_STK);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileUnsetCmd --
︙
This page was generated in about 0.043s by Fossil 2.26 [1205ec86cb] 2025-04-30 16:57:32