path: root/systems/mac/support/alpha/tcl/extensions/trace.diff

diff -C 3 -r -X traceignore.txt tcl8.2/generic/tcl.decls tcl8.2orig/generic/tcl.decls
*** tcl8.2/generic/tcl.decls	Sat Sep 18 19:52:50 1999
--- tcl8.2orig/generic/tcl.decls	Wed Aug 18 20:59:08 1999
***************
*** 1343,1353 ****
  declare 389 generic {
      int Tcl_GetChannelNamesEx(Tcl_Interp *interp, char *pattern)
  }
! declare 390 generic {
!     Tcl_Trace Tcl_CreateTraceObj(Tcl_Interp* interp, Tcl_Obj* insideCmd, \
! 	    int traceFlags, int maxLevel, int minLevel, \
! 	    Tcl_CmdTraceObjProc *proc, ClientData clientData)
! }
  
  
  ##############################################################################
--- 1343,1349 ----
  declare 389 generic {
      int Tcl_GetChannelNamesEx(Tcl_Interp *interp, char *pattern)
  }
! 
  
  
  ##############################################################################
diff -C 3 -r -X traceignore.txt tcl8.2/generic/tcl.h tcl8.2orig/generic/tcl.h
*** tcl8.2/generic/tcl.h	Tue Sep 21 09:03:50 1999
--- tcl8.2orig/generic/tcl.h	Tue Aug 10 17:16:25 1999
***************
*** 503,512 ****
  typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData,
  	Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc,
  	ClientData cmdClientData, int argc, char *argv[]));
- typedef void (Tcl_CmdTraceObjProc) _ANSI_ARGS_((ClientData clientData,
- 	Tcl_Interp *interp, int level, int startLevel, int flags, int code,
- 	char* command, int length, Tcl_Command currentCmd, 
- 	int objc, struct Tcl_Obj *CONST objv[]));
  typedef void (Tcl_DupInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *srcPtr, 
          struct Tcl_Obj *dupPtr));
  typedef int (Tcl_EncodingConvertProc)_ANSI_ARGS_((ClientData clientData,
--- 503,508 ----
***************
*** 867,878 ****
  #define TCL_INTERP_DESTROYED	 0x100
  #define TCL_LEAVE_ERR_MSG	 0x200
  #define TCL_TRACE_ARRAY		 0x800
- 
- /*
-  * Flag values passed to Tcl_CreateTraceObj
-  */
- #define TCL_CMD_TRACE_BEFORE	1
- #define TCL_CMD_TRACE_AFTER	2
  
  /*
   * The TCL_PARSE_PART1 flag is deprecated and has no effect. 
--- 863,868 ----
diff -C 3 -r -X traceignore.txt tcl8.2/generic/tclBasic.c tcl8.2orig/generic/tclBasic.c
*** tcl8.2/generic/tclBasic.c	Tue Sep 21 12:28:02 1999
--- tcl8.2orig/generic/tclBasic.c	Fri May 14 17:16:54 1999
***************
*** 3837,3964 ****
      tracePtr = (Trace *) ckalloc(sizeof(Trace));
      tracePtr->level = level;
      tracePtr->proc = proc;
-     tracePtr->traceFlags = 0;
      tracePtr->clientData = clientData;
-     tracePtr->nextPtr = iPtr->tracePtr;
-     iPtr->tracePtr = tracePtr;
- 
-     return (Tcl_Trace) tracePtr;
- }
- 
- /*
-  *----------------------------------------------------------------------
-  *
-  * Tcl_CreateTraceObj --
-  *
-  *	Arrange for a procedure to be called to trace command execution.
-  *
-  * Results:
-  *	The return value is a token for the trace, which may be passed
-  *	to Tcl_DeleteTrace to eliminate the trace.
-  *
-  * Side effects:
-  *	From now on, proc will be called just before a command procedure
-  *	is called to execute a Tcl command, provided certain conditions
-  *	are met.  These conditions may include: current execution
-  *	level is at least 'minLevel'; current execution level is at
-  *	most 'maxLevel'; execution is currently inside the command/proc
-  *	'insideCmd'.  For any given occasion on which those conditions
-  *	are met, there are two times at which this procedure may
-  *	be called: before the command is executed, and after the
-  *	command is executed.  Depending on the value to 'traceFlags'
-  *	the procedure will be called in one or both of those situations.
-  *	
-  *	Calls to proc will have the following form:
-  *
-  *	void
-  *	proc(clientData, interp, level, startLevel, flags, code,
-  *	        command, length, currentCmd, objc, objv)
-  *	    ClientData clientData;
-  *	    Tcl_Interp *interp;
-  *	    int level;
-  *	    int startLevel;
-  *	    int flags;
-  *	    int code;
-  *	    char *command;
-  *	    int length;
-  *	    Tcl_Command currentCmd;
-  *	    int objc;
-  *	    struct Tcl_Obj *CONST objv[];
-  *	{
-  *	}
-  *
-  *	The clientData, interp and flags arguments to proc will be the
-  *	same as the corresponding arguments to this procedure.  Level
-  *	gives the nesting level of command interpretation for this
-  *	interpreter (0 corresponds to top level).  StartLevel gives the
-  *	level at which the first command trace was triggered (so
-  *	Level-StartLevel gives a relative level).  The first 'length'
-  *	characters of Command gives the ASCII text of the raw command,
-  *	and currentCmd is the Tcl_Command structure referring to the
-  *	current command.  will receive, and objc and objv give the
-  *	arguments to the command, after any argument parsing and
-  *	substitution.  Proc does not return a value.
-  *
-  *----------------------------------------------------------------------
-  */
- 
- Tcl_Trace
- Tcl_CreateTraceObj(interp, insideCmd, traceFlags, maxLevel, minLevel, 
- 		   proc, clientData)
-     Tcl_Interp *interp;		/* Interpreter in which to create trace. */
-     Tcl_Obj* insideCmd;		/* Only activate this trace when execution
-                  		 * is inside a call to this command, and
-                  		 * after it is inside, later deactivate the 
-                  		 * trace when execution of this command is
-                  		 * complete. */
-     int traceFlags;		/* Or'd combination of TCL_CMD_TRACE_ flags,
-     				 * to indicate whether to call the given
-     				 * procedure before command execution,
-     				 * or after command execution (with the
-     				 * result of the command execution). If
-     				 * zero, then equivalent to the default
-     				 * of tracing before and after. */
-     int maxLevel;		/* Only call proc for commands at nesting
- 				 * level<=argument level (1=>top level). 
- 				 * If zero, then ignore minimum level. */
-     int minLevel;		/* Only call proc for commands at nesting
- 				 * level>=argument level (1=>top level). 
- 				 * If zero then ignore maximum level. */
-     Tcl_CmdTraceObjProc *proc;	/* Procedure to call before executing each
- 				 * command. */
-     ClientData clientData;	/* Arbitrary value word to pass to proc. */
- {
-     register Trace *tracePtr;
-     register Interp *iPtr = (Interp *) interp;
- 
-     /*
-      * Invalidate existing compiled code for this interpreter and arrange
-      * (by setting the DONT_COMPILE_CMDS_INLINE flag) that when compiling
-      * new code, no commands will be compiled inline (i.e., into an inline
-      * sequence of instructions). We do this because commands that were
-      * compiled inline will never result in a command trace being called.
-      */
- 
-     iPtr->compileEpoch++;
-     iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
- 
-     tracePtr = (Trace *) ckalloc(sizeof(Trace));
-     tracePtr->level = minLevel;
-     tracePtr->objProc = proc;
-     if((traceFlags & 3) == 0) {
- 	tracePtr->traceFlags = TCL_CMD_TRACE_BEFORE | TCL_CMD_TRACE_AFTER;
-     } else {
- 	tracePtr->traceFlags = traceFlags & 3;
-     }
-     tracePtr->clientData = clientData;
-     tracePtr->minLevel = minLevel;
-     tracePtr->cmdPtr = NULL;
-     if(insideCmd != NULL) {
- 	tracePtr->cmdPtr = Tcl_FindCommand(interp,
- 	      Tcl_GetString(insideCmd), (Tcl_Namespace *) NULL, /*flags*/ 0);
-     }
-     tracePtr->tracingCmdDepth = 0;
-     tracePtr->tracingInitialDepth = 0;
      tracePtr->nextPtr = iPtr->tracePtr;
      iPtr->tracePtr = tracePtr;
  
--- 3837,3843 ----
diff -C 3 -r -X traceignore.txt tcl8.2/generic/tclExecute.c tcl8.2orig/generic/tclExecute.c
*** tcl8.2/generic/tclExecute.c	Wed Sep 22 18:55:43 1999
--- tcl8.2orig/generic/tclExecute.c	Wed Jun 16 15:56:33 1999
***************
*** 208,214 ****
  static void		CallTraceProcedure _ANSI_ARGS_((Tcl_Interp *interp,
  			    Trace *tracePtr, Command *cmdPtr,
  			    char *command, int numChars,
! 			    int objc, Tcl_Obj *CONST objv[]));
  static void		DupCmdNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
  			    Tcl_Obj *copyPtr));
  static int		ExprAbsFunc _ANSI_ARGS_((Tcl_Interp *interp,
--- 208,214 ----
  static void		CallTraceProcedure _ANSI_ARGS_((Tcl_Interp *interp,
  			    Trace *tracePtr, Command *cmdPtr,
  			    char *command, int numChars,
! 			    int objc, Tcl_Obj *objv[]));
  static void		DupCmdNameInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
  			    Tcl_Obj *copyPtr));
  static int		ExprAbsFunc _ANSI_ARGS_((Tcl_Interp *interp,
***************
*** 726,737 ****
  	    
  	    doInvocation:
  	    {
! 		int objc = opnd;   /* The number of arguments. */
! 		Tcl_Obj **objv;	   /* The array of argument objects. */
! 		Command *cmdPtr;   /* Points to command's Command struct. */
! 		int newPcOffset;   /* New inst offset for break, continue. */
! 		char *command;     /* String starting with actual command */
! 		int numChars;      /* Number of chars of command to use */
  #ifdef TCL_COMPILE_DEBUG
  		int isUnknownCmd = 0;
  		char cmdNameBuf[21];
--- 726,735 ----
  	    
  	    doInvocation:
  	    {
! 		int objc = opnd; /* The number of arguments. */
! 		Tcl_Obj **objv;	 /* The array of argument objects. */
! 		Command *cmdPtr; /* Points to command's Command struct. */
! 		int newPcOffset; /* New inst offset for break, continue. */
  #ifdef TCL_COMPILE_DEBUG
  		int isUnknownCmd = 0;
  		char cmdNameBuf[21];
***************
*** 789,799 ****
  		 */
  
  		if (iPtr->tracePtr != NULL) {
! 		    command = GetSrcInfoForPc(pc, codePtr, &numChars);
! 		    DECACHE_STACK_INFO();
! 		    TclCheckTraces(interp,command,numChars,cmdPtr,TCL_OK,
! 				   TCL_CMD_TRACE_BEFORE,objc,objv);
! 		    CACHE_STACK_INFO();
  		}
  		
  		/*
--- 787,809 ----
  		 */
  
  		if (iPtr->tracePtr != NULL) {
! 		    Trace *tracePtr, *nextTracePtr;
! 
! 		    for (tracePtr = iPtr->tracePtr;  tracePtr != NULL;
! 		            tracePtr = nextTracePtr) {
! 			nextTracePtr = tracePtr->nextPtr;
! 			if (iPtr->numLevels <= tracePtr->level) {
! 			    int numChars;
! 			    char *cmd = GetSrcInfoForPc(pc, codePtr,
! 				    &numChars);
! 			    if (cmd != NULL) {
! 				DECACHE_STACK_INFO();
! 				CallTraceProcedure(interp, tracePtr, cmdPtr,
! 				        cmd, numChars, objc, objv);
! 				CACHE_STACK_INFO();
! 			    }
! 			}
! 		    }
  		}
  		
  		/*
***************
*** 849,861 ****
  		    (void) Tcl_GetObjResult(interp);
  		}
  		
- 		if (iPtr->tracePtr != NULL) {
- 		    DECACHE_STACK_INFO();
- 		    TclCheckTraces(interp,command,numChars,cmdPtr,result,
- 				   TCL_CMD_TRACE_AFTER,objc,objv);
- 		    CACHE_STACK_INFO();
- 		}
- 		
  		/*
  		 * Pop the objc top stack elements and decrement their ref
  		 * counts. 
--- 859,864 ----
***************
*** 3083,3185 ****
  /*
   *----------------------------------------------------------------------
   *
-  * TclCheckTraces --
-  *
-  *	Checks on all current traces, and invokes procedures which
-  *	have been registered.  This procedure can be used by other
-  *	code which performs execution to unify the tracing system.
-  *	For instance extensions like [incr Tcl] which use their
-  *	own execution technique can make use of Tcl's tracing.
-  *	
-  *	This procedure is used by 'EvalObjv' and 'TclExecuteByteCode'
-  *
-  * Results:
-  *	None.
-  *
-  * Side effects:
-  *	Those side effects made by any trace procedures called.
-  *
-  *----------------------------------------------------------------------
-  */
- void 
- TclCheckTraces(interp, command, numChars, cmdPtr, result, traceFlags, objc, objv)
-     Tcl_Interp *interp;		/* The current interpreter. */
-     char *command;              /* Pointer to beginning of the current 
-                                  * command string. */
-     int numChars;               /* The number of characters in 'command' 
-                                  * which are part of the command string. */
-     Command *cmdPtr;		/* Points to command's Command struct. */
-     int result;                 /* The current result code. */
-     int traceFlags;             /* Current tracing situation. */
-     int objc;			/* Number of arguments for the command. */
-     Tcl_Obj *CONST objv[];	/* Pointers to Tcl_Obj of each argument. */
- {
-     Interp *iPtr = (Interp *) interp;
-     Trace *tracePtr;
-     
-     if (command == NULL) {
- 	return;
-     }
- 
-     for (tracePtr = iPtr->tracePtr;tracePtr != NULL;tracePtr = tracePtr->nextPtr) {
- 	if (tracePtr->level != 0 && iPtr->numLevels > tracePtr->level) {
- 	    continue;
- 	}
- 	if (tracePtr->traceFlags != 0) {
- 	    /* The trace was created with Tcl_CreateTraceObj */
- 	    if (iPtr->numLevels < tracePtr->minLevel) {
- 		continue;
- 	    }
- 
- 	    if (traceFlags & TCL_CMD_TRACE_BEFORE) {
- 		if (tracePtr->cmdPtr != NULL) {
- 		    if (tracePtr->tracingCmdDepth == 0) {
- 			if (cmdPtr == (Command*)tracePtr->cmdPtr) {
- 			    tracePtr->tracingInitialDepth = iPtr->numLevels;
- 			} else {
- 			    continue;
- 			}
- 		    }
- 		    /* If we reach here, we are inside the command
- 		     * we wish to trace. */
- 		    tracePtr->tracingCmdDepth++;
- 		}
- 		if (tracePtr->traceFlags & TCL_CMD_TRACE_BEFORE) {
- 		    (*tracePtr->objProc)(tracePtr->clientData, interp, 
- 		      iPtr->numLevels, tracePtr->tracingInitialDepth, 
- 		      TCL_CMD_TRACE_BEFORE, 0,
- 		      command, numChars, (Tcl_Command)cmdPtr,
- 		      objc, objv);
- 		}
- 	    } else {
- 		if (tracePtr->cmdPtr != NULL) {
- 		    if (tracePtr->tracingCmdDepth == 0) {
- 			continue;
- 		    }
- 		    /* If we reach here, we are inside the command
- 		     * we wish to trace. */
- 		    tracePtr->tracingCmdDepth--;
- 		}
- 		if (tracePtr->traceFlags & TCL_CMD_TRACE_AFTER) {
- 		    (*tracePtr->objProc)(tracePtr->clientData, interp, 
- 			    iPtr->numLevels, tracePtr->tracingInitialDepth,
- 			    tracePtr->traceFlags & TCL_CMD_TRACE_AFTER, 
- 			    result, command, numChars, (Tcl_Command)cmdPtr,
- 			    objc, objv);
- 		}
- 	    }
- 	} else {
- 	    /* The trace was created with Tcl_CreateTrace */
- 	    CallTraceProcedure(interp, tracePtr, cmdPtr,
- 		    command, numChars, objc, objv);
- 	}
-     }
- }
- 
- 
- /*
-  *----------------------------------------------------------------------
-  *
   * CallTraceProcedure --
   *
   *	Invokes a trace procedure registered with an interpreter. These
--- 3086,3091 ----
***************
*** 3206,3212 ****
      int numChars;		/* The number of characters in the
  				 * command's source. */
      register int objc;		/* Number of arguments for the command. */
!     Tcl_Obj *CONST objv[];	/* Pointers to Tcl_Obj of each argument. */
  {
      Interp *iPtr = (Interp *) interp;
      register char **argv;
--- 3112,3118 ----
      int numChars;		/* The number of characters in the
  				 * command's source. */
      register int objc;		/* Number of arguments for the command. */
!     Tcl_Obj *objv[];		/* Pointers to Tcl_Obj of each argument. */
  {
      Interp *iPtr = (Interp *) interp;
      register char **argv;
diff -C 3 -r -X traceignore.txt tcl8.2/generic/tclInt.decls tcl8.2orig/generic/tclInt.decls
*** tcl8.2/generic/tclInt.decls	Wed Sep 22 18:49:37 1999
--- tcl8.2orig/generic/tclInt.decls	Mon Aug 09 20:42:14 1999
***************
*** 543,548 ****
--- 543,549 ----
  declare 145 generic {
      struct AuxDataType *TclGetAuxDataType(char *typeName)
  }
+ 
  declare 146 generic {
      TclHandle TclHandleCreate(VOID *ptr)
  }
***************
*** 590,606 ****
  }
  declare 157 generic {
      Var * TclVarTraceExists (Tcl_Interp *interp, char *varName)
- }
- 
- declare 159 generic {
-     void TclCheckTraces (Tcl_Interp *interp, char *command, int numChars, \
-             Command *cmdPtr, int result, int traceFlags, int objc, \
- 	    Tcl_Obj *CONST objv[])
  }
  
  ##############################################################################
--- 591,596 ----
diff -C 3 -r -X traceignore.txt tcl8.2/generic/tclInt.h tcl8.2orig/generic/tclInt.h
*** tcl8.2/generic/tclInt.h	Sun Sep 19 03:13:53 1999
--- tcl8.2orig/generic/tclInt.h	Mon Aug 02 11:45:37 1999
***************
*** 612,637 ****
   */
  
  typedef struct Trace {
!     int level;			      /* Only trace commands at nesting level
! 				       * less than or equal to this. */
!     union {
!         Tcl_CmdTraceProc *proc;	      /* Procedure to call to trace command. */
! 	Tcl_CmdTraceObjProc *objProc; /* Procedure to call to trace command. */
!     };
!     ClientData clientData;	      /* Arbitrary value to pass to proc. */
!     struct Trace *nextPtr;	      /* Next in list of traces for this 
!     				       * interp. */
!     int traceFlags;		      /* If zero, then this is an old trace 
!     				       * strcture, and the following fields are
!     				       * ignored.  Otherwise it is an or'd 
!     				       * combination of TCL_CMD_TRACE_ flags. 
!     				       * Old trace structures use the 'proc'
!     				       * above, new ones use 'objProc'. */
!     int minLevel;		      /* Only trace commands at nesting level
! 				       * greater than or equal to this. */
!     Tcl_Command cmdPtr;		      /* Only trace inside this command */
!     int tracingCmdDepth;	      /* Used to keep track of depth. */
!     int tracingInitialDepth;	      /* Used to keep track of depth. */
  } Trace;
  
  /*
--- 612,622 ----
   */
  
  typedef struct Trace {
!     int level;			/* Only trace commands at nesting level
! 				 * less than or equal to this. */
!     Tcl_CmdTraceProc *proc;	/* Procedure to call to trace command. */
!     ClientData clientData;	/* Arbitrary value to pass to proc. */
!     struct Trace *nextPtr;	/* Next in list of traces for this interp. */
  } Trace;
  
  /*
***************
*** 1495,1518 ****
  
  typedef struct TclpTime_t_ *TclpTime_t;
  
  /*
   *----------------------------------------------------------------
   * Variables shared among Tcl modules but not used by the outside world.
diff -C 3 -r -X traceignore.txt tcl8.2/generic/tclParse.c tcl8.2orig/generic/tclParse.c
*** tcl8.2/generic/tclParse.c	Wed Sep 22 18:51:37 1999
--- tcl8.2orig/generic/tclParse.c	Thu Aug 12 17:14:42 1999
***************
*** 799,804 ****
--- 799,806 ----
      Interp *iPtr = (Interp *) interp;
      Tcl_Obj **newObjv;
      int i, code;
+     Trace *tracePtr, *nextPtr;
+     char **argv, *commandCopy;
      CallFrame *savedVarFramePtr;	/* Saves old copy of iPtr->varFramePtr
  					 * in case TCL_EVAL_GLOBAL was set. */
  
***************
*** 878,886 ****
       * Call trace procedures if needed.
       */
  
!     if (iPtr->tracePtr != NULL) {
! 	TclCheckTraces(interp, command, length, cmdPtr, TCL_OK,
! 		       TCL_CMD_TRACE_BEFORE, objc, objv);
      }
      
      /*
--- 880,923 ----
       * Call trace procedures if needed.
       */
  
!     argv = NULL;
!     commandCopy = command;
! 
!     for (tracePtr = iPtr->tracePtr; tracePtr != NULL; tracePtr = nextPtr) {
! 	nextPtr = tracePtr->nextPtr;
! 	if (iPtr->numLevels > tracePtr->level) {
! 	    continue;
! 	}
! 
! 	/*
! 	 * This is a bit messy because we have to emulate the old trace
! 	 * interface, which uses strings for everything.
! 	 */
! 
! 	if (argv == NULL) {
! 	    argv = (char **) ckalloc((unsigned) (objc + 1) * sizeof(char *));
! 	    for (i = 0; i < objc; i++) {
! 		argv[i] = Tcl_GetString(objv[i]);
! 	    }
! 	    argv[objc] = 0;
! 
! 	    if (length < 0) {
! 		length = strlen(command);
! 	    } else if ((size_t)length < strlen(command)) {
! 		commandCopy = (char *) ckalloc((unsigned) (length + 1));
! 		strncpy(commandCopy, command, (size_t) length);
! 		commandCopy[length] = 0;
! 	    }
! 	}
! 	(*tracePtr->proc)(tracePtr->clientData, interp, iPtr->numLevels,
! 			  commandCopy, cmdPtr->proc, cmdPtr->clientData,
! 			  objc, argv);
!     }
!     if (argv != NULL) {
! 	ckfree((char *) argv);
!     }
!     if (commandCopy != command) {
! 	ckfree((char *) commandCopy);
      }
      
      /*
***************
*** 909,919 ****
  	(void) Tcl_GetObjResult(interp);
      }
  
-     if (iPtr->tracePtr != NULL) {
- 	TclCheckTraces(interp,command, length, cmdPtr, code,
- 		       TCL_CMD_TRACE_AFTER, objc, objv);
-     }
-     
      done:
      iPtr->numLevels--;
      return code;
--- 946,951 ----
***************
*** 962,972 ****
  	/*
  	 * EvalObjv will increment numLevels so use "<" rather than "<="
  	 */
! 	if ((tracePtr->level == 0 || (iPtr->numLevels < tracePtr->level))
! 	    && !(tracePtr->traceFlags != 0 
! 		 && (iPtr->numLevels < (tracePtr->minLevel - 1)))) {
! 	    /* It's either an old-style trace, or a new-style trace
! 	     * whose level is acceptable. */
  	    int i;
  	    /*
  	     * The command will be needed for an execution trace or stack trace
--- 994,1000 ----
  	/*
  	 * EvalObjv will increment numLevels so use "<" rather than "<="
  	 */
! 	if (iPtr->numLevels < tracePtr->level) {
  	    int i;
  	    /*
  	     * The command will be needed for an execution trace or stack trace