summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2024-05-27 20:23:37 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2024-05-27 20:23:37 (GMT)
commit1f059c4f281d63894b3daf5e67a0b5166ed2e491 (patch)
treef816002f78e3069ee3ea3ceb425f57dc3a60ed35 /generic
parent15ebf19a871e197a6f6a17427e865b4ecd785eb3 (diff)
downloadtcl-1f059c4f281d63894b3daf5e67a0b5166ed2e491.zip
tcl-1f059c4f281d63894b3daf5e67a0b5166ed2e491.tar.gz
tcl-1f059c4f281d63894b3daf5e67a0b5166ed2e491.tar.bz2
Eliminate TclPrintByteCodeObj()'s 'interp' argument, which is not used
Diffstat (limited to 'generic')
-rw-r--r--generic/tclAssembly.c66
-rw-r--r--generic/tclCompile.c16
-rw-r--r--generic/tclCompile.h5
-rw-r--r--generic/tclDisassemble.c76
-rw-r--r--generic/tclExecute.c57
5 files changed, 99 insertions, 121 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index fa59db0..a871f05 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -6,8 +6,8 @@
* This file contains the procedures that convert Tcl Assembly Language (TAL)
* to a sequence of bytecode instructions for the Tcl execution engine.
*
- * Copyright (c) 2010 by Ozgur Dogan Ugurlu.
- * Copyright (c) 2010 by Kevin B. Kenny.
+ * Copyright (c) 2010 Ozgur Dogan Ugurlu.
+ * Copyright (c) 2010 Kevin B. Kenny.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -271,15 +271,14 @@ static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*,
const TalInstDesc*);
static int DefineLabel(AssemblyEnv* envPtr, const char* label);
static void DeleteMirrorJumpTable(JumptableInfo* jtPtr);
-static void DupAssembleCodeInternalRep(Tcl_Obj* src,
- Tcl_Obj* dest);
+static Tcl_DupInternalRepProc DupAssembleCodeInternalRep;
static void FillInJumpOffsets(AssemblyEnv*);
static int CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
Tcl_Obj* jumpTable);
static int FindLocalVar(AssemblyEnv* envPtr,
Tcl_Token** tokenPtrPtr);
static int FinishAssembly(AssemblyEnv*);
-static void FreeAssembleCodeInternalRep(Tcl_Obj *objPtr);
+static Tcl_FreeInternalRepProc FreeAssembleCodeInternalRep;
static void FreeAssemblyEnv(AssemblyEnv*);
static int GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*);
static int GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*);
@@ -759,7 +758,7 @@ BBEmitInst1or4(
int
Tcl_AssembleObjCmd(
- ClientData dummy, /* Not used. */
+ void *clientData, /* clientData */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -769,12 +768,12 @@ Tcl_AssembleObjCmd(
* because there needs to be one in place to execute bytecode.
*/
- return Tcl_NRCallObjProc(interp, TclNRAssembleObjCmd, dummy, objc, objv);
+ return Tcl_NRCallObjProc(interp, TclNRAssembleObjCmd, clientData, objc, objv);
}
int
TclNRAssembleObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -912,12 +911,7 @@ CompileAssembleObj(
* Report on what the assembler did.
*/
-#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile >= 2) {
- TclPrintByteCodeObj(interp, objPtr);
- fflush(stdout);
- }
-#endif /* TCL_COMPILE_DEBUG */
+ TclDebugPrintByteCodeObj(objPtr);
return codePtr;
}
@@ -1257,7 +1251,7 @@ AssembleOneLine(
Tcl_Obj* instNameObj; /* Name of the instruction */
int tblIdx; /* Index in TalInstructionTable of the
* instruction */
- enum TalInstType instType; /* Type of the instruction */
+ TalInstType instType; /* Type of the instruction */
Tcl_Obj* operand1Obj = NULL;
/* First operand to the instruction */
const char* operand1; /* String rep of the operand */
@@ -1377,7 +1371,7 @@ AssembleOneLine(
if (opnd < 0 || opnd > 3) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("operand must be [0..3]", -1));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND<0,>3", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND<0,>3", (char *)NULL);
goto cleanup;
}
BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd);
@@ -1617,7 +1611,7 @@ AssembleOneLine(
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("operand must be >=2", -1));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", (char *)NULL);
}
goto cleanup;
}
@@ -1983,7 +1977,7 @@ CreateMirrorJumpTable(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"jump table must have an even number of list elements",
-1));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLE", (char *)NULL);
}
return TCL_ERROR;
}
@@ -2011,7 +2005,7 @@ CreateMirrorJumpTable(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"duplicate entry in jump table for \"%s\"",
TclGetString(objv[i])));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY", (char *)NULL);
DeleteMirrorJumpTable(jtPtr);
return TCL_ERROR;
}
@@ -2096,7 +2090,7 @@ GetNextOperand(
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"assembly code may not contain substitutions", -1));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOSUBST", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOSUBST", (char *)NULL);
}
return TCL_ERROR;
}
@@ -2319,7 +2313,7 @@ FindLocalVar(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot use this instruction to create a variable"
" in a non-proc context", -1));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", (char *)NULL);
}
return -1;
}
@@ -2354,7 +2348,7 @@ CheckNamespaceQualifiers(
if ((*p == ':') && (p[1] == ':')) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"variable \"%s\" is not local", name));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, (char *)NULL);
return TCL_ERROR;
}
}
@@ -2390,7 +2384,7 @@ CheckOneByte(
if (value < 0 || value > 0xFF) {
result = Tcl_NewStringObj("operand does not fit in one byte", -1);
Tcl_SetObjResult(interp, result);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", (char *)NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -2425,7 +2419,7 @@ CheckSignedOneByte(
if (value > 0x7F || value < -0x80) {
result = Tcl_NewStringObj("operand does not fit in one byte", -1);
Tcl_SetObjResult(interp, result);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", (char *)NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -2458,7 +2452,7 @@ CheckNonNegative(
if (value < 0) {
result = Tcl_NewStringObj("operand must be nonnegative", -1);
Tcl_SetObjResult(interp, result);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONNEGATIVE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONNEGATIVE", (char *)NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -2491,7 +2485,7 @@ CheckStrictlyPositive(
if (value <= 0) {
result = Tcl_NewStringObj("operand must be positive", -1);
Tcl_SetObjResult(interp, result);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "POSITIVE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "POSITIVE", (char *)NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -2543,7 +2537,7 @@ DefineLabel(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"duplicate definition of label \"%s\"", labelName));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL", labelName,
- NULL);
+ (char *)NULL);
}
return TCL_ERROR;
}
@@ -2944,7 +2938,7 @@ ReportUndefinedLabel(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"undefined label \"%s\"", TclGetString(jumpTarget)));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL",
- TclGetString(jumpTarget), NULL);
+ TclGetString(jumpTarget), (char *)NULL);
Tcl_SetErrorLine(interp, bbPtr->jumpLine);
}
}
@@ -3229,7 +3223,7 @@ CheckNonThrowingBlock(
"a context where an exception has been "
"caught and not disposed of.",
tclInstructionTable[opcode].name));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", (char *)NULL);
AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
}
return TCL_ERROR;
@@ -3409,7 +3403,7 @@ StackCheckBasicBlock(
*/
Tcl_SetErrorLine(interp, blockPtr->startLine);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", (char *)NULL);
}
return TCL_ERROR;
}
@@ -3432,7 +3426,7 @@ StackCheckBasicBlock(
if (initialStackDepth + blockPtr->minStackDepth < 0) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("stack underflow", -1));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", (char *)NULL);
AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
Tcl_SetErrorLine(interp, blockPtr->startLine);
}
@@ -3451,7 +3445,7 @@ StackCheckBasicBlock(
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"code pops stack below level of enclosing catch", -1));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", (char *)NULL);
AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
Tcl_SetErrorLine(interp, blockPtr->startLine);
}
@@ -3579,7 +3573,7 @@ StackCheckExit(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"stack is unbalanced on exit from the code (depth=%d)",
depth));
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", (char *)NULL);
}
return TCL_ERROR;
}
@@ -3724,7 +3718,7 @@ ProcessCatchesInBasicBlock(
"execution reaches an instruction in inconsistent "
"exception contexts", -1));
Tcl_SetErrorLine(interp, bbPtr->startLine);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADCATCH", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADCATCH", (char *)NULL);
}
return TCL_ERROR;
}
@@ -3783,7 +3777,7 @@ ProcessCatchesInBasicBlock(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"endCatch without a corresponding beginCatch", -1));
Tcl_SetErrorLine(interp, bbPtr->startLine);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", (char *)NULL);
}
return TCL_ERROR;
}
@@ -3859,7 +3853,7 @@ CheckForUnclosedCatches(
"catch still active on exit from assembly code", -1));
Tcl_SetErrorLine(interp,
assemEnvPtr->curr_bb->enclosingCatch->startLine);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", (char *)NULL);
}
return TCL_ERROR;
}
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 76e0efb..3813077 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -872,12 +872,7 @@ TclSetByteCodeFromAny(
if (result == TCL_OK) {
TclInitByteCodeObj(objPtr, &compEnv);
-#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile >= 2) {
- TclPrintByteCodeObj(interp, objPtr);
- fflush(stdout);
- }
-#endif /* TCL_COMPILE_DEBUG */
+ TclDebugPrintByteCodeObj(objPtr);
}
TclFreeCompileEnv(&compEnv);
@@ -1322,12 +1317,7 @@ CompileSubstObj(
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
}
-#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile >= 2) {
- TclPrintByteCodeObj(interp, objPtr);
- fflush(stdout);
- }
-#endif /* TCL_COMPILE_DEBUG */
+ TclDebugPrintByteCodeObj(objPtr);
}
return codePtr;
}
@@ -2137,7 +2127,7 @@ TclCompileScript(
if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"too many nested compilations (infinite loop?)", -1));
- Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", (char *)NULL);
TclCompileSyntaxError(interp, envPtr);
return;
}
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index f262b37..44c89bc 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1148,8 +1148,9 @@ MODULE_SCOPE int TclLocalScalarFromToken(Tcl_Token *tokenPtr,
CompileEnv *envPtr);
MODULE_SCOPE void TclOptimizeBytecode(void *envPtr);
#ifdef TCL_COMPILE_DEBUG
-MODULE_SCOPE void TclPrintByteCodeObj(Tcl_Interp *interp,
- Tcl_Obj *objPtr);
+MODULE_SCOPE void TclDebugPrintByteCodeObj(Tcl_Obj *objPtr);
+#else
+#define TclDebugPrintByteCodeObj(objPtr) (void)(objPtr)
#endif
MODULE_SCOPE int TclPrintInstruction(ByteCode *codePtr,
const unsigned char *pc);
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index a66b6a9..51e281b 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -5,7 +5,7 @@
* human-readable or Tcl-processable forms.
*
* Copyright (c) 1996-1998 Sun Microsystems, Inc.
- * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
+ * Copyright (c) 2001 Kevin B. Kenny. All rights reserved.
* Copyright (c) 2013-2016 Donal K. Fellows.
*
* See the file "license.terms" for information on usage and redistribution of
@@ -21,10 +21,8 @@
* Prototypes for procedures defined later in this file:
*/
-static Tcl_Obj * DisassembleByteCodeAsDicts(Tcl_Interp *interp,
- Tcl_Obj *objPtr);
-static Tcl_Obj * DisassembleByteCodeObj(Tcl_Interp *interp,
- Tcl_Obj *objPtr);
+static Tcl_Obj * DisassembleByteCodeAsDicts(Tcl_Obj *objPtr);
+static Tcl_Obj * DisassembleByteCodeObj(Tcl_Obj *objPtr);
static int FormatInstruction(ByteCode *codePtr,
const unsigned char *pc, Tcl_Obj *bufferObj);
static void GetLocationInformation(Proc *procPtr,
@@ -107,7 +105,7 @@ GetLocationInformation(
/*
*----------------------------------------------------------------------
*
- * TclPrintByteCodeObj --
+ * TclDebugPrintByteCodeObj --
*
* This procedure prints ("disassembles") the instructions of a bytecode
* object to stdout.
@@ -122,14 +120,16 @@ GetLocationInformation(
*/
void
-TclPrintByteCodeObj(
- Tcl_Interp *interp, /* Used only for getting location info. */
+TclDebugPrintByteCodeObj(
Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
{
- Tcl_Obj *bufPtr = DisassembleByteCodeObj(interp, objPtr);
+ if (tclTraceCompile == 2) {
+ Tcl_Obj *bufPtr = DisassembleByteCodeObj(objPtr);
- fprintf(stdout, "\n%s", TclGetString(bufPtr));
- Tcl_DecrRefCount(bufPtr);
+ fprintf(stdout, "\n%s", TclGetString(bufPtr));
+ Tcl_DecrRefCount(bufPtr);
+ fflush(stdout);
+ }
}
/*
@@ -191,7 +191,7 @@ TclPrintObject(
char *bytes;
int length;
- bytes = Tcl_GetStringFromObj(objPtr, &length);
+ bytes = TclGetStringFromObj(objPtr, &length);
TclPrintSource(outFile, bytes, TclMin(length, maxChars));
}
@@ -242,14 +242,14 @@ TclPrintSource(
static Tcl_Obj *
DisassembleByteCodeObj(
- Tcl_Interp *interp,
Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
{
ByteCode *codePtr = BYTECODE(objPtr);
unsigned char *codeStart, *codeLimit, *pc;
unsigned char *codeDeltaNext, *codeLengthNext;
unsigned char *srcDeltaNext, *srcLengthNext;
- int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
+ int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, line;
+ int i;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
Tcl_Obj *bufferObj, *fileObj;
char ptrBuf1[20], ptrBuf2[20];
@@ -277,9 +277,9 @@ DisassembleByteCodeObj(
PrintSourceToObj(bufferObj, codePtr->source,
TclMin(codePtr->numSrcBytes, 55));
GetLocationInformation(codePtr->procPtr, &fileObj, &line);
- if (line > -1 && fileObj != NULL) {
+ if (line >= 0 && fileObj != NULL) {
Tcl_AppendPrintfToObj(bufferObj, "\n File \"%s\" Line %d",
- Tcl_GetString(fileObj), line);
+ TclGetString(fileObj), line);
}
Tcl_AppendPrintfToObj(bufferObj,
"\n Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
@@ -648,7 +648,7 @@ FormatInstruction(
int length;
Tcl_AppendToObj(bufferObj, "\t# ", -1);
- bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
+ bytes = TclGetStringFromObj(codePtr->objArrayPtr[opnd], &length);
PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
} else if (suffixBuffer[0]) {
Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
@@ -683,7 +683,7 @@ TclGetInnerContext(
const unsigned char *pc,
Tcl_Obj **tosPtr)
{
- int objc = 0, off = 0;
+ int objc = 0;
Tcl_Obj *result;
Interp *iPtr = (Interp *) interp;
@@ -766,7 +766,7 @@ TclGetInnerContext(
for (; objc>0 ; objc--) {
Tcl_Obj *objPtr;
- objPtr = tosPtr[1 - objc + off];
+ objPtr = tosPtr[1 - objc];
if (!objPtr) {
Tcl_Panic("InnerContext: bad tos -- appending null object");
}
@@ -929,8 +929,6 @@ PrintSourceToObj(
static Tcl_Obj *
DisassembleByteCodeAsDicts(
- Tcl_Interp *interp, /* Used for looking up the CmdFrame for the
- * procedure, if one exists. */
Tcl_Obj *objPtr) /* The bytecode-holding value to take apart */
{
ByteCode *codePtr = BYTECODE(objPtr);
@@ -1221,7 +1219,7 @@ DisassembleByteCodeAsDicts(
TclDictPut(NULL, description, "commands", commands);
TclDictPut(NULL, description, "script",
Tcl_NewStringObj(codePtr->source, codePtr->numSrcBytes));
- TclDictPut(NULL, description, "namespace",
+ TclDictPut(NULL, description, "namespace",
Tcl_NewStringObj(codePtr->nsPtr->fullName, -1));
TclDictPut(NULL, description, "stackdepth",
Tcl_NewIntObj(codePtr->maxStackDepth));
@@ -1252,7 +1250,7 @@ DisassembleByteCodeAsDicts(
int
Tcl_DisassembleObjCmd(
- ClientData clientData, /* What type of operation. */
+ void *clientData, /* What type of operation. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -1335,7 +1333,7 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" isn't a procedure", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
- TclGetString(objv[2]), NULL);
+ TclGetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
@@ -1384,7 +1382,7 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
- TclGetString(objv[2]), NULL);
+ TclGetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
@@ -1394,7 +1392,7 @@ Tcl_DisassembleObjCmd(
"\"%s\" has no defined constructor",
TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
- "CONSRUCTOR", NULL);
+ "CONSRUCTOR", (char *)NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(methodPtr);
@@ -1402,7 +1400,7 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"body not available for this kind of constructor", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
- "METHODTYPE", NULL);
+ "METHODTYPE", (char *)NULL);
return TCL_ERROR;
}
@@ -1449,7 +1447,7 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
- TclGetString(objv[2]), NULL);
+ TclGetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
@@ -1459,7 +1457,7 @@ Tcl_DisassembleObjCmd(
"\"%s\" has no defined destructor",
TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
- "DESRUCTOR", NULL);
+ "DESRUCTOR", (char *)NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod(methodPtr);
@@ -1467,7 +1465,7 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"body not available for this kind of destructor", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
- "METHODTYPE", NULL);
+ "METHODTYPE", (char *)NULL);
return TCL_ERROR;
}
@@ -1514,11 +1512,11 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(objv[2])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
- TclGetString(objv[2]), NULL);
+ TclGetString(objv[2]), (char *)NULL);
return TCL_ERROR;
}
hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
- (char *) objv[3]);
+ (char *)objv[3]);
goto methodBody;
case DISAS_OBJECT_METHOD:
if (objc != 4) {
@@ -1537,7 +1535,7 @@ Tcl_DisassembleObjCmd(
if (oPtr->methodsPtr == NULL) {
goto unknownMethod;
}
- hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[3]);
+ hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *)objv[3]);
/*
* Compile (if necessary) and disassemble a method body.
@@ -1549,7 +1547,7 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unknown method \"%s\"", TclGetString(objv[3])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
- TclGetString(objv[3]), NULL);
+ TclGetString(objv[3]), (char *)NULL);
return TCL_ERROR;
}
procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
@@ -1557,7 +1555,7 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"body not available for this kind of method", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
- "METHODTYPE", NULL);
+ "METHODTYPE", (char *)NULL);
return TCL_ERROR;
}
if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
@@ -1592,15 +1590,15 @@ Tcl_DisassembleObjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"may not disassemble prebuilt bytecode", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
- "BYTECODE", NULL);
+ "BYTECODE", (char *)NULL);
return TCL_ERROR;
}
- if (PTR2INT(clientData)) {
+ if (clientData) {
Tcl_SetObjResult(interp,
- DisassembleByteCodeAsDicts(interp, codeObjPtr));
+ DisassembleByteCodeAsDicts(codeObjPtr));
} else {
Tcl_SetObjResult(interp,
- DisassembleByteCodeObj(interp, codeObjPtr));
+ DisassembleByteCodeObj(codeObjPtr));
}
return TCL_OK;
}
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 4072781..bdc3785 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1582,12 +1582,7 @@ CompileExprObj(
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
}
-#ifdef TCL_COMPILE_DEBUG
- if (tclTraceCompile == 2) {
- TclPrintByteCodeObj(interp, objPtr);
- fflush(stdout);
- }
-#endif /* TCL_COMPILE_DEBUG */
+ TclDebugPrintByteCodeObj(objPtr);
}
return codePtr;
}
@@ -2519,7 +2514,7 @@ TEBCresume(
"yield can only be called in a coroutine", -1));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
- NULL);
+ (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -2550,7 +2545,7 @@ TEBCresume(
"yieldto can only be called in a coroutine", -1));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD",
- NULL);
+ (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -2561,7 +2556,7 @@ TEBCresume(
"yieldto called in deleted namespace", -1));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
- NULL);
+ (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -2622,7 +2617,7 @@ TEBCresume(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"tailcall can only be called from a proc or lambda", -1));
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -4408,7 +4403,7 @@ TEBCresume(
TclObjVarErrMsg(interp, part1Ptr, NULL, "array set",
"variable isn't array", opnd);
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", (char *)NULL);
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
@@ -4757,7 +4752,7 @@ TEBCresume(
TRACE_ERROR(interp);
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "STACK_LEVEL",
- TclGetString(OBJ_AT_TOS), NULL);
+ TclGetString(OBJ_AT_TOS), (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -4785,7 +4780,7 @@ TEBCresume(
"invalid command name \"%s\"", TclGetString(OBJ_AT_TOS)));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
- TclGetString(OBJ_AT_TOS), NULL);
+ TclGetString(OBJ_AT_TOS), (char *)NULL);
CACHE_STACK_INFO();
TRACE_APPEND(("ERROR: not command\n"));
goto gotError;
@@ -4820,7 +4815,7 @@ TEBCresume(
"self may only be called from inside a method",
-1));
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -4848,7 +4843,7 @@ TEBCresume(
"nextto may only be called from inside a method",
-1));
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -4869,7 +4864,7 @@ TEBCresume(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(valuePtr)));
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -4921,7 +4916,7 @@ TEBCresume(
methodType, TclGetString(valuePtr)));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
- NULL);
+ (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -4929,7 +4924,7 @@ TEBCresume(
"%s has no non-filter implementation by \"%s\"",
methodType, TclGetString(valuePtr)));
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -4947,7 +4942,7 @@ TEBCresume(
"next may only be called from inside a method",
-1));
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
}
@@ -4976,7 +4971,7 @@ TEBCresume(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"no next %s implementation", methodType));
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
#ifdef TCL_COMPILE_DEBUG
@@ -6300,7 +6295,7 @@ TEBCresume(
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range",
- NULL);
+ (char *)NULL);
CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
@@ -6349,7 +6344,7 @@ TEBCresume(
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
"domain error: argument not in valid range",
- NULL);
+ (char *)NULL);
CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
@@ -6371,7 +6366,7 @@ TEBCresume(
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
- "integer value too large to represent", NULL);
+ "integer value too large to represent", (char *)NULL);
CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
@@ -7325,7 +7320,7 @@ TEBCresume(
TclGetString(OBJ_AT_TOS)));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
- TclGetString(OBJ_AT_TOS), NULL);
+ TclGetString(OBJ_AT_TOS), (char *)NULL);
CACHE_STACK_INFO();
TRACE_ERROR(interp);
goto gotError;
@@ -8012,7 +8007,7 @@ TEBCresume(
divideByZero:
Tcl_SetObjResult(interp, Tcl_NewStringObj("divide by zero", -1));
DECACHE_STACK_INFO();
- Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "DIVZERO", "divide by zero", (char *)NULL);
CACHE_STACK_INFO();
goto gotError;
@@ -8026,7 +8021,7 @@ TEBCresume(
"exponentiation of zero by negative power", -1));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
- "exponentiation of zero by negative power", NULL);
+ "exponentiation of zero by negative power", (char *)NULL);
CACHE_STACK_INFO();
/*
@@ -9779,7 +9774,7 @@ IllegalExprOperandType(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't use %s as operand of \"%s\"", description, op));
- Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, (char *)NULL);
}
/*
@@ -10156,23 +10151,23 @@ TclExprFloatError(
if ((errno == EDOM) || TclIsNaN(value)) {
s = "domain error: argument not in valid range";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
- Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", s, (char *)NULL);
} else if ((errno == ERANGE) || TclIsInfinite(value)) {
if (value == 0.0) {
s = "floating-point value too small to represent";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
- Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "UNDERFLOW", s, (char *)NULL);
} else {
s = "floating-point value too large to represent";
Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
- Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, NULL);
+ Tcl_SetErrorCode(interp, "ARITH", "OVERFLOW", s, (char *)NULL);
}
} else {
Tcl_Obj *objPtr = Tcl_ObjPrintf(
"unknown floating-point error, errno = %d", errno);
Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN",
- Tcl_GetString(objPtr), NULL);
+ Tcl_GetString(objPtr), (char *)NULL);
Tcl_SetObjResult(interp, objPtr);
}
}