summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2017-04-22 14:57:17 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2017-04-22 14:57:17 (GMT)
commit2507a22c1331a14e20f89bc665f8f8f0810d8da8 (patch)
treef1ff3c4b364185f5be97cc91fbc37ed76cbf52ad
parent0c9c64f76498585487efd90abb910d7f1e23072c (diff)
downloadtcl-2507a22c1331a14e20f89bc665f8f8f0810d8da8.zip
tcl-2507a22c1331a14e20f89bc665f8f8f0810d8da8.tar.gz
tcl-2507a22c1331a14e20f89bc665f8f8f0810d8da8.tar.bz2
A better way of getting source file location information when disassembling.
-rw-r--r--generic/tclDisassemble.c34
-rw-r--r--generic/tclInt.h5
-rw-r--r--generic/tclProc.c35
3 files changed, 54 insertions, 20 deletions
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index 1d616fb..f62c260 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -27,9 +27,8 @@ static Tcl_Obj * DisassembleByteCodeObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
static int FormatInstruction(ByteCode *codePtr,
const unsigned char *pc, Tcl_Obj *bufferObj);
-static void GetLocationInformation(Tcl_Interp *interp,
- Proc *procPtr, Tcl_Obj **fileObjPtr,
- int *linePtr);
+static void GetLocationInformation(Proc *procPtr,
+ Tcl_Obj **fileObjPtr, int *linePtr);
static void PrintSourceToObj(Tcl_Obj *appendObj,
const char *stringPtr, int maxChars);
static void UpdateStringOfInstName(Tcl_Obj *objPtr);
@@ -73,8 +72,6 @@ static const Tcl_ObjType tclInstNameType = {
static void
GetLocationInformation(
- Tcl_Interp *interp, /* Where to look up the location
- * information. */
Proc *procPtr, /* What to look up the information for. */
Tcl_Obj **fileObjPtr, /* Where to write the information about what
* file the code came from. Will be written
@@ -88,20 +85,21 @@ GetLocationInformation(
* either with the line number or with -1 if
* the information is not available. */
{
- Interp *iPtr = (Interp *) interp;
- Tcl_HashEntry *hePtr;
- CmdFrame *cfPtr;
+ CmdFrame *cfPtr = TclGetCmdFrameForProcedure(procPtr);
*fileObjPtr = NULL;
*linePtr = -1;
- if (iPtr != NULL && procPtr != NULL) {
- hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, procPtr);
- if (hePtr != NULL && (cfPtr = Tcl_GetHashValue(hePtr)) != NULL) {
- *linePtr = cfPtr->line[0];
- if (cfPtr->type == TCL_LOCATION_SOURCE) {
- *fileObjPtr = cfPtr->data.eval.path;
- }
- }
+ if (cfPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Get the source location data out of the CmdFrame.
+ */
+
+ *linePtr = cfPtr->line[0];
+ if (cfPtr->type == TCL_LOCATION_SOURCE) {
+ *fileObjPtr = cfPtr->data.eval.path;
}
}
@@ -278,7 +276,7 @@ DisassembleByteCodeObj(
Tcl_AppendToObj(bufferObj, " Source ", -1);
PrintSourceToObj(bufferObj, codePtr->source,
TclMin(codePtr->numSrcBytes, 55));
- GetLocationInformation(interp, codePtr->procPtr, &fileObj, &line);
+ GetLocationInformation(codePtr->procPtr, &fileObj, &line);
if (line > -1 && fileObj != NULL) {
Tcl_AppendPrintfToObj(bufferObj, "\n File \"%s\" Line %d",
Tcl_GetString(fileObj), line);
@@ -1221,7 +1219,7 @@ DisassembleByteCodeAsDicts(
* system if it is available.
*/
- GetLocationInformation(interp, codePtr->procPtr, &file, &line);
+ GetLocationInformation(codePtr->procPtr, &file, &line);
/*
* Build the overall result.
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1deda3c..fe4fefd 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2940,7 +2940,8 @@ MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler(Tcl_Interp *interp);
MODULE_SCOPE int TclGetChannelFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Channel *chanPtr,
int *modePtr, int flags);
-MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp,
+MODULE_SCOPE CmdFrame * TclGetCmdFrameForProcedure(Proc *procPtr);
+MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp,
Tcl_Obj *value, int *code);
MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, ClientData *clientDataPtr,
@@ -3920,7 +3921,7 @@ MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp,
struct CompileEnv *envPtr);
/*
- * Functions defined in generic/tclVar.c and currenttly exported only for use
+ * Functions defined in generic/tclVar.c and currently exported only for use
* by the bytecode compiler and engine. Some of these could later be placed in
* the public interface.
*/
diff --git a/generic/tclProc.c b/generic/tclProc.c
index ae9e7cd..5c68e17 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -2774,6 +2774,41 @@ MakeLambdaError(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetCmdFrameForProcedure --
+ *
+ * How to get the CmdFrame information for a procedure.
+ *
+ * Results:
+ * A pointer to the CmdFrame (only guaranteed to be valid until the next
+ * Tcl command is processed or the interpreter's state is otherwise
+ * modified) or a NULL if the information is not available.
+ *
+ * Side effects:
+ * none.
+ *
+ *----------------------------------------------------------------------
+ */
+
+CmdFrame *
+TclGetCmdFrameForProcedure(
+ Proc *procPtr) /* The procedure whose cmd-frame is to be
+ * looked up. */
+{
+ Tcl_HashEntry *hePtr;
+
+ if (procPtr == NULL || procPtr->iPtr == NULL) {
+ return NULL;
+ }
+ hePtr = Tcl_FindHashEntry(procPtr->iPtr->linePBodyPtr, procPtr);
+ if (hePtr == NULL) {
+ return NULL;
+ }
+ return (CmdFrame *) Tcl_GetHashValue(hePtr);
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4