Tcl Source Code

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

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

Overview
Comment:Use the routines that provide "basic compile" instead of reinventing them.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: d578a3c0069beffcf669ba48dc7c950f6cc218a6
User & Date: dgp 2013-05-28 19:21:22
Context
2013-05-29
14:37
Stop emitting the instructions INST_*_SCALAR_STK*. They are identical to their INST_*_STK* counterp... check-in: 134b3c0bfc user: dgp tags: trunk
2013-05-28
19:21
Use the routines that provide "basic compile" instead of reinventing them. check-in: d578a3c006 user: dgp tags: trunk
14:29
Plug the memory leak. Greater ambitions to improve this routine are proving more difficult than exp... check-in: e4201224a2 user: dgp tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclCompCmds.c.

︙︙
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261

				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *dataTokenPtr;
    int simpleVarName, isScalar, localIndex;
    int isDataLiteral, isDataValid, isDataEven, len;
    int dataVar, iterVar, keyVar, valVar, infoIndex;
    int back, fwd, offsetBack, offsetFwd, savedStackDepth;
    Tcl_Obj *literalObj;
    ForeachInfo *infoPtr;

    if (parsePtr->numWords != 3) {








|








247
248
249
250
251
252
253
254
255
256
257
258
259
260
261

				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *dataTokenPtr;
    int simpleVarName, isScalar, localIndex, code = TCL_OK;
    int isDataLiteral, isDataValid, isDataEven, len;
    int dataVar, iterVar, keyVar, valVar, infoIndex;
    int back, fwd, offsetBack, offsetFwd, savedStackDepth;
    Tcl_Obj *literalObj;
    ForeachInfo *infoPtr;

    if (parsePtr->numWords != 3) {
︙︙
277
278
279
280
281
282
283










284
285
286
287
288
289

290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307

308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356

    if (isDataValid && !isDataEven) {
	PushStringLiteral(envPtr, "list must have an even number of elements");
	PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
	TclEmitInstInt4(INST_RETURN_IMM, 1,			envPtr);
	TclEmitInt4(		0,				envPtr);
	goto done;
    }











    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
	    &localIndex, &simpleVarName, &isScalar, 1);
    if (!isScalar) {
	Tcl_DecrRefCount(literalObj);
	return TCL_ERROR;

    }
    /*
     * Special case: literal empty value argument is just an "ensure array"
     * operation.
     */

    if (isDataEven && len == 0) {
	if (localIndex >= 0) {
	    TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
	    TclEmitInstInt1(INST_JUMP_TRUE1, 7,			envPtr);
	    TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex,	envPtr);
	} else {
	    TclEmitOpcode(  INST_DUP,				envPtr);
	    TclEmitOpcode(  INST_ARRAY_EXISTS_STK,		envPtr);
	    TclEmitInstInt1(INST_JUMP_TRUE1, 5,			envPtr);
	    savedStackDepth = envPtr->currStackDepth;
	    TclEmitOpcode(  INST_ARRAY_MAKE_STK,		envPtr);
	    TclEmitInstInt1(INST_JUMP1, 3,			envPtr);

	    envPtr->currStackDepth = savedStackDepth;
	    TclEmitOpcode(  INST_POP,				envPtr);
	}
	PushStringLiteral(envPtr, "");
	goto done;
    }

    /*
     * Prepare for the internal foreach.
     */

    dataVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
    iterVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
    keyVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
    valVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);

    if (dataVar < 0) {
	/*
	 * Right number of arguments, but not compilable as we can't allocate
	 * (unnamed) local variables to manage the internal iteration.
	 */

	Tcl_Obj *objPtr = Tcl_NewObj();
	char *bytes;
	int length, cmdLit;

	Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
	bytes = Tcl_GetStringFromObj(objPtr, &length);
	cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length);
	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
	TclEmitPush(cmdLit, envPtr);
	TclDecrRefCount(objPtr);
	if (localIndex >= 0) {
	    CompileWord(envPtr, varTokenPtr, interp, 1);
	} else {
	    TclEmitInstInt4(INST_REVERSE, 2,			envPtr);
	}
	CompileWord(envPtr, dataTokenPtr, interp, 2);
	TclEmitInstInt1(INST_INVOKE_STK1, 3,			envPtr);
	goto done;
    }

    infoPtr = ckalloc(sizeof(ForeachInfo) + sizeof(ForeachVarList *));
    infoPtr->numLists = 1;
    infoPtr->firstValueTemp = dataVar;
    infoPtr->loopCtTemp = iterVar;
    infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) * 2*sizeof(int));
    infoPtr->varLists[0]->numVars = 2;
    infoPtr->varLists[0]->varIndexes[0] = keyVar;








>
>
>
>
>
>
>
>
>
>




<
|
>















<


>
|















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








277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297

298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314

315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333


























334
335
336
337
338
339
340

    if (isDataValid && !isDataEven) {
	PushStringLiteral(envPtr, "list must have an even number of elements");
	PushStringLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}");
	TclEmitInstInt4(INST_RETURN_IMM, 1,			envPtr);
	TclEmitInt4(		0,				envPtr);
	goto done;
    }

    /*
     * Except for the special "ensure array" case below, when we're not in
     * a proc, we cannot do a better compile than generic.
     */

    if (envPtr->procPtr == NULL && !(isDataEven && len == 0)) {
	code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
	goto done;
    }

    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
	    &localIndex, &simpleVarName, &isScalar, 1);
    if (!isScalar) {

	code = TCL_ERROR;
	goto done;
    }
    /*
     * Special case: literal empty value argument is just an "ensure array"
     * operation.
     */

    if (isDataEven && len == 0) {
	if (localIndex >= 0) {
	    TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
	    TclEmitInstInt1(INST_JUMP_TRUE1, 7,			envPtr);
	    TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex,	envPtr);
	} else {
	    TclEmitOpcode(  INST_DUP,				envPtr);
	    TclEmitOpcode(  INST_ARRAY_EXISTS_STK,		envPtr);
	    TclEmitInstInt1(INST_JUMP_TRUE1, 5,			envPtr);

	    TclEmitOpcode(  INST_ARRAY_MAKE_STK,		envPtr);
	    TclEmitInstInt1(INST_JUMP1, 3,			envPtr);
	    /* Each branch decrements stack depth, but we only take one. */
	    TclAdjustStackDepth(1, envPtr);
	    TclEmitOpcode(  INST_POP,				envPtr);
	}
	PushStringLiteral(envPtr, "");
	goto done;
    }

    /*
     * Prepare for the internal foreach.
     */

    dataVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
    iterVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
    keyVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);
    valVar = TclFindCompiledLocal(NULL, 0, 1, envPtr);



























    infoPtr = ckalloc(sizeof(ForeachInfo) + sizeof(ForeachVarList *));
    infoPtr->numLists = 1;
    infoPtr->firstValueTemp = dataVar;
    infoPtr->loopCtTemp = iterVar;
    infoPtr->varLists[0] = ckalloc(sizeof(ForeachVarList) * 2*sizeof(int));
    infoPtr->varLists[0]->numVars = 2;
    infoPtr->varLists[0]->varIndexes[0] = keyVar;
︙︙
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

	TclEmitOpcode(	INST_DUP,				envPtr);
	TclEmitOpcode(	INST_ARRAY_MAKE_STK,			envPtr);
	TclEmitInstInt4(INST_FOREACH_START4, infoIndex,		envPtr);
	offsetBack = CurrentOffset(envPtr);
	TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex,		envPtr);
	offsetFwd = CurrentOffset(envPtr);
	TclEmitInstInt1(INST_JUMP_FALSE1, 0,			envPtr);
	savedStackDepth = envPtr->currStackDepth;
	TclEmitOpcode(	INST_DUP,				envPtr);
	Emit14Inst(	INST_LOAD_SCALAR, keyVar,		envPtr);
	Emit14Inst(	INST_LOAD_SCALAR, valVar,		envPtr);
	TclEmitOpcode(	INST_STORE_ARRAY_STK,			envPtr);
	TclEmitOpcode(	INST_POP,				envPtr);
	back = offsetBack - CurrentOffset(envPtr);
	TclEmitInstInt1(INST_JUMP1, back,			envPtr);
	fwd = CurrentOffset(envPtr) - offsetFwd;
	TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
	envPtr->currStackDepth = savedStackDepth;
	TclEmitOpcode(	INST_POP,				envPtr);
    }
    if (!isDataLiteral) {
	TclEmitInstInt1(INST_UNSET_SCALAR, 0,			envPtr);
	TclEmitInt4(		dataVar,			envPtr);
    }
    PushStringLiteral(envPtr,	"");
  done:
    Tcl_DecrRefCount(literalObj);
    return TCL_OK;
}

int
TclCompileArrayUnsetCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */








<









<









|








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

	TclEmitOpcode(	INST_DUP,				envPtr);
	TclEmitOpcode(	INST_ARRAY_MAKE_STK,			envPtr);
	TclEmitInstInt4(INST_FOREACH_START4, infoIndex,		envPtr);
	offsetBack = CurrentOffset(envPtr);
	TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex,		envPtr);
	offsetFwd = CurrentOffset(envPtr);
	TclEmitInstInt1(INST_JUMP_FALSE1, 0,			envPtr);

	TclEmitOpcode(	INST_DUP,				envPtr);
	Emit14Inst(	INST_LOAD_SCALAR, keyVar,		envPtr);
	Emit14Inst(	INST_LOAD_SCALAR, valVar,		envPtr);
	TclEmitOpcode(	INST_STORE_ARRAY_STK,			envPtr);
	TclEmitOpcode(	INST_POP,				envPtr);
	back = offsetBack - CurrentOffset(envPtr);
	TclEmitInstInt1(INST_JUMP1, back,			envPtr);
	fwd = CurrentOffset(envPtr) - offsetFwd;
	TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);

	TclEmitOpcode(	INST_POP,				envPtr);
    }
    if (!isDataLiteral) {
	TclEmitInstInt1(INST_UNSET_SCALAR, 0,			envPtr);
	TclEmitInt4(		dataVar,			envPtr);
    }
    PushStringLiteral(envPtr,	"");
  done:
    Tcl_DecrRefCount(literalObj);
    return code;
}

int
TclCompileArrayUnsetCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
︙︙

This page was generated in about 0.022s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19