summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r--generic/tclExecute.c208
1 files changed, 168 insertions, 40 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 1169689..88b5299 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -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: tclExecute.c,v 1.12 2000/05/23 22:10:51 ericm Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.13 2000/05/26 08:53:42 hobbs Exp $
*/
#include "tclInt.h"
@@ -1757,15 +1757,14 @@ TclExecuteByteCode(interp, codePtr)
}
ADJUST_PC(1);
- case INST_STREQ:
- case INST_STRNEQ:
+ case INST_STR_EQ:
+ case INST_STR_NEQ:
{
/*
* String (in)equality check
*/
char *s1, *s2;
- int s1len, s2len;
- long iResult;
+ int s1len, s2len, iResult;
value2Ptr = POP_OBJECT();
valuePtr = POP_OBJECT();
@@ -1777,54 +1776,160 @@ TclExecuteByteCode(interp, codePtr)
* We only need to check (in)equality when we have equal
* length strings.
*/
- if (*pc == INST_STRNEQ) {
+ if (*pc == INST_STR_NEQ) {
iResult = (strcmp(s1, s2) != 0);
} else {
- /* INST_STREQ */
+ /* INST_STR_EQ */
iResult = (strcmp(s1, s2) == 0);
}
} else {
- iResult = (*pc == INST_STRNEQ);
+ iResult = (*pc == INST_STR_NEQ);
}
+ PUSH_OBJECT(Tcl_NewIntObj(iResult));
+ TRACE(("%.20s %.20s => %d\n",
+ O2S(valuePtr), O2S(value2Ptr), iResult));
+ TclDecrRefCount(valuePtr);
+ TclDecrRefCount(value2Ptr);
+ }
+ ADJUST_PC(1);
+
+ case INST_STR_CMP:
+ {
/*
- * Reuse the valuePtr object already on stack if possible.
+ * String compare
*/
-
- if (Tcl_IsShared(valuePtr)) {
- PUSH_OBJECT(Tcl_NewLongObj(iResult));
- TRACE(("%.20s %.20s => %ld\n",
- O2S(valuePtr), O2S(value2Ptr), iResult));
- TclDecrRefCount(valuePtr);
+ char *s1, *s2;
+ int s1len, s2len, iResult;
+
+ value2Ptr = POP_OBJECT();
+ valuePtr = POP_OBJECT();
+
+ s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
+ s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
+ /*
+ * Compare up to the minimum byte length
+ */
+ iResult = memcmp(s1, s2,
+ (size_t) ((s1len < s2len) ? s1len : s2len));
+ if (iResult == 0) {
+ iResult = s1len - s2len;
+ }
+
+ PUSH_OBJECT(Tcl_NewIntObj(iResult));
+ TRACE(("%.20s %.20s => %d\n",
+ O2S(valuePtr), O2S(value2Ptr), iResult));
+ TclDecrRefCount(valuePtr);
+ TclDecrRefCount(value2Ptr);
+ }
+ ADJUST_PC(1);
+
+ case INST_STR_LEN:
+ {
+ int length1;
+
+ valuePtr = POP_OBJECT();
+
+ if (valuePtr->typePtr == &tclByteArrayType) {
+ (void) Tcl_GetByteArrayFromObj(valuePtr, &length1);
+ } else {
+ length1 = Tcl_GetCharLength(valuePtr);
+ }
+ PUSH_OBJECT(Tcl_NewIntObj(length1));
+ TRACE(("%.20s => %d\n", O2S(valuePtr), length1));
+ TclDecrRefCount(valuePtr);
+ }
+ ADJUST_PC(1);
+
+ case INST_STR_INDEX:
+ {
+ /*
+ * String compare
+ */
+ int index;
+ bytes = NULL; /* lint */
+
+ value2Ptr = POP_OBJECT();
+ valuePtr = POP_OBJECT();
+
+ /*
+ * If we have a ByteArray object, avoid indexing in the
+ * Utf string since the byte array contains one byte per
+ * character. Otherwise, use the Unicode string rep to
+ * get the index'th char.
+ */
+
+ if (valuePtr->typePtr == &tclByteArrayType) {
+ bytes = Tcl_GetByteArrayFromObj(valuePtr, &length);
+ } else {
+ /*
+ * Get Unicode char length to calulate what 'end' means.
+ */
+ length = Tcl_GetCharLength(valuePtr);
+ }
+
+ result = TclGetIntForIndex(interp, value2Ptr, length - 1,
+ &index);
+ if (result != TCL_OK) {
+ Tcl_DecrRefCount(value2Ptr);
+ Tcl_DecrRefCount(valuePtr);
+ goto checkForCatch;
+ }
+
+ if ((index >= 0) && (index < length)) {
+ if (valuePtr->typePtr == &tclByteArrayType) {
+ objPtr = Tcl_NewByteArrayObj((unsigned char *)
+ (&bytes[index]), 1);
+ } else {
+ char buf[TCL_UTF_MAX];
+ Tcl_UniChar ch;
+
+ ch = Tcl_GetUniChar(valuePtr, index);
+ length = Tcl_UniCharToUtf(ch, buf);
+ objPtr = Tcl_NewStringObj(buf, length);
+ }
+ } else {
+ objPtr = Tcl_NewObj();
+ }
+
+ PUSH_OBJECT(objPtr);
+ TRACE(("%.20s %.20s => %s\n",
+ O2S(valuePtr), O2S(value2Ptr), O2S(objPtr)));
+ TclDecrRefCount(valuePtr);
+ TclDecrRefCount(value2Ptr);
+ }
+ ADJUST_PC(1);
+
+ case INST_STR_MATCH:
+ {
+ int nocase, match;
+
+ valuePtr = POP_OBJECT(); /* String */
+ value2Ptr = POP_OBJECT(); /* Pattern */
+ objPtr = POP_OBJECT(); /* Case Sensitivity */
+
+ Tcl_GetBooleanFromObj(interp, objPtr, &nocase);
+ match = Tcl_UniCharCaseMatch(Tcl_GetUnicode(valuePtr),
+ Tcl_GetUnicode(value2Ptr), nocase);
+
+ /*
+ * Reuse the casePtr object already on stack if possible.
+ */
+
+ TRACE(("%.20s %.20s => %d\n",
+ O2S(valuePtr), O2S(value2Ptr), match));
+ if (Tcl_IsShared(objPtr)) {
+ PUSH_OBJECT(Tcl_NewIntObj(match));
+ TclDecrRefCount(objPtr);
} else { /* reuse the valuePtr object */
- TRACE(("%.20s %.20s => %ld\n",
- O2S(valuePtr), O2S(value2Ptr), iResult));
- Tcl_SetLongObj(valuePtr, iResult);
+ Tcl_SetIntObj(objPtr, match);
++stackTop; /* valuePtr now on stk top has right r.c. */
}
+ TclDecrRefCount(valuePtr);
TclDecrRefCount(value2Ptr);
}
ADJUST_PC(1);
- case INST_STRLEN:
- {
- int length1;
- valuePtr = POP_OBJECT();
- if (valuePtr->typePtr == &tclByteArrayType) {
- (void) Tcl_GetByteArrayFromObj(valuePtr, &length1);
- } else {
- length1 = Tcl_GetCharLength(valuePtr);
- }
- if (Tcl_IsShared(valuePtr)) {
- PUSH_OBJECT(Tcl_NewIntObj(length1));
- TclDecrRefCount(valuePtr);
- } else {
- Tcl_SetIntObj(valuePtr, length1);
- ++stackTop;
- }
- }
- ADJUST_PC(1);
-
case INST_EQ:
case INST_NEQ:
case INST_LT:
@@ -4519,7 +4624,7 @@ EvalStatsCmd(unused, interp, argc, argv)
fprintf(stdout, " Mean code/source %.1f\n",
totalCodeBytes / statsPtr->totalSrcBytes);
- fprintf(stdout, "\nCurrent ByteCodes %ld\n",
+ fprintf(stdout, "\nCurrent (active) ByteCodes %ld\n",
numCurrentByteCodes);
fprintf(stdout, " Source bytes %.6g\n",
statsPtr->currentSrcBytes);
@@ -4542,6 +4647,29 @@ EvalStatsCmd(unused, interp, argc, argv)
(currentCodeBytes / statsPtr->currentSrcBytes) + 1.0);
/*
+ * Tcl_IsShared statistics check
+ *
+ * This gives the refcount of each obj as Tcl_IsShared was called
+ * for it. Shared objects must be duplicated before they can be
+ * modified.
+ */
+
+ numSharedMultX = 0;
+ fprintf(stdout, "\nTcl_IsShared object check (all objects):\n");
+ fprintf(stdout, " Object had refcount <=1 (not shared) %ld\n",
+ tclObjsShared[1]);
+ for (i = 2; i < TCL_MAX_SHARED_OBJ_STATS; i++) {
+ fprintf(stdout, " refcount ==%d %ld\n",
+ i, tclObjsShared[i]);
+ numSharedMultX += tclObjsShared[i];
+ }
+ fprintf(stdout, " refcount >=%d %ld\n",
+ i, tclObjsShared[0]);
+ numSharedMultX += tclObjsShared[0];
+ fprintf(stdout, " Total shared objects %d\n",
+ numSharedMultX);
+
+ /*
* Literal table statistics.
*/
@@ -4581,7 +4709,7 @@ EvalStatsCmd(unused, interp, argc, argv)
(tclObjsAlloced - tclObjsFreed));
fprintf(stdout, "Total literal objects %ld\n",
statsPtr->numLiteralsCreated);
-
+
fprintf(stdout, "\nCurrent literal objects %d (%0.1f%% of current objects)\n",
globalTablePtr->numEntries,
(globalTablePtr->numEntries * 100.0) / (tclObjsAlloced-tclObjsFreed));
@@ -4732,7 +4860,7 @@ EvalStatsCmd(unused, interp, argc, argv)
decadeHigh, (sum * 100.0) / statsPtr->numCompilations);
}
- fprintf(stdout, "\nByteCode longevity (excludes current ByteCodes):\n");
+ fprintf(stdout, "\nByteCode longevity (excludes Current ByteCodes):\n");
fprintf(stdout, " Up to ms Percentage\n");
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {