Tcl Source Code

Check-in [cda4203920]
Login

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

Overview
Comment:clarify and review code
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dgp-scan-element
Files: files | file ages | folders
SHA1: cda4203920b825aef80c380641573197cf68dc74
User & Date: sebres 2012-03-01 09:29:27
Context
2012-03-05
19:11
Backdoor kludge to let traced ensemble subcommands gain access to the string command of the original... check-in: a96d145418 user: dgp tags: bug-3485833
2012-03-01
09:33
fix compile error win / visual studio check-in: 57f30e3f2c user: sebres tags: dgp-scan-element
09:29
clarify and review code check-in: cda4203920 user: sebres tags: dgp-scan-element
2012-02-14
14:44
Minor change: clarify code to indicate magical sentinel values. check-in: faff574673 user: dkf tags: dgp-scan-element
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclBasic.c.

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
 *----------------------------------------------------------------------
 *
 * GetCommandSource --
 *
 *	This function returns a Tcl_Obj with the full source string for the
 *	command. This insures that traces get a correct NUL-terminated command
 *	string.



 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
GetCommandSource(
    Interp *iPtr,
    const char *command,
    int numChars,
    int objc,
    Tcl_Obj *const objv[])
{
    if (!command) {
	return Tcl_NewListObj(objc, objv);
    }
    if (command == (char *) -1 || command == ENSEMBLE_PSEUDO_COMMAND) {
	command = TclGetSrcInfoForCmd(iPtr, &numChars);
	if (!command) {
	    return Tcl_NewListObj(objc, objv);
	}
    }
    return Tcl_NewStringObj(command, numChars);
}







>
>
>















|







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
 *----------------------------------------------------------------------
 *
 * GetCommandSource --
 *
 *	This function returns a Tcl_Obj with the full source string for the
 *	command. This insures that traces get a correct NUL-terminated command
 *	string.
 *	If parameter 'command' is (char*)-1 it returns a pointer to the command's 
 *	source using TclGetSrcInfoForCmd. As parameter 'numChars' could be used 
 *	an ENSEMBLE_PSEUDO_COMMAND to advise call of the ensemble command.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
GetCommandSource(
    Interp *iPtr,
    const char *command,
    int numChars,
    int objc,
    Tcl_Obj *const objv[])
{
    if (!command) {
	return Tcl_NewListObj(objc, objv);
    }
    if (command == (char *) -1) {
	command = TclGetSrcInfoForCmd(iPtr, &numChars);
	if (!command) {
	    return Tcl_NewListObj(objc, objv);
	}
    }
    return Tcl_NewStringObj(command, numChars);
}
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
				 * the words that make up the command. */
    const char *command,	/* Points to the beginning of the string
				 * representation of the command; this is used
				 * for traces. NULL if the string
				 * representation of the command is unknown is
				 * to be generated from (objc,objv), -1 if it
				 * is to be generated from bytecode source,
				 * ENSEMBLE_PSEUDO_COMMAND if it is to be
				 * determined from the ensemble context. This
				 * is only needed the traces. */
    int length,			/* Number of bytes in command; if -1, all
				 * characters up to the first null byte are
				 * used. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
				 * currently supported. */







|
|
|







3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
				 * the words that make up the command. */
    const char *command,	/* Points to the beginning of the string
				 * representation of the command; this is used
				 * for traces. NULL if the string
				 * representation of the command is unknown is
				 * to be generated from (objc,objv), -1 if it
				 * is to be generated from bytecode source,
				 * with length ENSEMBLE_PSEUDO_COMMAND it is 
				 * to be determined from the ensemble context. 
				 * This is only needed the traces. */
    int length,			/* Number of bytes in command; if -1, all
				 * characters up to the first null byte are
				 * used. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
				 * currently supported. */

Changes to generic/tclCompile.h.

841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
    union {
	int numArgs;
	int identity;
    } i;
} TclOpCmdClientData;

/*
 * Special sentinel value for TclEvalObjvInternal's 'command' parameter to
 * cause it to retrieve command information for an ensemble from the
 * containing command.
 */

#define ENSEMBLE_PSEUDO_COMMAND ((char *)(-2))

/*
 *----------------------------------------------------------------
 * Procedures exported by tclBasic.c to be used within the engine.
 *----------------------------------------------------------------
 */








|

|


|







841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
    union {
	int numArgs;
	int identity;
    } i;
} TclOpCmdClientData;

/*
 * Special sentinel value for TclEvalObjvInternal's 'length' parameter to
 * cause it to retrieve command information for an ensemble from the
 * containing command (parameter 'command' is (char *)-1).
 */

#define ENSEMBLE_PSEUDO_COMMAND -2

/*
 *----------------------------------------------------------------
 * Procedures exported by tclBasic.c to be used within the engine.
 *----------------------------------------------------------------
 */

Changes to generic/tclExecute.c.

7753
7754
7755
7756
7757
7758
7759


7760
7761
7762
7763
7764
7765
7766
 * Results:
 *	If a command is found that encloses the program counter value, a
 *	pointer to the command's source is returned and the length of the
 *	source is stored at *lengthPtr. If multiple commands resulted in code
 *	at pc, information about the closest enclosing command is returned. If
 *	no matching command is found, NULL is returned and *lengthPtr is
 *	unchanged.


 *
 * Side effects:
 *	The CmdFrame at *cfPtr is updated.
 *
 *----------------------------------------------------------------------
 */








>
>







7753
7754
7755
7756
7757
7758
7759
7760
7761
7762
7763
7764
7765
7766
7767
7768
 * Results:
 *	If a command is found that encloses the program counter value, a
 *	pointer to the command's source is returned and the length of the
 *	source is stored at *lengthPtr. If multiple commands resulted in code
 *	at pc, information about the closest enclosing command is returned. If
 *	no matching command is found, NULL is returned and *lengthPtr is
 *	unchanged.
 *	As input parameter '*lengthPtr' could be used an ENSEMBLE_PSEUDO_COMMAND 
 *	to advise call of the ensemble command.
 *
 * Side effects:
 *	The CmdFrame at *cfPtr is updated.
 *
 *----------------------------------------------------------------------
 */

7782
7783
7784
7785
7786
7787
7788
7789
7790
7791
7792
7793
7794
7795
7796
7797
7798
7799
7800
    if (!cfPtr->data.tebc.pc)
	return NULL;

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

    /*
     * [sebres]: If ensemble call (sentinel length == -2), 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;
	}
    }







|
|


|







7784
7785
7786
7787
7788
7789
7790
7791
7792
7793
7794
7795
7796
7797
7798
7799
7800
7801
7802
    if (!cfPtr->data.tebc.pc)
	return NULL;

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

    /*
     * [sebres]: If ensemble call (sentinel length == ENSEMBLE_PSEUDO_COMMAND), 
     * shift string ptr to subcommand (string range -> range).
     */

    if (command && len && (lenPtr && *lenPtr == ENSEMBLE_PSEUDO_COMMAND) && codePtr->objArrayPtr) {
	Tcl_Obj *objPtr = codePtr->objArrayPtr[0];

	if (len > objPtr->length) {
	    command += objPtr->length + 1;
	    len -= objPtr->length + 1;
	}
    }

Changes to generic/tclNamesp.c.

6231
6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
6242
6243
6244
6245
6246
	/*
	 * Hand off to the target command.
	 * [sebres] call from ensemble using ENSEMBLE_PSEUDO_COMMAND to
	 * retrive subcommand from main ensemble.
	 */

	result = TclEvalObjvInternal(interp, objc-2+prefixObjc, tempObjv,
		ENSEMBLE_PSEUDO_COMMAND, -2 /*TclGetSrcInfoForCmd sentinel*/,
		TCL_EVAL_INVOKE);

	/*
	 * Clean up.
	 */

	TclStackFree(interp, tempObjv);
	Tcl_DecrRefCount(copyObj);







|
|







6231
6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
6242
6243
6244
6245
6246
	/*
	 * Hand off to the target command.
	 * [sebres] call from ensemble using ENSEMBLE_PSEUDO_COMMAND to
	 * retrive subcommand from main ensemble.
	 */

	result = TclEvalObjvInternal(interp, objc-2+prefixObjc, tempObjv,
		/* call from TEBC, TclGetSrcInfoForCmd sentinel */(char *) -1, 
		ENSEMBLE_PSEUDO_COMMAND, TCL_EVAL_INVOKE);

	/*
	 * Clean up.
	 */

	TclStackFree(interp, tempObjv);
	Tcl_DecrRefCount(copyObj);