summaryrefslogtreecommitdiffstats
path: root/tools/h5jam
diff options
context:
space:
mode:
authorJames Laird <jlaird@hdfgroup.org>2005-04-04 21:17:51 (GMT)
committerJames Laird <jlaird@hdfgroup.org>2005-04-04 21:17:51 (GMT)
commitb296a419c4ed2cc43cab53b78a40cbf1346f2362 (patch)
tree7a652352898be1a2e963c9e700228c00a878657d /tools/h5jam
parent7f5e1dfe31696bddb3967865af52801a2b38bb7e (diff)
downloadhdf5-b296a419c4ed2cc43cab53b78a40cbf1346f2362.zip
hdf5-b296a419c4ed2cc43cab53b78a40cbf1346f2362.tar.gz
hdf5-b296a419c4ed2cc43cab53b78a40cbf1346f2362.tar.bz2
[svn-r10534] Purpose:
Configuration feature Description: Different Fortran compilers mangle function names in different ways (upper case, lower case, adding underscores). To link between Fortran and C functions, we need to know what a given function's name is under a given compiler. Solution: Use autoconf's FC_WRAPPERS check to determine the Fortran naming scheme and define the FC_FUNC_ macro to name our functions (in H5f90proto.h). Removed references to our old FNAME macro, as well as flags that indicated whether function names were upper or lower case. Platforms tested: mir, pommier, modi4, copper, more
Diffstat (limited to 'tools/h5jam')
-rw-r--r--tools/h5jam/Makefile.in1
1 files changed, 1 insertions, 0 deletions
diff --git a/tools/h5jam/Makefile.in b/tools/h5jam/Makefile.in
index 1a8000a..caecd36 100644
--- a/tools/h5jam/Makefile.in
+++ b/tools/h5jam/Makefile.in
@@ -155,6 +155,7 @@ F9XMODFLAG = @F9XMODFLAG@
F9XSUFFIXFLAG = @F9XSUFFIXFLAG@
FC = @FC@
FCFLAGS = @FCFLAGS@
+FCLIBS = @FCLIBS@
FFLAGS = @FFLAGS@
FILTERS = @FILTERS@
FSEARCH_DIRS = @FSEARCH_DIRS@
generated by cgit v0.12 at 2024-10-02 16:23:47 (GMT)
'core_8_1_b3_synthetic'>core_8_1_b3_synthetic Tcl is a high-level, general-purpose, interpreted, dynamic programming language. It was designed with the goal of being very simple but powerful.
summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog12
-rw-r--r--generic/tclBasic.c282
-rw-r--r--generic/tclCmdAH.c9
-rw-r--r--generic/tclCompCmds.c10
-rw-r--r--generic/tclCompile.c49
-rw-r--r--generic/tclCompile.h12
-rw-r--r--generic/tclInt.h41
-rw-r--r--generic/tclInterp.c11
-rw-r--r--generic/tclNamesp.c11
-rw-r--r--generic/tclProc.c10
10 files changed, 391 insertions, 56 deletions
diff --git a/ChangeLog b/ChangeLog
index 3966ff0..53267af 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,15 @@
+2008-07-21 Andreas Kupries <andreask@activestate.com>
+
+ * generic/tclBasic.c: Extended the existing TIP #280 system (info
+ * generic/tclCmdAH.c: frame), added the ability to track the
+ * generic/tclCompCmds.c: absolute location of literal procedure
+ * generic/tclCompile.c: arguments, and making this information
+ * generic/tclCompile.h: available to uplevel, eval, and
+ * generic/tclInterp.c: siblings. This allows proper tracking of
+ * generic/tclInt.h: absolute location through custom (Tcl-coded)
+ * generic/tclNamesp.c: control structures based on uplevel, etc.
+ * generic/tclProc.c:
+
2008-07-07 Andreas Kupries <andreask@activestate.com>
* generic/tclCmdIL.c (InfoFrameCmd): Fixed unsafe idiom of setting
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index fd37b89..4ad59c7 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.75.2.28 2007/09/13 16:13:19 das Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.75.2.29 2008/07/21 19:37:40 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -360,8 +360,10 @@ Tcl_CreateInterp()
iPtr->cmdFramePtr = NULL;
iPtr->linePBodyPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
iPtr->lineBCPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
+ iPtr->lineLAPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS);
Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS);
#endif
iPtr->activeVarTracePtr = NULL;
@@ -1204,6 +1206,26 @@ DeleteInterpProc(interp)
Tcl_DeleteHashTable (iPtr->lineBCPtr);
ckfree((char*) iPtr->lineBCPtr);
iPtr->lineBCPtr = NULL;
+
+ /*
+ * Location stack for uplevel/eval/... scripts which were passed
+ * through proc arguments. Actually we track all arguments as we
+ * don't, cannot know which arguments will be used as scripts and
+ * which won't.
+ */
+
+ if (iPtr->lineLAPtr->numEntries) {
+ /*
+ * When the interp goes away we have nothing on the stack, so
+ * there are no arguments, so this table has to be empty.
+ */
+
+ Tcl_Panic ("Argument location tracking table not empty");
+ }
+
+ Tcl_DeleteHashTable (iPtr->lineLAPtr);
+ ckfree((char*) iPtr->lineLAPtr);
+ iPtr->lineLAPtr = NULL;
}
#endif
ckfree((char *) iPtr);
@@ -4005,6 +4027,7 @@ EvalEx(interp, script, numBytes, flags, line)
eeFrame.cmd.str.len --;
}
+ TclArgumentEnter (interp, objv, objectsUsed, &eeFrame);
iPtr->cmdFramePtr = &eeFrame;
#endif
iPtr->numLevels++;
@@ -4013,6 +4036,7 @@ EvalEx(interp, script, numBytes, flags, line)
iPtr->numLevels--;
#ifdef TCL_TIP280
iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
+ TclArgumentRelease (interp, objv, objectsUsed);
ckfree ((char*) eeFrame.line);
eeFrame.line = NULL;
@@ -4271,6 +4295,207 @@ TclAdvanceLines (line,start,end)
}
}
}
+
+/*
+ *----------------------------------------------------------------------
+ * Note: The whole data structure access for argument location tracking is
+ * hidden behind these three functions. The only parts open are the lineLAPtr
+ * field in the Interp structure. The CFWord definition is internal to here.
+ * Should make it easier to redo the data structures if we find something more
+ * space/time efficient.
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArgumentEnter --
+ *
+ * This procedure is a helper for the TIP #280 uplevel extension.
+ * It enters location references for the arguments of a command to be
+ * invoked. Only the first entry has the actual data, further entries
+ * simply count the usage up.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May allocate memory.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclArgumentEnter(interp,objv,objc,cfPtr)
+ Tcl_Interp* interp;
+ Tcl_Obj** objv;
+ int objc;
+ CmdFrame* cfPtr;
+{
+ Interp* iPtr = (Interp*) interp;
+ int new, i;
+ Tcl_HashEntry* hPtr;
+ CFWord* cfwPtr;
+
+ for (i=1; i < objc; i++) {
+ /*
+ * Ignore argument words without line information (= dynamic). If
+ * they are variables they may have location information associated
+ * with that, either through globally recorded 'set' invokations, or
+ * literals in bytecode. Eitehr way there is no need to record
+ * something here.
+ */
+
+ if (cfPtr->line [i] < 0) continue;
+ hPtr = Tcl_CreateHashEntry (iPtr->lineLAPtr, (char*) objv[i], &new);
+ if (new) {
+ /*
+ * The word is not on the stack yet, remember the current location
+ * and initialize references.
+ */
+ cfwPtr = (CFWord*) ckalloc (sizeof (CFWord));
+ cfwPtr->framePtr = cfPtr;
+ cfwPtr->word = i;
+ cfwPtr->refCount = 1;
+ Tcl_SetHashValue (hPtr, cfwPtr);
+ } else {
+ /*
+ * The word is already on the stack, its current location is not
+ * relevant. Just remember the reference to prevent early removal.
+ */
+ cfwPtr = (CFWord*) Tcl_GetHashValue (hPtr);
+ cfwPtr->refCount ++;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArgumentRelease --
+ *
+ * This procedure is a helper for the TIP #280 uplevel extension.
+ * It removes the location references for the arguments of a command
+ * just done. Usage is counted down, the data is removed only when
+ * no user is left over.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May release memory.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclArgumentRelease(interp,objv,objc)
+ Tcl_Interp* interp;
+ Tcl_Obj** objv;
+ int objc;
+{
+ Interp* iPtr = (Interp*) interp;
+ Tcl_HashEntry* hPtr;
+ CFWord* cfwPtr;
+ int i;
+
+ for (i=1; i < objc; i++) {
+ hPtr = Tcl_FindHashEntry (iPtr->lineLAPtr, (char *) objv[i]);
+
+ if (!hPtr) { continue; }
+ cfwPtr = (CFWord*) Tcl_GetHashValue (hPtr);
+
+ cfwPtr->refCount --;
+ if (cfwPtr->refCount > 0) { continue; }
+
+ ckfree ((char*) cfwPtr);
+ Tcl_DeleteHashEntry (hPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclArgumentGet --
+ *
+ * This procedure is a helper for the TIP #280 uplevel extension.
+ * It find the location references for a Tcl_Obj, if any.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Writes found location information into the result arguments.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+void
+TclArgumentGet(interp,obj,cfPtrPtr,wordPtr)
+ Tcl_Interp* interp;
+ Tcl_Obj* obj;
+ CmdFrame** cfPtrPtr;
+ int* wordPtr;
+{
+ Interp* iPtr = (Interp*) interp;
+ Tcl_HashEntry* hPtr;
+ CmdFrame* framePtr;
+
+ /*
+ * First look for location information recorded in the argument
+ * stack. That is nearest.
+ */
+
+ hPtr = Tcl_FindHashEntry (iPtr->lineLAPtr, (char *) obj);
+ if (hPtr) {
+ CFWord* cfwPtr = (CFWord*) Tcl_GetHashValue (hPtr);
+ *wordPtr = cfwPtr->word;
+ *cfPtrPtr = cfwPtr->framePtr;
+ return;
+ }
+
+ /*
+ * Check if the Tcl_Obj has location information as a bytecode literal. We
+ * have to scan the stack up and check all bytecode frames for a possible
+ * definition.
+ */
+
+ for (framePtr = iPtr->cmdFramePtr;
+ framePtr;
+ framePtr = framePtr->nextPtr) {
+ const ByteCode* codePtr;
+ Tcl_HashEntry* hePtr;
+
+ if (framePtr->type != TCL_LOCATION_BC) continue;
+
+ codePtr = framePtr->data.tebc.codePtr;
+ hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr);
+
+ if (hePtr) {
+ ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
+ Tcl_HashEntry *hlPtr = Tcl_FindHashEntry (&eclPtr->litIndex, (char *) obj);
+
+ if (hlPtr) {
+ /*
+ * Convert from the current invoker CmdFrame to a CmdFrame
+ * refering to the actual word location. We are directly
+ * manipulating the relevant command frame in the frame stack.
+ * That is no problem because TEBC is already setting the pc
+ * for each invokation, so moving it somewhere will not affect
+ * the following commands.
+ */
+
+ ExtIndex* eiPtr = (ExtIndex*) Tcl_GetHashValue (hlPtr);
+
+ framePtr->data.tebc.pc = codePtr->codeStart + eiPtr->pc;
+ *cfPtrPtr = framePtr;
+ *wordPtr = eiPtr->word;
+ }
+ }
+ }
+}
#endif
/*
@@ -4556,46 +4781,37 @@ TclEvalObjEx(interp, objPtr, flags, invoker, word)
* complex invokations.
*/
- if ((invoker->nline <= word) || (invoker->line[word] < 0)) {
- /* Dynamic script, or dynamic context, force our own
- * context */
-
- script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
- result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
+ CmdFrame ctx = *invoker;
+ int pc = 0;
- } else {
- /* Try to get an absolute context for the evaluation
+ if (invoker->type == TCL_LOCATION_BC) {
+ /* Note: Type BC => ctx.data.eval.path is not used.
+ * ctx.data.tebc.codePtr is used instead.
*/
+ TclGetSrcInfoForPc (&ctx);
+ pc = 1;
+ }
- CmdFrame ctx = *invoker;
- int pc = 0;
+ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
- if (invoker->type == TCL_LOCATION_BC) {
- /* Note: Type BC => ctx.data.eval.path is not used.
- * ctx.data.tebc.codePtr is used instead.
- */
- TclGetSrcInfoForPc (&ctx);
- pc = 1;
- }
+ if ((ctx.nline <= word) ||
+ (ctx.line[word] < 0) ||
+ (ctx.type != TCL_LOCATION_SOURCE)) {
+ /* Dynamic script, or dynamic context, force our own
+ * context */
- if (ctx.type == TCL_LOCATION_SOURCE) {
- /* Absolute context to reuse. */
+ result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
+ } else {
+ /* Absolute context available to reuse. */
- iPtr->invokeCmdFramePtr = &ctx;
- iPtr->evalFlags |= TCL_EVAL_CTX;
+ iPtr->invokeCmdFramePtr = &ctx;
+ iPtr->evalFlags |= TCL_EVAL_CTX;
- script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
- result = EvalEx(interp, script, numSrcBytes, flags, ctx.line [word]);
+ result = EvalEx(interp, script, numSrcBytes, flags, ctx.line [word]);
- if (pc) {
- /* Death of SrcInfo reference */
- Tcl_DecrRefCount (ctx.data.eval.path);
- }
- } else {
- /* Dynamic context or script, easier to make our own as
- * well */
- script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
- result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
+ if (pc) {
+ /* Death of SrcInfo reference */
+ Tcl_DecrRefCount (ctx.data.eval.path);
}
}
}
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 6621714..1b63198 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.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: tclCmdAH.c,v 1.27.2.16 2006/11/28 22:20:00 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.27.2.17 2008/07/21 19:37:41 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -613,9 +613,12 @@ Tcl_EvalObjCmd(dummy, interp, objc, objv)
#ifndef TCL_TIP280
result = Tcl_EvalObjEx(interp, objv[1], TCL_EVAL_DIRECT);
#else
- /* TIP #280. Make invoking context available to eval'd script */
+ /* TIP #280. Make argument location available to eval'd script */
+ CmdFrame* invoker = iPtr->cmdFramePtr;
+ int word = 1;
+ TclArgumentGet (interp, objv[1], &invoker, &word);
result = TclEvalObjEx(interp, objv[1], TCL_EVAL_DIRECT,
- iPtr->cmdFramePtr,1);
+ invoker, word);
#endif
} else {
/*
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index d2cd4bb..3c83a58 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.39.2.6 2007/03/01 16:06:19 dkf Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.39.2.7 2008/07/21 19:37:42 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -62,7 +62,7 @@ AuxDataType tclForeachInfoType = {
* The return value is a standard Tcl result, which is normally TCL_OK
* unless there was an error while parsing string. If an error occurs
* then the interpreter's result contains a standard error message. If
- * complation fails because the command requires a second level of
+ * compilation fails because the command requires a second level of
* substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
* command should be compiled "out of line" by emitting code to
* invoke its command procedure (Tcl_AppendObjCmd) at runtime.
@@ -1756,7 +1756,7 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
* The return value is a standard Tcl result, which is normally TCL_OK
* unless there was an error while parsing string. If an error occurs
* then the interpreter's result contains a standard error message. If
- * complation fails because the command requires a second level of
+ * compilation fails because the command requires a second level of
* substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
* command should be compiled "out of line" by emitting code to
* invoke its command procedure (Tcl_LappendObjCmd) at runtime.
@@ -1994,7 +1994,7 @@ TclCompileLindexCmd(interp, parsePtr, envPtr)
* The return value is a standard Tcl result, which is normally TCL_OK
* unless there was an error while parsing string. If an error occurs
* then the interpreter's result contains a standard error message. If
- * complation fails because the command requires a second level of
+ * compilation fails because the command requires a second level of
* substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
* command should be compiled "out of line" by emitting code to
* invoke its command procedure (Tcl_ListObjCmd) at runtime.
@@ -2706,7 +2706,7 @@ TclCompileReturnCmd(interp, parsePtr, envPtr)
* The return value is a standard Tcl result, which is normally TCL_OK
* unless there was an error while parsing string. If an error occurs
* then the interpreter's result contains a standard error message. If
- * complation fails because the set command requires a second level of
+ * compilation fails because the set command requires a second level of
* substitutions, TCL_OUT_LINE_COMPILE is returned indicating that the
* set command should be compiled "out of line" by emitting code to
* invoke its command procedure (Tcl_SetCmd) at runtime.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 59617b0..d8e22e2 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.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: tclCompile.c,v 1.43.2.8 2007/08/24 11:22:16 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.43.2.9 2008/07/21 19:37:43 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -702,6 +702,8 @@ TclCleanupByteCode(codePtr)
if (hePtr) {
ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
int i;
+ Tcl_HashSearch hSearch;
+ Tcl_HashEntry *hlPtr;
if (eclPtr->type == TCL_LOCATION_SOURCE) {
Tcl_DecrRefCount (eclPtr->path);
@@ -714,6 +716,15 @@ TclCleanupByteCode(codePtr)
ckfree ((char*) eclPtr->loc);
}
+ /* Release index of literals as well. */
+ for (hlPtr = Tcl_FirstHashEntry(&eclPtr->litIndex, &hSearch);
+ hlPtr != NULL;
+ hlPtr = Tcl_NextHashEntry(&hSearch)) {
+ ExtIndex* eiPtr = (ExtIndex*) Tcl_GetHashValue (hlPtr);
+ ckfree((char*) eiPtr);
+ Tcl_DeleteHashEntry (hlPtr);
+ }
+ Tcl_DeleteHashTable (&eclPtr->litIndex);
ckfree ((char*) eclPtr);
Tcl_DeleteHashEntry (hePtr);
}
@@ -806,6 +817,7 @@ TclInitCompileEnv(interp, envPtr, string, numBytes, invoker, word)
envPtr->extCmdMapPtr->nloc = 0;
envPtr->extCmdMapPtr->nuloc = 0;
envPtr->extCmdMapPtr->path = NULL;
+ Tcl_InitHashTable(&envPtr->extCmdMapPtr->litIndex, TCL_ONE_WORD_KEYS);
if (invoker == NULL) {
/* Initialize the compiler for relative counting */
@@ -1241,8 +1253,25 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
cmdPtr);
}
} else {
+ /* Simple argument word of a command. We reach this if
+ * and only if the command word was not compiled for
+ * whatever reason. Register the literal's location
+ * for use by uplevel, etc. commands, should they
+ * encounter it unmodified. We care only if the we are
+ * in a context which already allows absolute
+ * counting.
+ */
+
objIndex = TclRegisterNewLiteral(envPtr,
tokenPtr[1].start, tokenPtr[1].size);
+#ifdef TCL_TIP280
+ if (eclPtr->type == TCL_LOCATION_SOURCE) {
+ TclEnterCmdWordIndex (eclPtr,
+ envPtr->literalArrayPtr[objIndex].objPtr,
+ envPtr->codeNext - envPtr->codeStart,
+ wordIdx);
+ }
+#endif
}
TclEmitPush(objIndex, envPtr);
} else {
@@ -2459,6 +2488,24 @@ EnterCmdWordData(eclPtr, srcOffset, tokenPtr, cmd, len, numWords, line, wlines)
*wlines = wwlines;
eclPtr->nuloc ++;
}
+
+void
+TclEnterCmdWordIndex (eclPtr, obj, pc, word)
+ ExtCmdLoc *eclPtr;
+ Tcl_Obj* obj;
+ int pc;
+ int word;
+{
+ int new;
+ ExtIndex* eiPtr = (ExtIndex*) ckalloc (sizeof (ExtIndex));
+
+ eiPtr->pc = pc;
+ eiPtr->word = word;
+
+ Tcl_SetHashValue (Tcl_CreateHashEntry (&eclPtr->litIndex,
+ (char*) obj, &new),
+ eiPtr);
+}
#endif
/*
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 06414fd..8192aa4 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCompile.h,v 1.33.2.2 2007/09/13 15:28:11 das Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.33.2.3 2008/07/21 19:37:43 andreas_kupries Exp $
*/
#ifndef _TCLCOMPILATION
@@ -137,7 +137,7 @@ typedef struct CmdLocation {
typedef struct ECL {
int srcOffset; /* cmd location to find the entry */
- int nline;
+ int nline; /* Number of words in the command */
int* line; /* line information for all words in the command */
} ECL;
typedef struct ExtCmdLoc {
@@ -146,7 +146,15 @@ typedef struct ExtCmdLoc {
ECL* loc; /* Command word locations (lines) */
int nloc; /* Number of allocated entries in 'loc' */
int nuloc; /* Number of used entries in 'loc' */
+ Tcl_HashTable litIndex; /* HashValue is ExtIndex* */
} ExtCmdLoc;
+typedef struct ExtIndex {
+ int pc; /* Instruction pointer of the command in ExtCmdLoc.loc[.] */
+ int word; /* Index of word in ExtCmdLoc.loc[cmd]->line[.] */
+} ExtIndex;
+
+EXTERN void TclEnterCmdWordIndex _ANSI_ARGS_((
+ ExtCmdLoc *eclPtr, Tcl_Obj* obj, int pc, int word));
#endif
/*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 76544c0..18f1c70 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -13,7 +13,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.118.2.30 2007/09/13 15:28:13 das Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.118.2.31 2008/07/21 19:37:43 andreas_kupries Exp $
*/
#ifndef _TCLINT
@@ -910,7 +910,13 @@ typedef struct CmdFrame {
#define TCL_LOCATION_PROC (5) /* Location in a dynamic proc */
#define TCL_LOCATION_LAST (6) /* Number of values in the enum */
-#endif
+
+typedef struct CFWord {
+ CmdFrame* framePtr; /* CmdFrame to acess */
+ int word; /* Index of the word in the command */
+ int refCount; /* #times the word is on the stack */
+} CFWord;
+#endif /* TCL_TIP280 */
/*
*----------------------------------------------------------------
@@ -1488,13 +1494,34 @@ typedef struct Interp {
* location information for its
* body. It is keyed by the address of
* the Proc structure for a procedure.
+ * The values are "struct CmdFrame*".
*/
Tcl_HashTable* lineBCPtr;
/* This table remembers for each
* ByteCode object the location
* information for its body. It is
* keyed by the address of the Proc
- * structure for a procedure.
+ * structure for a procedure. The
+ * values are "struct ExtCmdLoc*" (See
+ * tclCompile.h).
+ */
+ Tcl_HashTable* lineLAPtr;
+ /* This table remembers for each
+ * argument of a command on the
+ * execution stack the index of the
+ * argument in the command, and the
+ * location data of the command. It is
+ * keyed by the address of the Tcl_Obj
+ * containing the argument. The values
+ * are "struct CFWord*" (See
+ * tclBasic.c). This allows commands
+ * like uplevel, eval, etc. to find
+ * location information for their
+ * arguments, if they are a proper
+ * literal argument to an invoking
+ * command. Alt view: An index to the
+ * CmdFrame stack keyed by command
+ * argument holders.
*/
#endif
#ifdef TCL_TIP268
@@ -1826,6 +1853,14 @@ EXTERN int TclEvalObjEx _ANSI_ARGS_((Tcl_Interp *interp,
int flags,
CONST CmdFrame* invoker,
int word));
+
+EXTERN void TclArgumentEnter _ANSI_ARGS_((Tcl_Interp* interp,
+ Tcl_Obj* objv[], int objc, CmdFrame* cf));
+EXTERN void TclArgumentRelease _ANSI_ARGS_((Tcl_Interp* interp,
+ Tcl_Obj* objv[], int objc));
+
+EXTERN void TclArgumentGet _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj* obj,
+ CmdFrame** cfPtrPtr, int* wordPtr));
#endif
EXTERN void TclExpandTokenArray _ANSI_ARGS_((
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index bd2db56..88438d7 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInterp.c,v 1.20.2.4 2008/01/30 10:46:56 msofer Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.20.2.5 2008/07/21 19:37:43 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -2094,9 +2094,12 @@ SlaveEval(interp, slaveInterp, objc, objv)
#ifndef TCL_TIP280
result = Tcl_EvalObjEx(slaveInterp, objv[0], 0);
#else
- /* TIP #280 : Make invoker available to eval'd script */
- Interp* iPtr = (Interp*) interp;
- result = TclEvalObjEx(slaveInterp, objv[0], 0, iPtr->cmdFramePtr,0);
+ /* TIP #280 : Make actual argument location available to eval'd script */
+ Interp* iPtr = (Interp*) interp;
+ CmdFrame* invoker = iPtr->cmdFramePtr;
+ int word = 0;
+ TclArgumentGet (interp, objv[0], &invoker, &word);
+ result = TclEvalObjEx(slaveInterp, objv[0], 0, invoker, word);
#endif
} else {
objPtr = Tcl_ConcatObj(objc, objv);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 8f42df6..07e5ea6 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -19,7 +19,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.31.2.14 2007/05/15 18:32:18 dgp Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.31.2.15 2008/07/21 19:37:44 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -3006,9 +3006,12 @@ NamespaceEvalCmd(dummy, interp, objc, objv)
#ifndef TCL_TIP280
result = Tcl_EvalObjEx(interp, objv[3], 0);
#else
- /* TIP #280 : Make invoker available to eval'd script */
- Interp* iPtr = (Interp*) interp;
- result = TclEvalObjEx(interp, objv[3], 0, iPtr->cmdFramePtr,3);
+ /* TIP #280 : Make actual argument location available to eval'd script */
+ Interp* iPtr = (Interp*) interp;
+ CmdFrame* invoker = iPtr->cmdFramePtr;
+ int word = 3;
+ TclArgumentGet (interp, objv[3], &invoker, &word);
+ result = TclEvalObjEx(interp, objv[3], 0, invoker, word);
#endif
} else {
/*
diff --git a/generic/tclProc.c b/generic/tclProc.c