From 29cf1d7bf639866e48ef946d326a229a9514f492 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 5 May 2007 23:33:11 +0000 Subject: Changes to allow the tip257 code to work as an extension properly post-tip280 --- ChangeLog | 13 ++++ generic/tclCmdIL.c | 23 +++++-- generic/tclInt.decls | 17 +++-- generic/tclInt.h | 177 +++++++++++++++++++++++++++++---------------------- generic/tclProc.c | 56 ++++++++-------- 5 files changed, 174 insertions(+), 112 deletions(-) diff --git a/ChangeLog b/ChangeLog index caa2ef1..6535d14 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +2007-05-06 Donal K. Fellows + + * generic/tclInt.h (ExtraFrameInfo): Create a new mechanism for + * generic/tclCmdIL.c (InfoFrameCmd): conveying what information needs + to be added to the results of [info frame] to replace the hack that + was there before. + * generic/tclProc.c (Tcl_ApplyObjCmd): Use the new mechanism for the + [apply] command, the only part of Tcl itself that needs it (so far). + + * generic/tclInt.decls (TclEvalObjEx, TclGetSrcInfoForPc): Expose + these two functions through the internal stubs table, necessary for + extensions that need to integrate deeply with TIP#280. + 2007-05-05 Donal K. Fellows * win/tclWinFile.c (TclpGetUserHome): Squelch type-pun warnings in 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 ; ilength ; 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 -- cgit v0.12