summaryrefslogtreecommitdiffstats
path: root/generic/tclCompExpr.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCompExpr.c')
-rw-r--r--generic/tclCompExpr.c86
1 files changed, 61 insertions, 25 deletions
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 9c7ab8d..a6ac797 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -281,7 +281,11 @@ enum Marks {
* parse tree. The sub-expression between
* parens becomes the single argument of the
* matching OPEN_PAREN unary operator. */
-#define END (BINARY | 28)
+#define STR_LT (BINARY | 28)
+#define STR_GT (BINARY | 29)
+#define STR_LEQ (BINARY | 30)
+#define STR_GEQ (BINARY | 31)
+#define END (BINARY | 32)
/* This lexeme represents the end of the
* string being parsed. Treating it as a
* binary operator follows the same logic as
@@ -360,12 +364,14 @@ static const unsigned char prec[] = {
PREC_EQUAL, /* IN_LIST */
PREC_EQUAL, /* NOT_IN_LIST */
PREC_CLOSE_PAREN, /* CLOSE_PAREN */
+ PREC_COMPARE, /* STR_LT */
+ PREC_COMPARE, /* STR_GT */
+ PREC_COMPARE, /* STR_LEQ */
+ PREC_COMPARE, /* STR_GEQ */
PREC_END, /* END */
/* Expansion room for more binary operators */
- 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0,
/* Unary operator lexemes */
PREC_UNARY, /* UNARY_PLUS */
PREC_UNARY, /* UNARY_MINUS */
@@ -415,12 +421,14 @@ static const unsigned char instruction[] = {
INST_LIST_IN, /* IN_LIST */
INST_LIST_NOT_IN, /* NOT_IN_LIST */
0, /* CLOSE_PAREN */
+ INST_STR_LT, /* STR_LT */
+ INST_STR_GT, /* STR_GT */
+ INST_STR_LE, /* STR_LEQ */
+ INST_STR_GE, /* STR_GEQ */
0, /* END */
/* Expansion room for more binary operators */
- 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0,
/* Unary operator lexemes */
INST_UPLUS, /* UNARY_PLUS */
INST_UMINUS, /* UNARY_MINUS */
@@ -1759,7 +1767,7 @@ ConvertTreeToTokens(
/*
* All the Tcl_Tokens allocated and filled belong to
- * this subexpresion. The first token is the leading
+ * this subexpression. The first token is the leading
* TCL_TOKEN_SUB_EXPR token, and all the rest (one fewer)
* are its components.
*/
@@ -2001,6 +2009,35 @@ ParseLexeme(
return 2;
}
}
+ break;
+
+ case 'l':
+ if ((numBytes > 1)
+ && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
+ switch (start[1]) {
+ case 't':
+ *lexemePtr = STR_LT;
+ return 2;
+ case 'e':
+ *lexemePtr = STR_LEQ;
+ return 2;
+ }
+ }
+ break;
+
+ case 'g':
+ if ((numBytes > 1)
+ && ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
+ switch (start[1]) {
+ case 't':
+ *lexemePtr = STR_GT;
+ return 2;
+ case 'e':
+ *lexemePtr = STR_GEQ;
+ return 2;
+ }
+ }
+ break;
}
literal = Tcl_NewObj();
@@ -2027,7 +2064,7 @@ ParseLexeme(
* Example: Inf + luence + () becomes a valid function call.
* [Bug 3401704]
*/
- if (literal->typePtr == &tclDoubleType) {
+ if (TclHasIntRep(literal, &tclDoubleType)) {
const char *p = start;
while (p < end) {
@@ -2066,9 +2103,9 @@ ParseLexeme(
if (Tcl_UtfCharComplete(start, numBytes)) {
scanned = TclUtfToUniChar(start, &ch);
} else {
- char utfBytes[TCL_UTF_MAX];
+ char utfBytes[4];
- memcpy(utfBytes, start, (size_t) numBytes);
+ memcpy(utfBytes, start, numBytes);
utfBytes[numBytes] = '\0';
scanned = TclUtfToUniChar(utfBytes, &ch);
}
@@ -2181,7 +2218,6 @@ ExecConstantExprTree(
CompileEnv *envPtr;
ByteCode *byteCodePtr;
int code;
- Tcl_Obj *byteCodeObj = Tcl_NewObj();
NRE_callback *rootPtr = TOP_CB(interp);
/*
@@ -2195,14 +2231,12 @@ ExecConstantExprTree(
CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
0 /* optimize */);
TclEmitOpcode(INST_DONE, envPtr);
- Tcl_IncrRefCount(byteCodeObj);
- TclInitByteCodeObj(byteCodeObj, envPtr);
+ byteCodePtr = TclInitByteCode(envPtr);
TclFreeCompileEnv(envPtr);
TclStackFree(interp, envPtr);
- byteCodePtr = byteCodeObj->internalRep.twoPtrValue.ptr1;
TclNRExecuteByteCode(interp, byteCodePtr);
code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
- Tcl_DecrRefCount(byteCodeObj);
+ TclReleaseByteCode(byteCodePtr);
return code;
}
@@ -2270,9 +2304,9 @@ CompileExprTree(
p = TclGetStringFromObj(*funcObjv, &length);
funcObjv++;
Tcl_DStringAppend(&cmdName, p, length);
- TclEmitPush(TclRegisterNewCmdLiteral(envPtr,
+ TclEmitPush(TclRegisterLiteral(envPtr,
Tcl_DStringValue(&cmdName),
- Tcl_DStringLength(&cmdName)), envPtr);
+ Tcl_DStringLength(&cmdName), LITERAL_CMD_NAME), envPtr);
Tcl_DStringFree(&cmdName);
/*
@@ -2379,8 +2413,8 @@ CompileExprTree(
pc1 = CurrentOffset(envPtr);
TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1
: INST_JUMP_TRUE1, 0, envPtr);
- TclEmitPush(TclRegisterNewLiteral(envPtr,
- (nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
+ TclEmitPush(TclRegisterLiteral(envPtr,
+ (nodePtr->lexeme == AND) ? "1" : "0", 1, 0), envPtr);
pc2 = CurrentOffset(envPtr);
TclEmitInstInt1(INST_JUMP1, 0, envPtr);
TclAdjustStackDepth(-1, envPtr);
@@ -2389,8 +2423,8 @@ CompileExprTree(
if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
pc2 += 3;
}
- TclEmitPush(TclRegisterNewLiteral(envPtr,
- (nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
+ TclEmitPush(TclRegisterLiteral(envPtr,
+ (nodePtr->lexeme == AND) ? "0" : "1", 1, 0), envPtr);
TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2,
envPtr->codeStart + pc2 + 1);
convert = 0;
@@ -2424,7 +2458,7 @@ CompileExprTree(
if (optimize) {
int length;
const char *bytes = TclGetStringFromObj(literal, &length);
- int index = TclRegisterNewLiteral(envPtr, bytes, length);
+ int index = TclRegisterLiteral(envPtr, bytes, length, 0);
Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
@@ -2479,11 +2513,13 @@ CompileExprTree(
* already, then use it to share via the literal table.
*/
- if (objPtr->bytes) {
+ if (TclHasStringRep(objPtr)) {
Tcl_Obj *tableValue;
+ int numBytes;
+ const char *bytes
+ = Tcl_GetStringFromObj(objPtr, &numBytes);
- index = TclRegisterNewLiteral(envPtr, objPtr->bytes,
- objPtr->length);
+ index = TclRegisterLiteral(envPtr, bytes, numBytes, 0);
tableValue = TclFetchLiteral(envPtr, index);
if ((tableValue->typePtr == NULL) &&
(objPtr->typePtr != NULL)) {
@@ -2569,7 +2605,7 @@ TclSingleOpCmd(
*
* TclSortingOpCmd --
* Implements the commands:
- * <, <=, >, >=, ==, eq
+ * <, <=, >, >=, ==, eq, lt, le, gt, ge
* in the ::tcl::mathop namespace. These commands are defined for
* arbitrary number of arguments by computing the AND of the base
* operator applied to all neighbor argument pairs.
generated by cgit v0.12 at 2024-11-17 14:21:13 (GMT)