Tcl Source Code

Check-in [d6c4824b30]
Login

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

Overview
Comment:Testing of fixing execution trace, overhead by ensemble commands
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dgp-scan-element
Files: files | file ages | folders
SHA1: d6c4824b301bd77bac7a94d712d2bc99c755e14b
User & Date: sergey.brester 2012-02-14 13:06:28
Context
2012-02-14
14:44
Minor change: clarify code to indicate magical sentinel values. check-in: faff574673 user: dkf tags: dgp-scan-element
13:06
Testing of fixing execution trace, overhead by ensemble commands check-in: d6c4824b30 user: sergey.brester tags: dgp-scan-element
2012-02-10
08:25
Define dependencies in Makefile. check-in: 1c577fcea4 user: dkf tags: dgp-scan-element
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclBasic.c.

3016
3017
3018
3019
3020
3021
3022
3023
3024



3025
3026
3027
3028
3029
3030
3031
    int numChars,
    int objc,
    Tcl_Obj *const objv[])
{
    if (!command) {
	return Tcl_NewListObj(objc, objv);
    }
    if (command == (char *) -1) {
	command = TclGetSrcInfoForCmd(iPtr, &numChars);



    }
    return Tcl_NewStringObj(command, numChars);
}

/*
 *----------------------------------------------------------------------
 *







|

>
>
>







3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
    int numChars,
    int objc,
    Tcl_Obj *const objv[])
{
    if (!command) {
	return Tcl_NewListObj(objc, objv);
    }
    if (command == (char *) -1 || command == (char *) -2) {
	command = TclGetSrcInfoForCmd(iPtr, &numChars);
	if (!command) {
	    return Tcl_NewListObj(objc, objv);
	}
    }
    return Tcl_NewStringObj(command, numChars);
}

/*
 *----------------------------------------------------------------------
 *

Changes to generic/tclExecute.c.

7765
7766
7767
7768
7769
7770
7771



7772




7773




7774
7775
7776













7777
7778
7779
7780
7781
7782
7783
 */

const char *
TclGetSrcInfoForCmd(
    Interp *iPtr,
    int *lenPtr)
{



    CmdFrame *cfPtr = iPtr->cmdFramePtr;




    ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;





    return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
	    codePtr, lenPtr);













}

void
TclGetSrcInfoForPc(
    CmdFrame *cfPtr)
{
    ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;







>
>
>

>
>
>
>
|
>
>
>
>

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







7765
7766
7767
7768
7769
7770
7771
7772
7773
7774
7775
7776
7777
7778
7779
7780
7781
7782
7783
7784
7785
7786
7787
7788
7789
7790
7791
7792
7793
7794
7795
7796
7797
7798
7799
7800
7801
7802
7803
7804
7805
7806
7807
 */

const char *
TclGetSrcInfoForCmd(
    Interp *iPtr,
    int *lenPtr)
{
    int len;
    ByteCode *codePtr;

    CmdFrame *cfPtr = iPtr->cmdFramePtr;
    const char * command;

    if (!cfPtr)
	return NULL;
    codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
    if (!codePtr)
	return NULL;
    if (!cfPtr->data.tebc.pc)
	return NULL;

    command = GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
	    codePtr, &len);

    // [sebres] if ensemble call - shift string ptr to subcommand (string range -> range) :
    if (command && len && (lenPtr && *lenPtr == -2) && codePtr->objArrayPtr) {
	Tcl_Obj * objPtr = codePtr->objArrayPtr[0];
	if (len > objPtr->length) {
	    command += objPtr->length + 1;
	    len -= objPtr->length + 1;
	}
    }

    if (lenPtr != NULL)
	*lenPtr = len;
    return command;
}

void
TclGetSrcInfoForPc(
    CmdFrame *cfPtr)
{
    ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;

Changes to generic/tclNamesp.c.

21
22
23
24
25
26
27

28
29
30
31
32
33
34
 *   [email protected]
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"


/*
 * Thread-local storage used to avoid having a global lock on data that is not
 * limited to a single interpreter.
 */

typedef struct ThreadSpecificData {







>







21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
 *   [email protected]
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclCompile.h"

/*
 * Thread-local storage used to avoid having a global lock on data that is not
 * limited to a single interpreter.
 */

typedef struct ThreadSpecificData {
6225
6226
6227
6228
6229
6230
6231

6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
	tempObjv = (Tcl_Obj **) TclStackAlloc(interp,
		(int) sizeof(Tcl_Obj *) * (objc - 2 + prefixObjc));
	memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
	memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2));

	/*
	 * Hand off to the target command.

	 */

	result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv,
		TCL_EVAL_INVOKE);

	/*
	 * Clean up.
	 */

	TclStackFree(interp, tempObjv);







>


|







6226
6227
6228
6229
6230
6231
6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
6242
6243
	tempObjv = (Tcl_Obj **) TclStackAlloc(interp,
		(int) sizeof(Tcl_Obj *) * (objc - 2 + prefixObjc));
	memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
	memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2));

	/*
	 * Hand off to the target command.
	 * [sebres] call from ensemble -- -2 (to retrive subcommand from main ensemble)
	 */

	result = TclEvalObjvInternal(interp, objc-2+prefixObjc, tempObjv, (char *)-2, -2,
		TCL_EVAL_INVOKE);

	/*
	 * Clean up.
	 */

	TclStackFree(interp, tempObjv);

Changes to generic/tclTest.c.

40
41
42
43
44
45
46




47
48
49
50
51
52
53
 */
#include "tclIO.h"

/*
 * Declare external functions used in Windows tests.
 */





/*
 * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
 * the results of the various deletion callbacks.
 */

static Tcl_DString delString;
static Tcl_Interp *delInterp;







>
>
>
>







40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
 */
#include "tclIO.h"

/*
 * Declare external functions used in Windows tests.
 */

#if (defined( _MSC_VER ))
typedef void * intptr_t;
#endif
 
/*
 * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
 * the results of the various deletion callbacks.
 */

static Tcl_DString delString;
static Tcl_Interp *delInterp;