Changes to allow the tip257 code to work as an extension properly post-tip280

4 files changed, 161 insertions, 112 deletions

diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 08a96db..cdda071 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdIL.c,v 1.114 2007/04/20 05:51:09 kennykb Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.115 2007/05/05 23:33:13 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -1274,15 +1274,24 @@ InfoFrameCmd(
 		    Tcl_AppendToObj(lv[lc-1], "::", -1);
 		}
 		Tcl_AppendToObj(lv[lc-1], procName, -1);
-	    } else {
+	    } else if (procPtr->cmdPtr->clientData) {
+		ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
+		int i;
+
 		/*
-		 * Lambda execution. The lambda in question is stored in the
-		 * clientData of the cmdPtr. See the #280 HACK in
-		 * Tcl_ApplyObjCmd. There is no separate namespace to
-		 * consider, if any is used it is part of the lambda term.
+		 * This is a non-standard command. Luckily, it's told us how
+		 * to render extra information about its frame.
 		 */
 
-		ADD_PAIR("lambda", (Tcl_Obj *) procPtr->cmdPtr->clientData);
+		for (i=0 ; i<efiPtr->length ; i++) {
+		    lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1);
+		    if (efiPtr->fields[i].proc) {
+			lv[lc++] = efiPtr->fields[i].proc(
+				efiPtr->fields[i].clientData);
+		    } else {
+			lv[lc++] = efiPtr->fields[i].clientData;
+		    }
+		}
 	    }
 	}
 	break;
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index a110ae0..b17c8e7 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 # 
-# RCS: @(#) $Id: tclInt.decls,v 1.107 2007/04/03 15:08:24 msofer Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.108 2007/05/05 23:33:14 dkf Exp $
 
 library tcl
 
@@ -886,7 +886,7 @@ declare 224 generic {
     TclPlatformType *TclGetPlatform(void)
 }
 
-# 
+#
 declare 225 generic {
     Tcl_Obj *TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr,
 	    int keyc, Tcl_Obj *CONST keyv[], int flags)
@@ -916,8 +916,17 @@ declare 230 generic {
 }
 
 declare 231 generic {
-    int	TclGetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, 
-	     Tcl_Namespace **nsPtrPtr)
+    int	TclGetNamespaceFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+	    Tcl_Namespace **nsPtrPtr)
+}
+
+# Bits and pieces of TIP#280's guts
+declare 232 generic {
+    int TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
+	    const CmdFrame *invoker, int word)
+}
+declare 233 generic {
+    void TclGetSrcInfoForPc(CmdFrame *contextPtr)
 }
 
 ##############################################################################
diff --git a/generic/tclInt.h b/generic/tclInt.h
index df2ea41..c839e3c 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.306 2007/04/18 22:49:48 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.307 2007/05/05 23:33:14 dkf Exp $
  */
 
 #ifndef _TCLINT
@@ -937,98 +937,100 @@ typedef struct CallFrame {
 
 /*
  * TIP #280
- * The structure below defines a command frame. A command frame
- * provides location information for all commands executing a tcl
- * script (source, eval, uplevel, procedure bodies, ...). The runtime
- * structure essentially contains the stack trace as it would be if
- * the currently executing command were to throw an error.
+ * The structure below defines a command frame. A command frame provides
+ * location information for all commands executing a tcl script (source, eval,
+ * uplevel, procedure bodies, ...). The runtime structure essentially contains
+ * the stack trace as it would be if the currently executing command were to
+ * throw an error.
  *
- * For commands where it makes sense it refers to the associated
- * CallFrame as well.
+ * For commands where it makes sense it refers to the associated CallFrame as
+ * well.
  *
- * The structures are chained in a single list, with the top of the
- * stack anchored in the Interp structure.
+ * The structures are chained in a single list, with the top of the stack
+ * anchored in the Interp structure.
  *
- * Instances can be allocated on the C stack, or the heap, the former
- * making cleanup a bit simpler.
+ * Instances can be allocated on the C stack, or the heap, the former making
+ * cleanup a bit simpler.
  */
 
 typedef struct CmdFrame {
-  /* General data. Always available. */
-
-  int              type;     /* Values see below */
-  int              level;    /* #Frames in stack, prevent O(n) scan of list */
-  int*             line;     /* Lines the words of the command start on */
-  int              nline;
-
-  CallFrame*       framePtr; /* Procedure activation record, may be NULL */
-  struct CmdFrame* nextPtr;  /* Link to calling frame */
-
-  /* Data needed for Eval vs TEBC
-   *
-   * EXECUTION CONTEXTS and usage of CmdFrame
-   *
-   * Field      TEBC            EvalEx          EvalObjEx
-   * =======    ====            ======          =========
-   * level      yes             yes             yes
-   * type       BC/PREBC        SRC/EVAL        EVAL_LIST
-   * line0      yes             yes             yes
-   * framePtr   yes             yes             yes
-   * =======    ====            ======          =========
-   *
-   * =======    ====            ======          ========= union data
-   * line1      -               yes             -
-   * line3      -               yes             -
-   * path       -               yes             -
-   * -------    ----            ------          ---------
-   * codePtr    yes             -               -
-   * pc         yes             -               -
-   * =======    ====            ======          =========
-   *
-   * =======    ====            ======          ========= | union cmd
-   * listPtr    -               -               yes       |
-   * -------    ----            ------          --------- |
-   * cmd        yes             yes             -         |
-   * cmdlen     yes             yes             -         |
-   * -------    ----            ------          --------- |
-   */
-
-  union {
-    struct {
-      Tcl_Obj*     path;     /* Path of the sourced file the command
-			      * is in. */
-    } eval;
-    struct {
-      CONST void*  codePtr;  /* Byte code currently executed */
-      CONST char*  pc;       /* and instruction pointer.     */
-    } tebc;
-  } data;
+    /* General data. Always available. */
 
-  union {
-    struct {
-      CONST char*  cmd;      /* The executed command, if possible */
-      int          len;      /* And its length */
-    } str;
-    Tcl_Obj*       listPtr;  /* Tcl_EvalObjEx, cmd list */
-  } cmd;
+    int type;			/* Values see below. */
+    int level;			/* #Frames in stack, prevent O(n) scan of
+				 * list. */
+    int *line;			/* Lines the words of the command start on. */
+    int nline;
+
+    CallFrame *framePtr;	/* Procedure activation record, may be
+				 * NULL. */
+    struct CmdFrame *nextPtr;	/* Link to calling frame */
+
+    /*
+     * Data needed for Eval vs TEBC
+     *
+     * EXECUTION CONTEXTS and usage of CmdFrame
+     *
+     * Field      TEBC            EvalEx          EvalObjEx
+     * =======    ====            ======          =========
+     * level      yes             yes             yes
+     * type       BC/PREBC        SRC/EVAL        EVAL_LIST
+     * line0      yes             yes             yes
+     * framePtr   yes             yes             yes
+     * =======    ====            ======          =========
+     *
+     * =======    ====            ======          ========= union data
+     * line1      -               yes             -
+     * line3      -               yes             -
+     * path       -               yes             -
+     * -------    ----            ------          ---------
+     * codePtr    yes             -               -
+     * pc         yes             -               -
+     * =======    ====            ======          =========
+     *
+     * =======    ====            ======          ========= | union cmd
+     * listPtr    -               -               yes       |
+     * -------    ----            ------          --------- |
+     * cmd        yes             yes             -         |
+     * cmdlen     yes             yes             -         |
+     * -------    ----            ------          --------- |
+     */
 
+    union {
+	struct {
+	    Tcl_Obj *path;	/* Path of the sourced file the command is
+				 * in. */
+	} eval;
+	struct {
+	    CONST void *codePtr;/* Byte code currently executed */
+	    CONST char *pc;	/* and instruction pointer.     */
+	} tebc;
+    } data;
+    union {
+	struct {
+	    CONST char *cmd;	/* The executed command, if possible */
+	    int len;		/* And its length */
+	} str;
+	Tcl_Obj *listPtr;	/* Tcl_EvalObjEx, cmd list */
+    } cmd;
 } CmdFrame;
 
-/* The following macros define the allowed values for the type field
- * of the CmdFrame structure above. Some of the values occur only in
- * the extended location data referenced via the 'baseLocPtr'.
+/*
+ * The following macros define the allowed values for the type field of the
+ * CmdFrame structure above. Some of the values occur only in the extended
+ * location data referenced via the 'baseLocPtr'.
  *
  * TCL_LOCATION_EVAL      : Frame is for a script evaluated by EvalEx.
  * TCL_LOCATION_EVAL_LIST : Frame is for a script evaluated by the list
  *                          optimization path of EvalObjEx.
- * TCL_LOCATION_BC        : Frame is for bytecode. 
+ * TCL_LOCATION_BC        : Frame is for bytecode.
  * TCL_LOCATION_PREBC     : Frame is for precompiled bytecode.
- * TCL_LOCATION_SOURCE    : Frame is for a script evaluated by EvalEx,
- *                          from a sourced file.
+ * TCL_LOCATION_SOURCE    : Frame is for a script evaluated by EvalEx, from a
+ *                          sourced file.
  * TCL_LOCATION_PROC      : Frame is for bytecode of a procedure.
  *
- * A TCL_LOCATION_BC type in a frame can be overridden by _SOURCE and
- * _PROC types, per the context of the byte code in execution.
+ * A TCL_LOCATION_BC type in a frame can be overridden by _SOURCE and _PROC
+ * types, per the context of the byte code in execution.
  */
 
 #define TCL_LOCATION_EVAL      (0) /* Location in a dynamic eval script */
@@ -1041,6 +1043,28 @@ typedef struct CmdFrame {
 #define TCL_LOCATION_LAST      (6) /* Number of values in the enum */
 
 /*
+ * Structure passed to describe procedure-like "procedures" that are not
+ * procedures (e.g. a lambda) so that their details can be reported correctly
+ * by [info frame]. Contains a sub-structure for each extra field.
+ */
+
+typedef Tcl_Obj *(*GetFrameInfoValueProc)(ClientData clientData);
+typedef struct {
+    const char *name;		/* Name of this field. */
+    GetFrameInfoValueProc proc;	/* Function to generate a Tcl_Obj* from the
+				 * clientData, or just use the clientData
+				 * directly (after casting) if NULL. */
+    ClientData clientData;	/* Context for above function, or Tcl_Obj* if
+				 * proc field is NULL. */
+} ExtraFrameInfoField;
+typedef struct {
+    int length;			/* Length of array. */
+    ExtraFrameInfoField fields[2];
+				/* Really as long as necessary, but this is
+				 * long enough for nearly anything. */
+} ExtraFrameInfo;
+
+/*
  *----------------------------------------------------------------
  * Data structures and procedures related to TclHandles, which are a very
  * lightweight method of preserving enough information to determine if an
@@ -1057,6 +1081,7 @@ typedef void **TclHandle;
  * It will probably go away in a later release.
  *----------------------------------------------------------------
  */
+
 #define TCL_REG_BOSONLY         002000  /* prepend \A to pattern so it only
 					 * matches at the beginning of the
 					 * string. */
diff --git a/generic/tclProc.c b/generic/tclProc.c
index c87da49..4f75d14 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclProc.c,v 1.113 2007/04/30 19:46:03 kennykb Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.114 2007/05/05 23:33:19 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -2264,39 +2264,40 @@ SetLambdaFromAny(
 
 	if (context.type == TCL_LOCATION_BC) {
 	    /*
-	     * Retrieve the source context from the bytecode.  This
-	     * call accounts for the reference to the source file,
-	     * if any, held in 'context.data.eval.path'.
+	     * Retrieve the source context from the bytecode. This call
+	     * accounts for the reference to the source file, if any, held in
+	     * 'context.data.eval.path'.
 	     */
+
 	    TclGetSrcInfoForPc(&context);
 	} else if (context.type == TCL_LOCATION_SOURCE) {
 	    /*
-	     * We created a new reference to the source file path
-	     * name when we created 'context' above. Account for the reference.
+	     * We created a new reference to the source file path name when we
+	     * created 'context' above. Account for the reference.
 	     */
+
 	    Tcl_IncrRefCount(context.data.eval.path);
 
 	}
 
 	if (context.type == TCL_LOCATION_SOURCE) {
-
 	    /*
-	     * We can record source location within a lambda
-	     * only if the body was not created by substitution.
+	     * We can record source location within a lambda only if the body
+	     * was not created by substitution.
 	     */
 
 	    if (context.line
-		&& (context.nline >= 2) && (context.line[1] >= 0)) {
+		    && (context.nline >= 2) && (context.line[1] >= 0)) {
 		int isNew, buf[2];
 		CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame));
-		
+
 		/*
 		 * Move from approximation (line of list cmd word) to actual
 		 * location (line of 2nd list element).
 		 */
-		
+
 		TclListLines(name, context.line[1], 2, buf);
-		
+
 		cfPtr->level = -1;
 		cfPtr->type = context.type;
 		cfPtr->line = (int *) ckalloc(sizeof(int));
@@ -2304,20 +2305,19 @@ SetLambdaFromAny(
 		cfPtr->nline = 1;
 		cfPtr->framePtr = NULL;
 		cfPtr->nextPtr = NULL;
-		
+
 		cfPtr->data.eval.path = context.data.eval.path;
 		Tcl_IncrRefCount(cfPtr->data.eval.path);
 
 		cfPtr->cmd.str.cmd = NULL;
 		cfPtr->cmd.str.len = 0;
-		
+
 		Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr,
-						     (char *) procPtr, &isNew),
-				 cfPtr);
+			(char *) procPtr, &isNew), cfPtr);
 	    }
 
-	    /* 
-	     * 'context' is going out of scope. Release the reference that 
+	    /*
+	     * 'context' is going out of scope. Release the reference that
 	     * it's holding to the source file path
 	     */
 
@@ -2390,6 +2390,7 @@ Tcl_ApplyObjCmd(
     Command cmd;
     Tcl_Namespace *nsPtr;
     int isRootEnsemble;
+    ExtraFrameInfo efi;
 
     if (objc < 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "lambdaExpr ?arg1 arg2 ...?");
@@ -2437,15 +2438,20 @@ Tcl_ApplyObjCmd(
     procPtr->cmdPtr = &cmd;
 
     /*
-     * TIP#280 HACK!
+     * TIP#280 (semi-)HACK!
      *
-     * Using cmd.clientData to remember the 'lambdaPtr' for 'info frame'.  The
-     * InfoFrameCmd will detect this case by testing cmd.hPtr for NULL. This
-     * condition holds here because of the 'memset' above, and nowhere else.
-     * Regular commands always have a valid 'hPtr', and lambda's never.
+     * Using cmd.clientData to tell [info frame] how to render the
+     * 'lambdaPtr'. The InfoFrameCmd will detect this case by testing cmd.hPtr
+     * for NULL. This condition holds here because of the 'memset' above, and
+     * nowhere else (in the core). Regular commands always have a valid
+     * 'hPtr', and lambda's never.
      */
 
-    cmd.clientData = (ClientData) lambdaPtr;
+    efi.length = 1;
+    efi.fields[0].name = "lambda";
+    efi.fields[0].proc = NULL;
+    efi.fields[0].clientData = lambdaPtr;
+    cmd.clientData = &efi;
 
     /*
      * Find the namespace where this lambda should run, and push a call frame