From 9d7e696016d924ae175c552e503b4dfb2c806884 Mon Sep 17 00:00:00 2001 From: bch Date: Thu, 6 Jun 2019 03:47:33 +0000 Subject: squelch int vs. long int (size_t) warings in comparison, format specifiers --- generic/tclLiteral.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 464f565..6358c7f 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -465,7 +465,7 @@ TclRegisterLiteral( #ifdef TCL_COMPILE_DEBUG if (globalPtr != NULL && globalPtr->refCount < 1) { - Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", + Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %ld", "TclRegisterLiteral", (length>60? 60 : length), bytes, globalPtr->refCount); } @@ -1174,9 +1174,9 @@ TclVerifyLocalLiteralTable( for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL; localPtr=localPtr->nextPtr) { count++; - if (localPtr->refCount != -1) { + if (localPtr->refCount != (size_t)-1) { bytes = TclGetStringFromObj(localPtr->objPtr, &length); - Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d", + Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %ld", "TclVerifyLocalLiteralTable", (length>60? 60 : length), bytes, localPtr->refCount); } @@ -1227,7 +1227,7 @@ TclVerifyGlobalLiteralTable( count++; if (globalPtr->refCount < 1) { bytes = TclGetStringFromObj(globalPtr->objPtr, &length); - Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", + Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %ld", "TclVerifyGlobalLiteralTable", (length>60? 60 : length), bytes, globalPtr->refCount); } -- cgit v0.12 From a1b2390c0ff1b013e377ddd81188f0125c3a2e83 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 7 Jun 2019 14:09:35 +0000 Subject: More usage of TCL_INDEX_NONE in stead of -1. More internal use of size_t, mainly in memory statistics (debug-mode only), and TCL_Z_MODIFIER. This gives broader memory statistics on win64. --- generic/regexec.c | 2 +- generic/tclDisassemble.c | 2 +- generic/tclExecute.c | 75 ++++++++++++++++++++++++------------------------ generic/tclInt.h | 32 ++++++++++----------- generic/tclLiteral.c | 42 +++++++++++++++------------ generic/tclRegexp.c | 10 +++---- 6 files changed, 84 insertions(+), 79 deletions(-) diff --git a/generic/regexec.c b/generic/regexec.c index c57f42c..1a3e114 100644 --- a/generic/regexec.c +++ b/generic/regexec.c @@ -889,7 +889,7 @@ cbrdissect( MDEBUG(("cbackref n%d %d{%d-%d}\n", t->id, n, min, max)); /* get the backreferenced string */ - if (v->pmatch[n].rm_so == -1) { + if (v->pmatch[n].rm_so == TCL_INDEX_NONE) { return REG_NOMATCH; } brstring = v->start + v->pmatch[n].rm_so; diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index e5fce72..76a4d46 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -837,7 +837,7 @@ UpdateStringOfInstName( if (inst > LAST_INST_OPCODE) { dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5); TclOOM(dst, TCL_INTEGER_SPACE + 5); - sprintf(dst, "inst_%" TCL_Z_MODIFIER "d", inst); + sprintf(dst, "inst_%" TCL_Z_MODIFIER "u", inst); (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } else { const char *s = tclInstructionTable[inst].name; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index a2eed3f..6b69d97 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -97,9 +97,9 @@ static const char *const resultStrings[] = { */ #ifdef TCL_COMPILE_STATS -long tclObjsAlloced = 0; -long tclObjsFreed = 0; -long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; +size_t tclObjsAlloced = 0; +size_t tclObjsFreed = 0; +size_t tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; #endif /* TCL_COMPILE_STATS */ /* @@ -6471,7 +6471,7 @@ TEBCresume( listTmpIndex++; } } - TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "d, %s loop\n", + TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "u, %s loop\n", numLists, iterNum, (continueLoop? "continue" : "exit"))); /* @@ -8947,19 +8947,19 @@ ValidatePcAndStackTop( { int stackUpperBound = codePtr->maxStackDepth; /* Greatest legal value for stackTop. */ - unsigned relativePc = (unsigned) (pc - codePtr->codeStart); - unsigned long codeStart = (unsigned long) codePtr->codeStart; - unsigned long codeEnd = (unsigned long) + size_t relativePc = (size_t) (pc - codePtr->codeStart); + size_t codeStart = (size_t) codePtr->codeStart; + size_t codeEnd = (size_t) (codePtr->codeStart + codePtr->numCodeBytes); unsigned char opCode = *pc; - if (((unsigned long) pc < codeStart) || ((unsigned long) pc > codeEnd)) { + if (((size_t) pc < codeStart) || ((size_t) pc > codeEnd)) { fprintf(stderr, "\nBad instruction pc 0x%p in TclNRExecuteByteCode\n", pc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc"); } if ((unsigned) opCode > LAST_INST_OPCODE) { - fprintf(stderr, "\nBad opcode %d at pc %u in TclNRExecuteByteCode\n", + fprintf(stderr, "\nBad opcode %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode\n", (unsigned) opCode, relativePc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode"); } @@ -8968,7 +8968,7 @@ ValidatePcAndStackTop( int numChars; const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL); - fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min 0, max %i)", + fprintf(stderr, "\nBad stack top %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %i)", stackTop, relativePc, stackUpperBound); if (cmd != NULL) { Tcl_Obj *message; @@ -9510,10 +9510,10 @@ EvalStatsCmd( double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved; double strBytesSharedMultX, strBytesSharedOnce; double numInstructions, currentHeaderBytes; - long numCurrentByteCodes, numByteCodeLits; - long refCountSum, literalMgmtBytes, sum; - int numSharedMultX, numSharedOnce; - int decadeHigh, minSizeDecade, maxSizeDecade, length, i; + size_t numCurrentByteCodes, numByteCodeLits; + size_t refCountSum, literalMgmtBytes, sum; + size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade, i; + int decadeHigh, length; char *litTableStats; LiteralEntry *entryPtr; Tcl_Obj *objPtr; @@ -9555,12 +9555,12 @@ EvalStatsCmd( Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n"); Tcl_AppendPrintfToObj(objPtr, - "Compilation and execution statistics for interpreter %#lx\n", - (long int)iPtr); + "Compilation and execution statistics for interpreter %#" TCL_Z_MODIFIER "x\n", + (size_t)iPtr); - Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%" TCL_Z_MODIFIER "u\n", statsPtr->numExecutions); - Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%" TCL_Z_MODIFIER "u\n", statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, " Mean executions/compile\t%.1f\n", statsPtr->numExecutions / (float)statsPtr->numCompilations); @@ -9572,7 +9572,7 @@ EvalStatsCmd( Tcl_AppendPrintfToObj(objPtr, " Mean inst/execution\t\t%.0f\n", numInstructions / statsPtr->numExecutions); - Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes\t\t\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes\t\t\t%" TCL_Z_MODIFIER "u\n", statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, " Source bytes\t\t\t%.6g\n", statsPtr->totalSrcBytes); @@ -9582,18 +9582,18 @@ EvalStatsCmd( statsPtr->totalByteCodeBytes); Tcl_AppendPrintfToObj(objPtr, " Literal bytes\t\t%.6g\n", totalLiteralBytes); - Tcl_AppendPrintfToObj(objPtr, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n", - (unsigned long) sizeof(LiteralTable), - (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)), - (unsigned long) (statsPtr->numLiteralsCreated * sizeof(LiteralEntry)), - (unsigned long) (statsPtr->numLiteralsCreated * sizeof(Tcl_Obj)), + Tcl_AppendPrintfToObj(objPtr, " table %" TCL_Z_MODIFIER "u + bkts %" TCL_Z_MODIFIER "u + entries %" TCL_Z_MODIFIER "u + objects %" TCL_Z_MODIFIER "u + strings %.6g\n", + sizeof(LiteralTable), + iPtr->literalTable.numBuckets * sizeof(LiteralEntry *), + statsPtr->numLiteralsCreated * sizeof(LiteralEntry), + statsPtr->numLiteralsCreated * sizeof(Tcl_Obj), statsPtr->totalLitStringBytes); Tcl_AppendPrintfToObj(objPtr, " Mean code/compile\t\t%.1f\n", totalCodeBytes / statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, " Mean code/source\t\t%.1f\n", totalCodeBytes / statsPtr->totalSrcBytes); - Tcl_AppendPrintfToObj(objPtr, "\nCurrent (active) ByteCodes\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "\nCurrent (active) ByteCodes\t%" TCL_Z_MODIFIER "u\n", numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, " Source bytes\t\t\t%.6g\n", statsPtr->currentSrcBytes); @@ -9624,17 +9624,17 @@ EvalStatsCmd( numSharedMultX = 0; Tcl_AppendPrintfToObj(objPtr, "\nTcl_IsShared object check (all objects):\n"); - Tcl_AppendPrintfToObj(objPtr, " Object had refcount <=1 (not shared)\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, " Object had refcount <=1 (not shared)\t%" TCL_Z_MODIFIER "u\n", tclObjsShared[1]); for (i = 2; i < TCL_MAX_SHARED_OBJ_STATS; i++) { - Tcl_AppendPrintfToObj(objPtr, " refcount ==%d\t\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, " refcount ==%" TCL_Z_MODIFIER "u\t\t%" TCL_Z_MODIFIER "u\n", i, tclObjsShared[i]); numSharedMultX += tclObjsShared[i]; } - Tcl_AppendPrintfToObj(objPtr, " refcount >=%d\t\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, " refcount >=%" TCL_Z_MODIFIER "u\t\t%" TCL_Z_MODIFIER "u\n", i, tclObjsShared[0]); numSharedMultX += tclObjsShared[0]; - Tcl_AppendPrintfToObj(objPtr, " Total shared objects\t\t\t%d\n", + Tcl_AppendPrintfToObj(objPtr, " Total shared objects\t\t\t%" TCL_Z_MODIFIER "u\n", numSharedMultX); /* @@ -9671,20 +9671,20 @@ EvalStatsCmd( sharingBytesSaved = (objBytesIfUnshared + strBytesIfUnshared) - currentLiteralBytes; - Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%" TCL_Z_MODIFIER "u\n", tclObjsAlloced); - Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%" TCL_Z_MODIFIER "u\n", (tclObjsAlloced - tclObjsFreed)); - Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%" TCL_Z_MODIFIER "u\n", statsPtr->numLiteralsCreated); Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%d (%0.1f%% of current objects)\n", globalTablePtr->numEntries, Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed)); - Tcl_AppendPrintfToObj(objPtr, " ByteCode literals\t\t%ld (%0.1f%% of current literals)\n", + Tcl_AppendPrintfToObj(objPtr, " ByteCode literals\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current literals)\n", numByteCodeLits, Percent(numByteCodeLits, globalTablePtr->numEntries)); - Tcl_AppendPrintfToObj(objPtr, " Literals reused > 1x\t\t%d\n", + Tcl_AppendPrintfToObj(objPtr, " Literals reused > 1x\t\t%" TCL_Z_MODIFIER "u\n", numSharedMultX); Tcl_AppendPrintfToObj(objPtr, " Mean reference count\t\t%.2f\n", ((double) refCountSum) / globalTablePtr->numEntries); @@ -9709,7 +9709,7 @@ EvalStatsCmd( Tcl_AppendPrintfToObj(objPtr, " String sharing savings \t%.6g = unshared %.6g - shared %.6g\n", (strBytesIfUnshared - statsPtr->currentLitStringBytes), strBytesIfUnshared, statsPtr->currentLitStringBytes); - Tcl_AppendPrintfToObj(objPtr, " Literal mgmt overhead\t\t%ld (%0.1f%% of bytes with sharing)\n", + Tcl_AppendPrintfToObj(objPtr, " Literal mgmt overhead\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of bytes with sharing)\n", literalMgmtBytes, Percent(literalMgmtBytes, currentLiteralBytes)); Tcl_AppendPrintfToObj(objPtr, " table %lu + buckets %lu + entries %lu\n", @@ -9759,7 +9759,8 @@ EvalStatsCmd( Tcl_AppendPrintfToObj(objPtr, "\nLiteral string sizes:\n"); Tcl_AppendPrintfToObj(objPtr, "\t Up to length\t\tPercentage\n"); maxSizeDecade = 0; - for (i = 31; i >= 0; i--) { + i = 32; + while (i-- > 0) { if (statsPtr->literalCount[i] > 0) { maxSizeDecade = i; break; @@ -9857,7 +9858,7 @@ EvalStatsCmd( Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n"); for (i = 0; i <= LAST_INST_OPCODE; i++) { - Tcl_AppendPrintfToObj(objPtr, "%20s %8ld ", + Tcl_AppendPrintfToObj(objPtr, "%20s %8" TCL_Z_MODIFIER "u ", tclInstructionTable[i].name, statsPtr->instructionCount[i]); if (statsPtr->instructionCount[i]) { Tcl_AppendPrintfToObj(objPtr, "%6.1f%%\n", diff --git a/generic/tclInt.h b/generic/tclInt.h index 9384295..edf92c5 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1537,11 +1537,11 @@ typedef struct LiteralTable { LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables to avoid * mallocs and frees. */ - int numBuckets; /* Total number of buckets allocated at + unsigned int numBuckets; /* Total number of buckets allocated at * **buckets. */ - int numEntries; /* Total number of entries present in + unsigned int numEntries; /* Total number of entries present in * table. */ - int rebuildSize; /* Enlarge table when numEntries gets to be + unsigned int rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ unsigned int mask; /* Mask value used in hashing function. */ } LiteralTable; @@ -1554,10 +1554,10 @@ typedef struct LiteralTable { #ifdef TCL_COMPILE_STATS typedef struct ByteCodeStats { - long numExecutions; /* Number of ByteCodes executed. */ - long numCompilations; /* Number of ByteCodes created. */ - long numByteCodesFreed; /* Number of ByteCodes destroyed. */ - long instructionCount[256]; /* Number of times each instruction was + size_t numExecutions; /* Number of ByteCodes executed. */ + size_t numCompilations; /* Number of ByteCodes created. */ + size_t numByteCodesFreed; /* Number of ByteCodes destroyed. */ + size_t instructionCount[256]; /* Number of times each instruction was * executed. */ double totalSrcBytes; /* Total source bytes ever compiled. */ @@ -1565,10 +1565,10 @@ typedef struct ByteCodeStats { double currentSrcBytes; /* Src bytes for all current ByteCodes. */ double currentByteCodeBytes;/* Code bytes in all current ByteCodes. */ - long srcCount[32]; /* Source size distribution: # of srcs of + size_t srcCount[32]; /* Source size distribution: # of srcs of * size [2**(n-1)..2**n), n in [0..32). */ - long byteCodeCount[32]; /* ByteCode size distribution. */ - long lifetimeCount[32]; /* ByteCode lifetime distribution (ms). */ + size_t byteCodeCount[32]; /* ByteCode size distribution. */ + size_t lifetimeCount[32]; /* ByteCode lifetime distribution (ms). */ double currentInstBytes; /* Instruction bytes-current ByteCodes. */ double currentLitBytes; /* Current literal bytes. */ @@ -1576,11 +1576,11 @@ typedef struct ByteCodeStats { double currentAuxBytes; /* Current auxiliary information bytes. */ double currentCmdMapBytes; /* Current src<->code map bytes. */ - long numLiteralsCreated; /* Total literal objects ever compiled. */ + size_t numLiteralsCreated; /* Total literal objects ever compiled. */ double totalLitStringBytes; /* Total string bytes in all literals. */ double currentLitStringBytes; /* String bytes in current literals. */ - long literalCount[32]; /* Distribution of literal string sizes. */ + size_t literalCount[32]; /* Distribution of literal string sizes. */ } ByteCodeStats; #endif /* TCL_COMPILE_STATS */ @@ -2513,7 +2513,7 @@ typedef struct List { (((objPtr)->typePtr == &tclIntType \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \ ? ((*(idxPtr) = ((objPtr)->internalRep.wideValue >= 0) \ - ? (int)(objPtr)->internalRep.wideValue : -1), TCL_OK) \ + ? (int)(objPtr)->internalRep.wideValue : TCL_INDEX_NONE), TCL_OK) \ : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) /* @@ -2776,10 +2776,10 @@ MODULE_SCOPE const Tcl_HashKeyType tclObjHashKeyType; MODULE_SCOPE Tcl_Obj * tclFreeObjList; #ifdef TCL_COMPILE_STATS -MODULE_SCOPE long tclObjsAlloced; -MODULE_SCOPE long tclObjsFreed; +MODULE_SCOPE size_t tclObjsAlloced; +MODULE_SCOPE size_t tclObjsFreed; #define TCL_MAX_SHARED_OBJ_STATS 5 -MODULE_SCOPE long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS]; +MODULE_SCOPE size_t tclObjsShared[TCL_MAX_SHARED_OBJ_STATS]; #endif /* TCL_COMPILE_STATS */ /* diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 6407c37..2f93200 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -104,7 +104,7 @@ TclDeleteLiteralTable( { LiteralEntry *entryPtr, *nextPtr; Tcl_Obj *objPtr; - int i; + size_t i; /* * Release remaining literals in the table. Note that releasing a literal @@ -298,7 +298,8 @@ TclCreateLiteral( TclVerifyGlobalLiteralTable(iPtr); { LiteralEntry *entryPtr; - int found, i; + int found; + size_t i; found = 0; for (i=0 ; inumBuckets ; i++) { @@ -466,7 +467,7 @@ TclRegisterLiteral( objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash); #ifdef TCL_COMPILE_DEBUG - if (globalPtr != NULL && globalPtr->refCount < 1) { + if (globalPtr != NULL && globalPtr->refCount + 1 < 2) { Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", "TclRegisterLiteral", (length>60? 60 : length), bytes, globalPtr->refCount); @@ -689,7 +690,8 @@ AddLocalLiteralEntry( TclVerifyLocalLiteralTable(envPtr); { char *bytes; - int length, found, i; + int length, found; + size_t i; found = 0; for (i=0 ; inumBuckets ; i++) { @@ -743,15 +745,15 @@ ExpandLocalLiteralArray( */ LiteralTable *localTablePtr = &envPtr->localLitTable; - int currElems = envPtr->literalArrayNext; + size_t currElems = envPtr->literalArrayNext; size_t currBytes = (currElems * sizeof(LiteralEntry)); LiteralEntry *currArrayPtr = envPtr->literalArrayPtr; LiteralEntry *newArrayPtr; - int i; - unsigned int newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX; + size_t i; + size_t newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX; if (currBytes == newSize) { - Tcl_Panic("max size of Tcl literal array (%d literals) exceeded", + Tcl_Panic("max size of Tcl literal array (%" TCL_Z_MODIFIER "u literals) exceeded", currElems); } @@ -1092,7 +1094,9 @@ TclLiteralStats( LiteralTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 - int count[NUM_COUNTERS], overflow, i, j; + size_t count[NUM_COUNTERS]; + int overflow; + size_t i, j; double average, tmp; register LiteralEntry *entryPtr; char *result, *p; @@ -1131,7 +1135,7 @@ TclLiteralStats( tablePtr->numEntries, tablePtr->numBuckets); p = result + strlen(result); for (i=0 ; ilocalLitTable; register LiteralEntry *localPtr; char *bytes; - register int i; - int length, count; + size_t i, count; + int length; count = 0; for (i=0 ; inumBuckets ; i++) { for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL; localPtr=localPtr->nextPtr) { count++; - if (localPtr->refCount != (size_t)-1) { + if (localPtr->refCount != (unsigned)-1) { bytes = TclGetStringFromObj(localPtr->objPtr, &length); - Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d", + Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %u", "TclVerifyLocalLiteralTable", (length>60? 60 : length), bytes, localPtr->refCount); } @@ -1189,7 +1193,7 @@ TclVerifyLocalLiteralTable( } } if (count != localTablePtr->numEntries) { - Tcl_Panic("%s: local literal table had %d entries, should be %d", + Tcl_Panic("%s: local literal table had %" TCL_Z_MODIFIER "u entries, should be %u", "TclVerifyLocalLiteralTable", count, localTablePtr->numEntries); } @@ -1219,15 +1223,15 @@ TclVerifyGlobalLiteralTable( register LiteralTable *globalTablePtr = &iPtr->literalTable; register LiteralEntry *globalPtr; char *bytes; - register int i; - int length, count; + size_t i, count; + int length; count = 0; for (i=0 ; inumBuckets ; i++) { for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL; globalPtr=globalPtr->nextPtr) { count++; - if (globalPtr->refCount < 1) { + if (globalPtr->refCount + 1 < 2) { bytes = TclGetStringFromObj(globalPtr->objPtr, &length); Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", "TclVerifyGlobalLiteralTable", @@ -1240,7 +1244,7 @@ TclVerifyGlobalLiteralTable( } } if (count != globalTablePtr->numEntries) { - Tcl_Panic("%s: global literal table had %d entries, should be %d", + Tcl_Panic("%s: global literal table had %" TCL_Z_MODIFIER "u entries, should be %u", "TclVerifyGlobalLiteralTable", count, globalTablePtr->numEntries); } diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 804b117..d3f7428 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -263,7 +263,7 @@ Tcl_RegExpRange( if ((size_t) index > regexpPtr->re.re_nsub) { *startPtr = *endPtr = NULL; - } else if (regexpPtr->matches[index].rm_so < 0) { + } else if (regexpPtr->matches[index].rm_so == TCL_INDEX_NONE) { *startPtr = *endPtr = NULL; } else { if (regexpPtr->objPtr) { @@ -364,7 +364,7 @@ TclRegExpRangeUniChar( * passed to Tcl_RegExpExec. */ int index, /* 0 means give the range of the entire match, * > 0 means give the range of a matching - * subrange, -1 means the range of the + * subrange, TCL_INDEX_NONE means the range of the * rm_extend field. */ int *startPtr, /* Store address of first character in * (sub-)range here. */ @@ -373,12 +373,12 @@ TclRegExpRangeUniChar( { TclRegexp *regexpPtr = (TclRegexp *) re; - if ((regexpPtr->flags®_EXPECT) && index == -1) { + if ((regexpPtr->flags®_EXPECT) && (index == TCL_INDEX_NONE)) { *startPtr = regexpPtr->details.rm_extend.rm_so; *endPtr = regexpPtr->details.rm_extend.rm_eo; } else if ((size_t) index > regexpPtr->re.re_nsub) { - *startPtr = -1; - *endPtr = -1; + *startPtr = TCL_INDEX_NONE; + *endPtr = TCL_INDEX_NONE; } else { *startPtr = regexpPtr->matches[index].rm_so; *endPtr = regexpPtr->matches[index].rm_eo; -- cgit v0.12 From ee5696ef47d4e0bb5ccc54377fde9c75edc18de2 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 7 Jun 2019 22:09:32 +0000 Subject: closes [c3a211e8a5995018c82e]: search of tcl/tk is more backwards compatible now + make some errors more verbose (e. g. if scan found nothing and no tcl/tk build expected) --- tools/tcltk-man2html-utils.tcl | 4 ++++ tools/tcltk-man2html.tcl | 33 +++++++++++++++++++++++---------- 2 files changed, 27 insertions(+), 10 deletions(-) diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl index 5a4550b..e851047 100644 --- a/tools/tcltk-man2html-utils.tcl +++ b/tools/tcltk-man2html-utils.tcl @@ -1566,6 +1566,10 @@ proc make-manpage-section {outputDir sectionDescriptor} { puts stderr "" } + if {![llength $manual(wing-toc)]} { + fatal "not table of contents." + } + # # make the wing table of contents for the section # diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index e4cf3e9..efb3cd6 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -32,6 +32,11 @@ set ::CSSFILE "docs.css" source [file join [file dirname [info script]] tcltk-man2html-utils.tcl] proc findversion {top name useversion} { + # Default search version is a glob pattern, switch it for string match: + if {$useversion eq {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}}} { + set useversion {[8-9].[0-9]} + } + # Search: set upper [string toupper $name] foreach top1 [list $top $top/..] sub {{} generic} { foreach dirname [ @@ -152,22 +157,30 @@ proc parse_command_line {} { } if {$build_tcl} { - # Find Tcl. - lassign [findversion $tcltkdir tcl $useversion] tcltkdir tcldir major minor - if {$tcldir eq {} && $opt_build_tcl} { - puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir" - exit 1 + # Find Tcl (firstly using glob pattern / backwards compatible way) + set tcldir [lindex [lsort [glob -nocomplain -tails -type d \ + -directory $tcltkdir tcl$useversion]] end] + if {$tcldir eq {}} { + lassign [findversion $tcltkdir tcl $useversion] tcltkdir tcldir major minor + if {$tcldir eq {} && $opt_build_tcl} { + puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir" + exit 1 + } } puts "using Tcl source directory $tcltkdir $tcldir" } if {$build_tk} { - # Find Tk. - lassign [findversion $tcltkdir tk $useversion] tcltkdir tkdir major minor - if {$tkdir eq {} && $opt_build_tk} { - puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir" - exit 1 + # Find Tk (firstly using glob pattern / backwards compatible way) + set tkdir [lindex [lsort [glob -nocomplain -tails -type d \ + -directory $tcltkdir tk$useversion]] end] + if {$tkdir eq {}} { + lassign [findversion $tcltkdir tk $useversion] tcltkdir tkdir major minor + if {$tkdir eq {} && $opt_build_tk} { + puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir" + exit 1 + } } puts "using Tk source directory $tkdir" } -- cgit v0.12 From eea593cd754831122ab3771e0f4c217c9f883b5c Mon Sep 17 00:00:00 2001 From: sebres Date: Sat, 8 Jun 2019 10:46:22 +0000 Subject: amend to close [c3a211e8a5], fixes can't read "major": no such variable --- tools/tcltk-man2html.tcl | 86 +++++++++++++++++++++++++++++++----------------- 1 file changed, 55 insertions(+), 31 deletions(-) diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl index efb3cd6..08f3d28 100755 --- a/tools/tcltk-man2html.tcl +++ b/tools/tcltk-man2html.tcl @@ -31,6 +31,24 @@ set ::CSSFILE "docs.css" ## source [file join [file dirname [info script]] tcltk-man2html-utils.tcl] +proc getversion {tclh {name {}}} { + if {[file exists $tclh]} { + set chan [open $tclh] + set data [read $chan] + close $chan + if {$name eq ""} { + set name [string toupper [file root [file tail $tclh]]] + } + # backslash isn't required in front of quote, but it keeps syntax + # highlighting straight in some editors + if {[regexp -lineanchor \ + [string map [list @name@ $name] \ + {^#define\s+@name@_VERSION\s+\"([^.])+\.([^.\"]+)}] \ + $data -> major minor]} { + return [list $major $minor] + } + } +} proc findversion {top name useversion} { # Default search version is a glob pattern, switch it for string match: if {$useversion eq {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}}} { @@ -42,30 +60,21 @@ proc findversion {top name useversion} { foreach dirname [ glob -nocomplain -tails -type d -directory $top1 *] { - set tclh [join [list $top1 $dirname {*}$sub $name.h] /] - if {[file exists $tclh]} { - set chan [open $tclh] - set data [read $chan] - close $chan - # backslash isn't required in front of quote, but it keeps syntax - # highlighting straight in some editors - if {[regexp -lineanchor \ - [string map [list @name@ $upper] \ - {^#define\s+@name@_VERSION\s+\"([^.])+\.([^.\"]+)}] \ - $data -> major minor]} { - # to do - # use glob matching instead of string matching or add - # brace handling to [string matcch] - if {$useversion eq {} || [string match $useversion $major.$minor]} { - set top [file dirname [file dirname $tclh]] - set prefix [file dirname $top] - return [list $prefix [file tail $top] $major $minor] - } + set tclh [join [list $top1 $dirname {*}$sub ${name}.h] /] + set v [getversion $tclh $upper] + if {[llength $v]} { + lassign $v major minor + # to do + # use glob matching instead of string matching or add + # brace handling to [string matcch] + if {$useversion eq {} || [string match $useversion $major.$minor]} { + set top [file dirname [file dirname $tclh]] + set prefix [file dirname $top] + return [list $prefix [file tail $top] $major $minor] } } } } - return } proc parse_command_line {} { @@ -156,16 +165,22 @@ proc parse_command_line {} { set build_tk 1 } + set major "" + set minor "" + if {$build_tcl} { # Find Tcl (firstly using glob pattern / backwards compatible way) set tcldir [lindex [lsort [glob -nocomplain -tails -type d \ -directory $tcltkdir tcl$useversion]] end] - if {$tcldir eq {}} { + if {$tcldir ne {}} { + # obtain version from generic header if we can: + lassign [getversion [file join $tcltkdir $tcldir generic tcl.h]] major minor + } else { lassign [findversion $tcltkdir tcl $useversion] tcltkdir tcldir major minor - if {$tcldir eq {} && $opt_build_tcl} { - puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir" - exit 1 - } + } + if {$tcldir eq {} && $opt_build_tcl} { + puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir" + exit 1 } puts "using Tcl source directory $tcltkdir $tcldir" } @@ -175,12 +190,17 @@ proc parse_command_line {} { # Find Tk (firstly using glob pattern / backwards compatible way) set tkdir [lindex [lsort [glob -nocomplain -tails -type d \ -directory $tcltkdir tk$useversion]] end] - if {$tkdir eq {}} { - lassign [findversion $tcltkdir tk $useversion] tcltkdir tkdir major minor - if {$tkdir eq {} && $opt_build_tk} { - puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir" - exit 1 + if {$tkdir ne {}} { + if {$major eq ""} { + # obtain version from generic header if we can: + lassign [getversion [file join $tcltkdir $tcldir generic tk.h]] major minor } + } else { + lassign [findversion $tcltkdir tk $useversion] tcltkdir tkdir major minor + } + if {$tkdir eq {} && $opt_build_tk} { + puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir" + exit 1 } puts "using Tk source directory $tkdir" } @@ -191,7 +211,11 @@ proc parse_command_line {} { global overall_title set overall_title "" if {$build_tcl} { - append overall_title "Tcl $major.$minor" + if {$major ne ""} { + append overall_title "Tcl $major.$minor" + } else { + append overall_title "Tcl [capitalize $tcldir]" + } } if {$build_tcl && $build_tk} { append overall_title "/" -- cgit v0.12 From c18dcfc96ca16e4b4a6dd477d20aacc619ca8632 Mon Sep 17 00:00:00 2001 From: bch Date: Sun, 9 Jun 2019 05:07:53 +0000 Subject: cast to correct size, stop faulting --- generic/tclLiteral.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 6407c37..f945742 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -1176,7 +1176,7 @@ TclVerifyLocalLiteralTable( for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL; localPtr=localPtr->nextPtr) { count++; - if (localPtr->refCount != (size_t)-1) { + if (localPtr->refCount != (unsigned)-1) { bytes = TclGetStringFromObj(localPtr->objPtr, &length); Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d", "TclVerifyLocalLiteralTable", -- cgit v0.12 From ab3a73bf751655c42ee2d89647b0609dd2f7ff27 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 9 Jun 2019 11:28:58 +0000 Subject: minor cleanup of source code formatting --- generic/tclBinary.c | 139 +++++++++++++++++++++++++++++----------------------- 1 file changed, 78 insertions(+), 61 deletions(-) diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 0ef4bda..8bd65a8 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -318,10 +318,10 @@ Tcl_DbNewByteArrayObj( void Tcl_SetByteArrayObj( Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */ - const unsigned char *bytes, /* The array of bytes to use as the new - value. May be NULL even if length > 0. */ + const unsigned char *bytes, /* The array of bytes to use as the new value. + * May be NULL even if length > 0. */ int length) /* Length of the array of bytes, which must - be >= 0. */ + * be >= 0. */ { ByteArray *byteArrayPtr; @@ -664,12 +664,18 @@ TclAppendBytesToByteArray( int attempt; if (needed <= INT_MAX/2) { - /* Try to allocate double the total space that is needed. */ + /* + * Try to allocate double the total space that is needed. + */ + attempt = 2 * needed; ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } if (ptr == NULL) { - /* Try to allocate double the increment that is needed (plus). */ + /* + * Try to allocate double the increment that is needed (plus). + */ + unsigned int limit = INT_MAX - needed; unsigned int extra = len + TCL_MIN_GROWTH; int growth = (int) ((extra > limit) ? limit : extra); @@ -678,7 +684,10 @@ TclAppendBytesToByteArray( ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } if (ptr == NULL) { - /* Last chance: Try to allocate exactly what is needed. */ + /* + * Last chance: Try to allocate exactly what is needed. + */ + attempt = needed; ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } @@ -753,7 +762,7 @@ BinaryFormatCmd( int count; /* Count associated with current format * character. */ int flags; /* Format field flags */ - const char *format; /* Pointer to current position in format + const char *format; /* Pointer to current position in format * string. */ Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ unsigned char *buffer; /* Start of result buffer. */ @@ -939,9 +948,9 @@ BinaryFormatCmd( memset(buffer, 0, (size_t) length); /* - * Pack the data into the result object. Note that we can skip the - * error checking during this pass, since we have already parsed the - * string once. + * Pack the data into the result object. Note that we can skip the error + * checking during this pass, since we have already parsed the string + * once. */ arg = 2; @@ -1154,7 +1163,7 @@ BinaryFormatCmd( } arg++; for (i = 0; i < count; i++) { - if (FormatNumber(interp, cmd, listv[i], &cursor)!=TCL_OK) { + if (FormatNumber(interp, cmd, listv[i], &cursor) != TCL_OK) { Tcl_DecrRefCount(resultPtr); return TCL_ERROR; } @@ -1258,7 +1267,7 @@ BinaryScanCmd( int count; /* Count associated with current format * character. */ int flags; /* Format field flags */ - const char *format; /* Pointer to current position in format + const char *format; /* Pointer to current position in format * string. */ Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ unsigned char *buffer; /* Start of result buffer. */ @@ -1317,7 +1326,7 @@ BinaryScanCmd( if (cmd == 'A') { while (size > 0) { - if (src[size-1] != '\0' && src[size-1] != ' ') { + if (src[size - 1] != '\0' && src[size - 1] != ' ') { break; } size--; @@ -1923,7 +1932,7 @@ FormatNumber( * valid range for float. */ - if (fabs(dvalue) > (double)FLT_MAX) { + if (fabs(dvalue) > (double) FLT_MAX) { fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX; } else { fvalue = (float) dvalue; @@ -2044,9 +2053,9 @@ ScanNumber( int type, /* Format character from "binary scan" */ int flags, /* Format field flags */ Tcl_HashTable **numberCachePtrPtr) - /* Place to look for cache of scanned - * value objects, or NULL if too many - * different numbers have been scanned. */ + /* Place to look for cache of scanned value + * objects, or NULL if too many different + * numbers have been scanned. */ { long value; float fvalue; @@ -2120,6 +2129,7 @@ ScanNumber( /* * Check to see if the value was sign extended properly on systems * where an int is more than 32-bits. + * * We avoid caching unsigned integers as we cannot distinguish between * 32bit signed and unsigned in the hash (short and char are ok). */ @@ -2127,9 +2137,9 @@ ScanNumber( if (flags & BINARY_UNSIGNED) { return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value); } - if ((value & (((unsigned) 1)<<31)) && (value > 0)) { - value -= (((unsigned) 1)<<31); - value -= (((unsigned) 1)<<31); + if ((value & (((unsigned) 1) << 31)) && (value > 0)) { + value -= (((unsigned) 1) << 31); + value -= (((unsigned) 1) << 31); } returnNumericObject: @@ -2329,8 +2339,8 @@ BinaryEncodeHex( data = Tcl_GetByteArrayFromObj(objv[1], &count); cursor = Tcl_SetByteArrayLength(resultObj, count * 2); for (offset = 0; offset < count; ++offset) { - *cursor++ = HexDigits[((data[offset] >> 4) & 0x0f)]; - *cursor++ = HexDigits[(data[offset] & 0x0f)]; + *cursor++ = HexDigits[(data[offset] >> 4) & 0x0f]; + *cursor++ = HexDigits[data[offset] & 0x0f]; } Tcl_SetObjResult(interp, resultObj); return TCL_OK; @@ -2370,7 +2380,7 @@ BinaryDecodeHex( Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } - for (i = 1; i < objc-1; ++i) { + for (i = 1; i < objc - 1; ++i) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; @@ -2384,13 +2394,13 @@ BinaryDecodeHex( TclNewObj(resultObj); datastart = data = (unsigned char *) - TclGetStringFromObj(objv[objc-1], &count); + TclGetStringFromObj(objv[objc - 1], &count); dataend = data + count; size = (count + 1) / 2; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); while (data < dataend) { value = 0; - for (i=0 ; i<2 ; i++) { + for (i = 0 ; i < 2 ; i++) { if (data >= dataend) { value <<= 4; break; @@ -2413,7 +2423,7 @@ BinaryDecodeHex( if (c > 16) { c += ('A' - 'a'); } - value |= (c & 0xf); + value |= c & 0xf; } if (i < 2) { cut++; @@ -2484,22 +2494,22 @@ BinaryEncode64( const char *wrapchar = "\n"; int wrapcharlen = 1; int offset, i, index, size, outindex = 0, count = 0; - enum {OPT_MAXLEN, OPT_WRAPCHAR }; + enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; - if (objc < 2 || objc%2 != 0) { + if (objc < 2 || objc % 2 != 0) { Tcl_WrongNumArgs(interp, 1, objv, "?-maxlen len? ?-wrapchar char? data"); return TCL_ERROR; } - for (i = 1; i < objc-1; i += 2) { + for (i = 1; i < objc - 1; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case OPT_MAXLEN: - if (Tcl_GetIntFromObj(interp, objv[i+1], &maxlen) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) { return TCL_ERROR; } if (maxlen < 0) { @@ -2511,7 +2521,7 @@ BinaryEncode64( } break; case OPT_WRAPCHAR: - wrapchar = Tcl_GetStringFromObj(objv[i+1], &wrapcharlen); + wrapchar = Tcl_GetStringFromObj(objv[i + 1], &wrapcharlen); if (wrapcharlen == 0) { maxlen = 0; } @@ -2520,9 +2530,9 @@ BinaryEncode64( } resultObj = Tcl_NewObj(); - data = Tcl_GetByteArrayFromObj(objv[objc-1], &count); + data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); if (count > 0) { - size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */ + size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */ if (maxlen > 0 && size > maxlen) { int adjusted = size + (wrapcharlen * (size / maxlen)); @@ -2533,15 +2543,15 @@ BinaryEncode64( } cursor = Tcl_SetByteArrayLength(resultObj, size); limit = cursor + size; - for (offset = 0; offset < count; offset+=3) { + for (offset = 0; offset < count; offset += 3) { unsigned char d[3] = {0, 0, 0}; - for (i = 0; i < 3 && offset+i < count; ++i) { + for (i = 0; i < 3 && offset + i < count; ++i) { d[i] = data[offset + i]; } OUTPUT(B64Digits[d[0] >> 2]); OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]); - if (offset+1 < count) { + if (offset + 1 < count) { OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]); } else { OUTPUT(B64Digits[64]); @@ -2594,19 +2604,20 @@ BinaryEncodeUu( enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; - if (objc < 2 || objc%2 != 0) { + if (objc < 2 || objc % 2 != 0) { Tcl_WrongNumArgs(interp, 1, objv, "?-maxlen len? ?-wrapchar char? data"); return TCL_ERROR; } - for (i = 1; i < objc-1; i += 2) { + for (i = 1; i < objc - 1; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case OPT_MAXLEN: - if (Tcl_GetIntFromObj(interp, objv[i+1], &lineLength) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[i + 1], + &lineLength) != TCL_OK) { return TCL_ERROR; } if (lineLength < 3 || lineLength > 85) { @@ -2618,7 +2629,7 @@ BinaryEncodeUu( } break; case OPT_WRAPCHAR: - wrapchar = Tcl_GetByteArrayFromObj(objv[i+1], &wrapcharlen); + wrapchar = Tcl_GetByteArrayFromObj(objv[i + 1], &wrapcharlen); break; } } @@ -2630,7 +2641,7 @@ BinaryEncodeUu( resultObj = Tcl_NewObj(); offset = 0; - data = Tcl_GetByteArrayFromObj(objv[objc-1], &count); + data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); rawLength = (lineLength - 1) * 3 / 4; start = cursor = Tcl_SetByteArrayLength(resultObj, (lineLength + wrapcharlen) * @@ -2651,11 +2662,11 @@ BinaryEncodeUu( lineLen = rawLength; } *cursor++ = UueDigits[lineLen]; - for (i=0 ; i 6 ; bits -= 6) { - *cursor++ = UueDigits[(n >> (bits-6)) & 0x3f]; + *cursor++ = UueDigits[(n >> (bits - 6)) & 0x3f]; } } if (bits > 0) { @@ -2663,7 +2674,7 @@ BinaryEncodeUu( *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f]; bits = 0; } - for (j=0 ; j 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } - for (i = 1; i < objc-1; ++i) { + for (i = 1; i < objc - 1; ++i) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; @@ -2726,7 +2737,7 @@ BinaryDecodeUu( TclNewObj(resultObj); datastart = data = (unsigned char *) - TclGetStringFromObj(objv[objc-1], &count); + TclGetStringFromObj(objv[objc - 1], &count); dataend = data + count; size = ((count + 3) & ~3) * 3 / 4; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); @@ -2758,7 +2769,7 @@ BinaryDecodeUu( * Now we read a four-character grouping. */ - for (i=0 ; i<4 ; i++) { + for (i = 0 ; i < 4 ; i++) { if (data < dataend) { d[i] = c = *data++; if (c < 32 || c > 96) { @@ -2876,7 +2887,7 @@ BinaryDecode64( Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } - for (i = 1; i < objc-1; ++i) { + for (i = 1; i < objc - 1; ++i) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; @@ -2890,7 +2901,7 @@ BinaryDecode64( TclNewObj(resultObj); datastart = data = (unsigned char *) - TclGetStringFromObj(objv[objc-1], &count); + TclGetStringFromObj(objv[objc - 1], &count); dataend = data + count; size = ((count + 3) & ~3) * 3 / 4; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); @@ -2918,8 +2929,11 @@ BinaryDecode64( c = '='; } else { if (strict && i <= 1) { - /* single resp. unfulfilled char (each 4th next single char) - * is rather bad64 error case in strict mode */ + /* + * Single resp. unfulfilled char (each 4th next single + * char) is rather bad64 error case in strict mode. + */ + goto bad64; } cut += 3; @@ -2935,10 +2949,10 @@ BinaryDecode64( if (cut) { if (c == '=' && i > 1) { - value <<= 6; - cut++; + value <<= 6; + cut++; } else if (!strict && TclIsSpaceProc(c)) { - i--; + i--; } else { goto bad64; } @@ -2952,11 +2966,15 @@ BinaryDecode64( value = (value << 6) | 0x3e; } else if (c == '/') { value = (value << 6) | 0x3f; - } else if (c == '=' && ( - !strict || i > 1) /* "=" and "a=" is rather bad64 error case in strict mode */ - ) { + } else if (c == '=' && (!strict || i > 1)) { + /* + * "=" and "a=" is rather bad64 error case in strict mode. + */ + value <<= 6; - if (i) cut++; + if (i) { + cut++; + } } else if (strict || !TclIsSpaceProc(c)) { goto bad64; } else { @@ -3003,4 +3021,3 @@ BinaryDecode64( * fill-column: 78 * End: */ - -- cgit v0.12 From 774c2050f147750c96d391c1150c8026a9864ac3 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 10 Jun 2019 18:24:05 +0000 Subject: Remove declarations that are never defined. --- generic/tclInt.h | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index 57367fa..821a39f 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3287,39 +3287,21 @@ MODULE_SCOPE int TclDivOpCmd(ClientData clientData, MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclLessOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLessOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclLeqOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileLeqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclGreaterOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileGreaterOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclGeqOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileGeqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclEqOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileEqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -MODULE_SCOPE int TclStreqOpCmd(ClientData clientData, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr); -- cgit v0.12 From 5f72a5554c21a6f9ef8f355452fd19c1914da786 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 10 Jun 2019 18:33:28 +0000 Subject: More bytecodes are non-throwing. --- generic/tclAssembly.c | 1 + 1 file changed, 1 insertion(+) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index b6bebb6..1a5e5f4 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -513,6 +513,7 @@ static const unsigned char NonThrowingByteCodes[] = { INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */ INST_JUMP1, INST_JUMP4, /* 34-35 */ INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */ + INST_STR_EQ, INST_STR_NEQ, INST_STR_CMP, INST_STR_LEN, /* 73-76 */ INST_LIST, /* 79 */ INST_OVER, /* 95 */ INST_PUSH_RETURN_OPTIONS, /* 108 */ -- cgit v0.12 From 39fba10b45e247bf94cdca222334c7cd4eb40087 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 10 Jun 2019 18:44:18 +0000 Subject: More localized documentation of lazy operators. --- doc/expr.n | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/doc/expr.n b/doc/expr.n index 2a0af7e..58a4b7f 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -106,7 +106,7 @@ Then the command on the left side of each of the lines below will produce the value on the right side of the line: .PP .CS -.ta 6c +.ta 8c \fBexpr\fR 3.1 + $a \fI6.1\fR \fBexpr\fR 2 + "$a.$b" \fI5.6\fR \fBexpr\fR 4*[llength "6 2"] \fI8\fR @@ -201,18 +201,23 @@ Bit-wise OR. Valid for integer operands only. Logical AND. Produces a 1 result if both operands are non-zero, 0 otherwise. Valid for boolean and numeric (integers or floating-point) operands only. +This operator evaluates lazily; it only evaluates its second operand if it +must in order to determine its result. .TP 20 \fB||\fR . Logical OR. Produces a 0 result if both operands are zero, 1 otherwise. Valid for boolean and numeric (integers or floating-point) operands only. +This operator evaluates lazily; it only evaluates its second operand if it +must in order to determine its result. .TP 20 -\fIx\fB?\fIy\fB:\fIz\fR +\fIx \fB?\fI y \fB:\fI z\fR . If-then-else, as in C. If \fIx\fR evaluates to non-zero, then the result is the value of \fIy\fR. Otherwise the result is the value of \fIz\fR. The \fIx\fR operand must have a boolean or numeric value. +This operator evaluates lazily; it evaluates only one of \fIy\fR or \fIz\fR. .PP See the C manual for more details on the results produced by each operator. -- cgit v0.12 From 6a3773f6119ffaee96382a12d282e033a6a0bf95 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 10 Jun 2019 18:58:44 +0000 Subject: Doc formatting and advice about double substitution in expressions. --- doc/expr.n | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) diff --git a/doc/expr.n b/doc/expr.n index 6acc4bf..996407a 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -343,25 +343,45 @@ substitution on the value before \fBexpr\fR is called. In the following example, the value of the expression is 11 because the Tcl parser first substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR. Enclosing the expression in braces would result in a syntax error. +.PP .CS set a 3 set b {$a + 2} \fBexpr\fR $b*4 .CE .PP - -When an expression is generated at runtime, like the one above is, the bytcode +When an expression is generated at runtime, like the one above is, the bytecode compiler must ensure that new code is generated each time the expression is evaluated. This is the most costly kind of expression from a performance perspective. In such cases, consider directly using the commands described in the \fBmathfunc\fR(n) or \fBmathop\fR(n) documentation instead of \fBexpr\fR. - +.PP Most expressions are not formed at runtime, but are literal strings or contain substitutions that don't introduce other substitutions. To allow the bytecode compiler to work with an expression as a string literal at compilation time, ensure that it contains no substitutions or that it is enclosed in braces or otherwise quoted to prevent Tcl from performing substitutions, allowing \fBexpr\fR to perform them instead. +.PP +If it is necessary to include a non-constant expression string within the +wider context of an otherwise-constant expression, the most efficient +technique is to put the varying part inside a recursive \fBexpr\fR, as this at +least allows for the compilation of the outer part, though it does mean that +the varying part must itself be evaluated as a separate expression. Thus, in +this example the result is 20 and the outer expression benefits from fully +cached bytecode compilation. +.PP +.CS +set a 3 +set b {$a + 2} +\fBexpr\fR {[\fBexpr\fR $b] * 4} +.CE +.PP +In general, you should enclose your expression in braces wherever possible, +and where not possible, the argument to \fBexpr\fR should be an expression +defined elsewhere as simply as possible. It is usually more efficient and +safer to use other techniques (e.g., the commands in the \fBtcl::mathop\fR +namespace) than it is to do complex expression generation. .SH EXAMPLES .PP A numeric comparison whose result is 1: -- cgit v0.12 From f627e6922c20d26f51c6cc68be1796be135515aa Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 10 Jun 2019 19:09:16 +0000 Subject: more formatting --- doc/expr.n | 2 ++ 1 file changed, 2 insertions(+) diff --git a/doc/expr.n b/doc/expr.n index 996407a..5263c07 100644 --- a/doc/expr.n +++ b/doc/expr.n @@ -385,11 +385,13 @@ namespace) than it is to do complex expression generation. .SH EXAMPLES .PP A numeric comparison whose result is 1: +.PP .CS \fBexpr\fR {"0x03" > "2"} .CE .PP A string comparison whose result is 1: +.PP .CS \fBexpr\fR {"0y" > "0x12"} .CE -- cgit v0.12