summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2007-05-05 23:33:11 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2007-05-05 23:33:11 (GMT)
commit29cf1d7bf639866e48ef946d326a229a9514f492 (patch)
tree1d78768bab303fef7c4c0ad56f5d8d65f3841216 /generic
parente3a939a3c254481c00ee564e3e5bb4306ddeb7bf (diff)
downloadtcl-29cf1d7bf639866e48ef946d326a229a9514f492.zip
tcl-29cf1d7bf639866e48ef946d326a229a9514f492.tar.gz
tcl-29cf1d7bf639866e48ef946d326a229a9514f492.tar.bz2
Changes to allow the tip257 code to work as an extension properly post-tip280
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCmdIL.c23
-rw-r--r--generic/tclInt.decls17
-rw-r--r--generic/tclInt.h177
-rw-r--r--generic/tclProc.c56
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