summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCkalloc.c68
-rw-r--r--generic/tclHash.c34
-rw-r--r--generic/tclProc.c126
3 files changed, 115 insertions, 113 deletions
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index ab51f85..1ec77d9 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -1,4 +1,4 @@
-/*
+/*
* tclCkalloc.c --
*
* Interface to malloc and free that provides support for debugging problems
@@ -13,7 +13,7 @@
*
* This code contributed by Karl Lehenbauer and Mark Diekhans
*
- * RCS: @(#) $Id: tclCkalloc.c,v 1.19.2.1 2009/09/28 21:20:51 dgp Exp $
+ * RCS: @(#) $Id: tclCkalloc.c,v 1.19.2.2 2011/01/25 15:57:09 nijtmans Exp $
*/
#include "tclInt.h"
@@ -103,7 +103,7 @@ static int init_malloced_bodies = TRUE;
#endif
/*
- * The following variable indicates to TclFinalizeMemorySubsystem()
+ * The following variable indicates to TclFinalizeMemorySubsystem()
* that it should dump out the state of memory before exiting. If the
* value is non-NULL, it gives the name of the file in which to
* dump memory usage information.
@@ -146,7 +146,7 @@ static void ValidateMemory _ANSI_ARGS_((
*----------------------------------------------------------------------
*/
void
-TclInitDbCkalloc()
+TclInitDbCkalloc()
{
if (!ckallocInit) {
ckallocInit = 1;
@@ -163,20 +163,20 @@ TclInitDbCkalloc()
*----------------------------------------------------------------------
*/
void
-TclDumpMemoryInfo(outFile)
+TclDumpMemoryInfo(outFile)
FILE *outFile;
{
- fprintf(outFile,"total mallocs %10d\n",
+ fprintf(outFile,"total mallocs %10d\n",
total_mallocs);
- fprintf(outFile,"total frees %10d\n",
+ fprintf(outFile,"total frees %10d\n",
total_frees);
- fprintf(outFile,"current packets allocated %10d\n",
+ fprintf(outFile,"current packets allocated %10d\n",
current_malloc_packets);
- fprintf(outFile,"current bytes allocated %10d\n",
+ fprintf(outFile,"current bytes allocated %10d\n",
current_bytes_malloced);
- fprintf(outFile,"maximum packets allocated %10d\n",
+ fprintf(outFile,"maximum packets allocated %10d\n",
maximum_malloc_packets);
- fprintf(outFile,"maximum bytes allocated %10d\n",
+ fprintf(outFile,"maximum bytes allocated %10d\n",
maximum_bytes_malloced);
}
@@ -213,7 +213,7 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
int idx;
int guard_failed = FALSE;
int byte;
-
+
for (idx = 0; idx < LOW_GUARD_SIZE; idx++) {
byte = *(memHeaderP->low_guard + idx);
if (byte != GUARD_VALUE) {
@@ -258,8 +258,8 @@ ValidateMemory(memHeaderP, file, line, nukeGuards)
}
if (nukeGuards) {
- memset ((char *) memHeaderP->low_guard, 0, LOW_GUARD_SIZE);
- memset ((char *) hiPtr, 0, HIGH_GUARD_SIZE);
+ memset ((char *) memHeaderP->low_guard, 0, LOW_GUARD_SIZE);
+ memset ((char *) hiPtr, 0, HIGH_GUARD_SIZE);
}
}
@@ -305,7 +305,7 @@ Tcl_ValidateAllMemory (file, line)
* information will be written to stderr.
*
* Results:
- * Return TCL_ERROR if an error accessing the file occurs, `errno'
+ * Return TCL_ERROR if an error accessing the file occurs, `errno'
* will have the file error number left in it.
*----------------------------------------------------------------------
*/
@@ -350,7 +350,7 @@ Tcl_DumpActiveMemory (fileName)
* Tcl_DbCkalloc - debugging ckalloc
*
* Allocate the requested amount of space plus some extra for
- * guard bands at both ends of the request, plus a size, panicing
+ * guard bands at both ends of the request, plus a size, panicing
* if there isn't enough space, then write in the guard bands
* and return the address of the space in the middle that the
* user asked for.
@@ -376,7 +376,7 @@ Tcl_DbCkalloc(size, file, line)
/* Don't let size argument to TclpAlloc overflow */
if (size <= UINT_MAX - HIGH_GUARD_SIZE - sizeof(struct mem_header)) {
- result = (struct mem_header *) TclpAlloc((unsigned)size +
+ result = (struct mem_header *) TclpAlloc((unsigned)size +
sizeof(struct mem_header) + HIGH_GUARD_SIZE);
}
if (result == NULL) {
@@ -432,7 +432,7 @@ Tcl_DbCkalloc(size, file, line)
if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
break_on_malloc = 0;
(void) fflush(stdout);
- fprintf(stderr,"reached malloc break limit (%d)\n",
+ fprintf(stderr,"reached malloc break limit (%d)\n",
total_mallocs);
fprintf(stderr, "program will now enter C debugger\n");
(void) fflush(stderr);
@@ -464,7 +464,7 @@ Tcl_AttemptDbCkalloc(size, file, line)
/* Don't let size argument to TclpAlloc overflow */
if (size <= UINT_MAX - HIGH_GUARD_SIZE - sizeof(struct mem_header)) {
- result = (struct mem_header *) TclpAlloc((unsigned)size +
+ result = (struct mem_header *) TclpAlloc((unsigned)size +
sizeof(struct mem_header) + HIGH_GUARD_SIZE);
}
if (result == NULL) {
@@ -520,7 +520,7 @@ Tcl_AttemptDbCkalloc(size, file, line)
if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
break_on_malloc = 0;
(void) fflush(stdout);
- fprintf(stderr,"reached malloc break limit (%d)\n",
+ fprintf(stderr,"reached malloc break limit (%d)\n",
total_mallocs);
fprintf(stderr, "program will now enter C debugger\n");
(void) fflush(stderr);
@@ -793,6 +793,7 @@ MemoryCmd (clientData, interp, argc, argv)
CONST char *fileName;
Tcl_DString buffer;
int result;
+ size_t len;
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
@@ -813,7 +814,7 @@ MemoryCmd (clientData, interp, argc, argv)
result = Tcl_DumpActiveMemory (fileName);
Tcl_DStringFree(&buffer);
if (result != TCL_OK) {
- Tcl_AppendResult(interp, "error accessing ", argv[2],
+ Tcl_AppendResult(interp, "error accessing ", argv[2],
(char *) NULL);
return TCL_ERROR;
}
@@ -870,9 +871,10 @@ MemoryCmd (clientData, interp, argc, argv)
if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
TclpFree((char *) curTagPtr);
}
- curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(strlen(argv[2])));
+ len = strlen(argv[2]);
+ curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len));
curTagPtr->refCount = 0;
- strcpy(curTagPtr->string, argv[2]);
+ memcpy(curTagPtr->string, argv[2], len + 1);
return TCL_OK;
}
if (strcmp(argv[1],"trace") == 0) {
@@ -974,7 +976,7 @@ Tcl_InitMemory(interp)
Tcl_Interp *interp; /* Interpreter in which commands should be added */
{
TclInitDbCkalloc();
- Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData) NULL,
+ Tcl_CreateCommand (interp, "memory", MemoryCmd, (ClientData) NULL,
(Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0,
(Tcl_CmdDeleteProc *) NULL);
@@ -1076,7 +1078,7 @@ Tcl_AttemptDbCkalloc(size, file, line)
*----------------------------------------------------------------------
*
* Tcl_Realloc --
- * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does
+ * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does
* check that memory was actually allocated.
*
*----------------------------------------------------------------------
@@ -1119,7 +1121,7 @@ Tcl_DbCkrealloc(ptr, size, file, line)
*----------------------------------------------------------------------
*
* Tcl_AttemptRealloc --
- * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does
+ * Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does
* not check that memory was actually allocated.
*
*----------------------------------------------------------------------
@@ -1154,7 +1156,7 @@ Tcl_AttemptDbCkrealloc(ptr, size, file, line)
*
* Tcl_Free --
* Interface to TclpFree when TCL_MEM_DEBUG is disabled. Done here
- * rather in the macro to keep some modules from being compiled with
+ * rather in the macro to keep some modules from being compiled with
* TCL_MEM_DEBUG enabled and some with it disabled.
*
*----------------------------------------------------------------------
@@ -1181,7 +1183,7 @@ Tcl_DbCkfree(ptr, file, line)
*----------------------------------------------------------------------
*
* Tcl_InitMemory --
- * Dummy initialization for memory command, which is only available
+ * Dummy initialization for memory command, which is only available
* if TCL_MEM_DEBUG is on.
*
*----------------------------------------------------------------------
@@ -1208,7 +1210,7 @@ Tcl_ValidateAllMemory(file, line)
}
void
-TclDumpMemoryInfo(outFile)
+TclDumpMemoryInfo(outFile)
FILE *outFile;
{
}
@@ -1220,16 +1222,16 @@ TclDumpMemoryInfo(outFile)
*
* TclFinalizeMemorySubsystem --
*
- * This procedure is called to finalize all the structures that
+ * This procedure is called to finalize all the structures that
* are used by the memory allocator on a per-process basis.
*
* Results:
* None.
*
* Side effects:
- * This subsystem is self-initializing, since memory can be
+ * This subsystem is self-initializing, since memory can be
* allocated before Tcl is formally initialized. After this call,
- * this subsystem has been reset to its initial state and is
+ * this subsystem has been reset to its initial state and is
* usable again.
*
*---------------------------------------------------------------------------
@@ -1254,6 +1256,6 @@ TclFinalizeMemorySubsystem()
#endif
#if USE_TCLALLOC
- TclFinalizeAllocSubsystem();
+ TclFinalizeAllocSubsystem();
#endif
}
diff --git a/generic/tclHash.c b/generic/tclHash.c
index ae2eca8..9ae23e3 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -1,4 +1,4 @@
-/*
+/*
* tclHash.c --
*
* Implementation of in-memory hash tables for Tcl and Tcl-based
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclHash.c,v 1.12.2.1 2004/11/11 01:18:07 das Exp $
+ * RCS: @(#) $Id: tclHash.c,v 1.12.2.2 2011/01/25 15:57:09 nijtmans Exp $
*/
#include "tclInt.h"
@@ -191,11 +191,11 @@ Tcl_InitCustomHashTable(tablePtr, keyType, typePtr)
Tcl_HashKeyType *typePtr; /* Pointer to structure which defines
* the behaviour of this table. */
{
-#if (TCL_SMALL_HASH_TABLE != 4)
+#if (TCL_SMALL_HASH_TABLE != 4)
panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
TCL_SMALL_HASH_TABLE);
#endif
-
+
tablePtr->buckets = tablePtr->staticBuckets;
tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
@@ -341,7 +341,7 @@ Tcl_FindHashEntry(tablePtr, key)
}
}
}
-
+
return NULL;
}
@@ -454,7 +454,7 @@ Tcl_CreateHashEntry(tablePtr, key, newPtr)
hPtr = (Tcl_HashEntry *) ckalloc((unsigned) sizeof(Tcl_HashEntry));
hPtr->key.oneWordValue = (char *) key;
}
-
+
hPtr->tablePtr = tablePtr;
#if TCL_HASH_KEY_STORE_HASH
# if TCL_PRESERVE_BINARY_COMPATABILITY
@@ -530,7 +530,7 @@ Tcl_DeleteHashEntry(entryPtr)
#else
typePtr = tablePtr->typePtr;
#endif
-
+
#if TCL_HASH_KEY_STORE_HASH
if (typePtr->hashKeyProc == NULL
|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
@@ -543,7 +543,7 @@ Tcl_DeleteHashEntry(entryPtr)
#else
bucketPtr = entryPtr->bucketPtr;
#endif
-
+
if (*bucketPtr == entryPtr) {
*bucketPtr = entryPtr->nextPtr;
} else {
@@ -820,12 +820,12 @@ AllocArrayEntry(tablePtr, keyPtr)
unsigned int size;
count = tablePtr->keyType;
-
+
size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key);
if (size < sizeof(Tcl_HashEntry))
size = sizeof(Tcl_HashEntry);
hPtr = (Tcl_HashEntry *) ckalloc(size);
-
+
for (iPtr1 = array, iPtr2 = hPtr->key.words;
count > 0; count--, iPtr1++, iPtr2++) {
*iPtr2 = *iPtr1;
@@ -929,14 +929,14 @@ AllocStringEntry(tablePtr, keyPtr)
{
CONST char *string = (CONST char *) keyPtr;
Tcl_HashEntry *hPtr;
- unsigned int size;
-
- size = sizeof(Tcl_HashEntry) + strlen(string) + 1 - sizeof(hPtr->key);
- if (size < sizeof(Tcl_HashEntry))
- size = sizeof(Tcl_HashEntry);
- hPtr = (Tcl_HashEntry *) ckalloc(size);
- strcpy(hPtr->key.string, string);
+ unsigned int size, allocsize;
+ allocsize = size = strlen(string) + 1;
+ if (size < sizeof(hPtr->key)) {
+ allocsize = sizeof(hPtr->key);
+ }
+ hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key));
+ memcpy(hPtr->key.string, string, size);
return hPtr;
}
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 8ceb184..ce3b3b7 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -1,4 +1,4 @@
-/*
+/*
* tclProc.c --
*
* This file contains routines that implement Tcl procedures,
@@ -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.44.2.11 2009/08/25 20:59:11 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.44.2.12 2011/01/25 15:57:09 nijtmans Exp $
*/
#include "tclInt.h"
@@ -52,7 +52,7 @@ Tcl_ObjType tclProcBodyType = {
*
* Tcl_ProcObjCmd --
*
- * This object-based procedure is invoked to process the "proc" Tcl
+ * This object-based procedure is invoked to process the "proc" Tcl
* command. See the user documentation for details on what it does.
*
* Results:
@@ -90,7 +90,7 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
* the command name includes namespace qualifiers, this will be the
* current namespace.
*/
-
+
fullName = TclGetString(objv[1]);
TclGetNamespaceForQualName(interp, fullName, (Namespace *) NULL,
0, &nsPtr, &altNsPtr, &cxtNsPtr, &procName);
@@ -137,7 +137,7 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
Tcl_DStringAppend(&ds, "::", 2);
}
Tcl_DStringAppend(&ds, procName, -1);
-
+
Tcl_CreateCommand(interp, Tcl_DStringValue(&ds), TclProcInterpProc,
(ClientData) procPtr, TclProcDeleteProc);
cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
@@ -150,7 +150,7 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
* procedure will run in. This will be different than the current
* namespace if the proc was renamed into a different namespace.
*/
-
+
procPtr->cmdPtr = (Command *) cmd;
#ifdef TCL_TIP280
@@ -237,14 +237,14 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
* procbody), and the argument list is just "args" and the body is empty,
* define a compileProc to compile a noop.
*
- * Notes:
+ * Notes:
* - cannot be done for any argument list without having different
- * compiled/not-compiled behaviour in the "wrong argument #" case,
- * or making this code much more complicated. In any case, it doesn't
- * seem to make a lot of sense to verify the number of arguments we
+ * compiled/not-compiled behaviour in the "wrong argument #" case,
+ * or making this code much more complicated. In any case, it doesn't
+ * seem to make a lot of sense to verify the number of arguments we
* are about to ignore ...
- * - could be enhanced to handle also non-empty bodies that contain
- * only comments; however, parsing the body will slow down the
+ * - could be enhanced to handle also non-empty bodies that contain
+ * only comments; however, parsing the body will slow down the
* compilation of all procs whose argument list is just _args_ */
if (objv[3]->typePtr == &tclProcBodyType) {
@@ -252,11 +252,11 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
}
procArgs = Tcl_GetString(objv[2]);
-
+
while (*procArgs == ' ') {
procArgs++;
}
-
+
if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) {
procArgs +=4;
while(*procArgs != '\0') {
@@ -264,24 +264,24 @@ Tcl_ProcObjCmd(dummy, interp, objc, objv)
goto done;
}
procArgs++;
- }
-
- /*
+ }
+
+ /*
* The argument list is just "args"; check the body
*/
-
+
procBody = Tcl_GetString(objv[3]);
while (*procBody != '\0') {
if (!isspace(UCHAR(*procBody))) {
goto done;
}
procBody++;
- }
-
- /*
+ }
+
+ /*
* The body is just spaces: link the compileProc
*/
-
+
((Command *) cmd)->compileProc = TclCompileNoOp;
}
@@ -330,7 +330,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
register CompiledLocal *localPtr = NULL;
Tcl_Obj *defPtr;
int precompiled = 0;
-
+
if (bodyPtr->typePtr == &tclProcBodyType) {
/*
* Because the body is a TclProProcBody, the actual body is already
@@ -345,7 +345,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
* since the command (soon to be created) will be holding a reference
* to it.
*/
-
+
procPtr = (Proc *) bodyPtr->internalRep.otherValuePtr;
procPtr->iPtr = iPtr;
procPtr->refCount++;
@@ -389,7 +389,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
* body object since there will be a reference to it in the Proc
* structure.
*/
-
+
Tcl_IncrRefCount(bodyPtr);
procPtr = (Proc *) ckalloc(sizeof(Proc));
@@ -401,7 +401,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
procPtr->firstLocalPtr = NULL;
procPtr->lastLocalPtr = NULL;
}
-
+
/*
* Break up the argument list into argument specifiers, then process
* each argument specifier.
@@ -459,7 +459,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
"\" has argument with no name", (char *) NULL);
goto procError;
}
-
+
nameLength = strlen(fieldValues[0]);
if (fieldCount == 2) {
valueLength = strlen(fieldValues[1]);
@@ -553,10 +553,10 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
} else {
/*
* Allocate an entry in the runtime procedure frame's array of
- * local variables for the argument.
+ * local variables for the argument.
*/
- localPtr = (CompiledLocal *) ckalloc((unsigned)
+ localPtr = (CompiledLocal *) ckalloc((unsigned)
(sizeof(CompiledLocal) - sizeof(localPtr->name)
+ nameLength+1));
if (procPtr->firstLocalPtr == NULL) {
@@ -570,7 +570,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
localPtr->frameIndex = i;
localPtr->flags = VAR_SCALAR | VAR_ARGUMENT;
localPtr->resolveInfo = NULL;
-
+
if (fieldCount == 2) {
localPtr->defValuePtr =
Tcl_NewStringObj(fieldValues[1], valueLength);
@@ -578,7 +578,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
} else {
localPtr->defValuePtr = NULL;
}
- strcpy(localPtr->name, fieldValues[0]);
+ memcpy(localPtr->name, fieldValues[0], nameLength + 1);
}
ckfree((char *) fieldValues);
@@ -590,7 +590,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
* procedure will run in. This will be different than the current
* namespace if the proc was renamed into a different namespace.
*/
-
+
*procPtrPtr = procPtr;
ckfree((char *) argArray);
return TCL_OK;
@@ -603,12 +603,12 @@ procError:
while (procPtr->firstLocalPtr != NULL) {
localPtr = procPtr->firstLocalPtr;
procPtr->firstLocalPtr = localPtr->nextPtr;
-
+
defPtr = localPtr->defValuePtr;
if (defPtr != NULL) {
Tcl_DecrRefCount(defPtr);
}
-
+
ckfree((char *) localPtr);
}
ckfree((char *) procPtr);
@@ -832,7 +832,7 @@ TclFindProc(iPtr, procName)
Tcl_Command cmd;
Tcl_Command origCmd;
Command *cmdPtr;
-
+
cmd = Tcl_FindCommand((Tcl_Interp *) iPtr, procName,
(Tcl_Namespace *) NULL, /*flags*/ 0);
if (cmd == (Tcl_Command) NULL) {
@@ -949,10 +949,10 @@ TclProcInterpProc(clientData, interp, argc, argv)
result = TclObjInterpProc(clientData, interp, argc, objv);
/*
- * Move the interpreter's object result to the string result,
+ * Move the interpreter's object result to the string result,
* then reset the object result.
*/
-
+
Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
TCL_VOLATILE);
@@ -965,7 +965,7 @@ TclProcInterpProc(clientData, interp, argc, argv)
objPtr = objv[i];
TclDecrRefCount(objPtr);
}
-
+
/*
* Free the objv array if malloc'ed storage was used.
*/
@@ -982,7 +982,7 @@ TclProcInterpProc(clientData, interp, argc, argv)
*
* TclObjInterpProc --
*
- * When a Tcl procedure gets invoked during bytecode evaluation, this
+ * When a Tcl procedure gets invoked during bytecode evaluation, this
* object-based routine gets invoked to interpret the procedure.
*
* Results:
@@ -1027,7 +1027,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
/*
* Get the procedure's name.
*/
-
+
procName = Tcl_GetStringFromObj(objv[0], &nameLen);
/*
@@ -1040,7 +1040,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
result = ProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
"body of proc", procName, &procPtr);
-
+
if (result != TCL_OK) {
return result;
}
@@ -1055,7 +1055,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
if (localCt > NUM_LOCALS) {
compiledLocals = (Var *) ckalloc((unsigned) localCt * sizeof(Var));
}
-
+
/*
* Set up and push a new call frame for the new procedure invocation.
* This call frame will execute in the proc's namespace, which might
@@ -1154,7 +1154,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
/*
* Quote the proc name if it contains spaces (Bug 942757).
*/
-
+
len = Tcl_ScanCountedElement(procName, nameLen, &flags);
if (len != nameLen) {
char *procName1 = ckalloc((unsigned) len);
@@ -1235,7 +1235,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
if (result != TCL_OK) {
result = ProcessProcResultCode(interp, procName, nameLen, result);
}
-
+
if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
Tcl_Obj *r;
@@ -1248,7 +1248,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
* Pop and free the call frame for this procedure invocation, then
* free the compiledLocals array if malloc'ed storage was used.
*/
-
+
procDone:
Tcl_PopCallFrame(interp);
if (compiledLocals != localStorage) {
@@ -1278,7 +1278,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
*
*----------------------------------------------------------------------
*/
-
+
int
TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
Tcl_Interp *interp; /* Interpreter containing procedure. */
@@ -1314,7 +1314,7 @@ ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
Tcl_CallFrame frame;
ByteCode *codePtr = (ByteCode *) bodyPtr->internalRep.otherValuePtr;
CompiledLocal *localPtr;
-
+
/*
* If necessary, compile the procedure's body. The compiler will
* allocate frame slots for the procedure's non-argument local
@@ -1328,7 +1328,7 @@ ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
* Precompiled procedure bodies, however, are immutable and therefore
* they are not recompiled, even if things have changed.
*/
-
+
if (bodyPtr->typePtr == &tclByteCodeType) {
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
@@ -1350,14 +1350,14 @@ ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
if (bodyPtr->typePtr != &tclByteCodeType) {
int numChars;
char *ellipsis;
-
+
#ifdef TCL_COMPILE_DEBUG
if (tclTraceCompile >= 1) {
/*
* Display a line summarizing the top level command we
* are about to compile.
*/
-
+
numChars = strlen(procName);
ellipsis = "";
if (numChars > 50) {
@@ -1368,7 +1368,7 @@ ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
description, numChars, procName, ellipsis);
}
#endif
-
+
/*
* Plug the current procPtr into the interpreter and coerce
* the code body to byte codes. The interpreter needs to
@@ -1417,7 +1417,7 @@ ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
Tcl_IncrRefCount(copy->defValuePtr);
}
copy->resolveInfo = localPtr->resolveInfo;
- strcpy(copy->name, localPtr->name);
+ memcpy(copy->name, localPtr->name, localPtr->nameLength + 1);
}
@@ -1438,10 +1438,10 @@ ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
*procPtrPtr = procPtr = new;
}
iPtr->compiledProcPtr = procPtr;
-
+
result = Tcl_PushCallFrame(interp, &frame,
(Tcl_Namespace*)nsPtr, /* isProcCallFrame */ 0);
-
+
if (result == TCL_OK) {
#ifdef TCL_TIP280
/* TIP #280. We get the invoking context from the cmdFrame
@@ -1463,7 +1463,7 @@ ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
#endif
Tcl_PopCallFrame(interp);
}
-
+
if (result != TCL_OK) {
if (result == TCL_ERROR) {
char buf[100 + TCL_INTEGER_SPACE];
@@ -1490,7 +1490,7 @@ ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
return result;
}
} else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
-
+
/*
* The resolver epoch has changed, but we only need to invalidate
* the resolver cache.
@@ -1554,10 +1554,10 @@ ProcessProcResultCode(interp, procName, nameLen, returnCode)
}
if (returnCode == TCL_RETURN) {
return TclUpdateReturnInfo(iPtr);
- }
+ }
if (returnCode != TCL_ERROR) {
Tcl_ResetResult(interp);
- Tcl_AppendToObj(Tcl_GetObjResult(interp), ((returnCode == TCL_BREAK)
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), ((returnCode == TCL_BREAK)
? "invoked \"break\" outside of a loop"
: "invoked \"continue\" outside of a loop"), -1);
}
@@ -1820,7 +1820,7 @@ TclNewProcBodyObj(procPtr)
if (!procPtr) {
return (Tcl_Obj *) NULL;
}
-
+
objPtr = Tcl_NewStringObj("", 0);
if (objPtr) {
@@ -1856,7 +1856,7 @@ static void ProcBodyDup(srcPtr, dupPtr)
Tcl_Obj *dupPtr; /* target object for the duplication */
{
Proc *procPtr = (Proc *) srcPtr->internalRep.otherValuePtr;
-
+
dupPtr->typePtr = &tclProcBodyType;
dupPtr->internalRep.otherValuePtr = (VOID *) procPtr;
procPtr->refCount++;
@@ -1919,7 +1919,7 @@ ProcBodySetFromAny(interp, objPtr)
/*
* this to keep compilers happy.
*/
-
+
return TCL_OK;
}
@@ -1980,14 +1980,14 @@ TclCompileNoOp(interp, parsePtr, envPtr)
tokenPtr = tokenPtr + tokenPtr->numComponents + 1;
envPtr->currStackDepth = savedStackDepth;
- if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
+ if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
code = TclCompileTokens(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
return code;
}
TclEmitOpcode(INST_POP, envPtr);
- }
+ }
}
envPtr->currStackDepth = savedStackDepth;
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
generated by cgit v0.12 at 2024-11-05 06:08:24 (GMT)