Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Merge 8.7. Some int -> Tcl_Size |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk | main |
Files: | files | file ages | folders |
SHA3-256: |
1a12a05fa18026db575d4b1a1a3a05dc |
User & Date: | jan.nijtmans 2024-05-21 15:03:29 |
Context
2024-05-21
| ||
20:00 | Add tommath-????/zlib-???? to build-info if libtommath/zlib is statically linked check-in: c92cf5f76d user: jan.nijtmans tags: trunk, main | |
15:03 | Merge 8.7. Some int -> Tcl_Size check-in: 1a12a05fa1 user: jan.nijtmans tags: trunk, main | |
14:05 | Fix off-by-one error in tcl::build-info command. Improve spacing check-in: 6924fe0f7b user: jan.nijtmans tags: core-8-branch | |
10:51 | merge 8.7 check-in: 780ab56525 user: sebres tags: trunk, main | |
Changes
Changes to generic/tclBasic.c.
︙ | ︙ | |||
214 215 216 217 218 219 220 | static Tcl_NRPostProc NRCommand; static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); static void TEOV_SwitchVarFrame(Tcl_Interp *interp); static void TEOV_PushExceptionHandlers(Tcl_Interp *interp, | | | | | 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 | static Tcl_NRPostProc NRCommand; static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); static void TEOV_SwitchVarFrame(Tcl_Interp *interp); static void TEOV_PushExceptionHandlers(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int flags); static inline Command * TEOV_LookupCmdFromObj(Tcl_Interp *interp, Tcl_Obj *namePtr, Namespace *lookupNsPtr); static int TEOV_NotFound(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], Namespace *lookupNsPtr); static int TEOV_RunEnterTraces(Tcl_Interp *interp, Command **cmdPtrPtr, Tcl_Obj *commandPtr, Tcl_Size objc, Tcl_Obj *const objv[]); static Tcl_NRPostProc RewindCoroutineCallback; static Tcl_NRPostProc TEOEx_ByteCodeCallback; static Tcl_NRPostProc TEOEx_ListCallback; static Tcl_NRPostProc TEOV_Error; static Tcl_NRPostProc TEOV_Exception; static Tcl_NRPostProc TEOV_NotFoundCallback; |
︙ | ︙ | |||
742 743 744 745 746 747 748 | break; default: /* Boolean test for other identifiers' presence */ arg = TclGetStringFromObj(objv[1], &len); for (p = strchr(buildData, '.'); p++; p = strchr(p, '.')) { if (!strncmp(p, arg, len) && ((p[len] == '.') || (p[len] == '-') || (p[len] == '\0'))) { if (p[len] == '-') { | | | | 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 | break; default: /* Boolean test for other identifiers' presence */ arg = TclGetStringFromObj(objv[1], &len); for (p = strchr(buildData, '.'); p++; p = strchr(p, '.')) { if (!strncmp(p, arg, len) && ((p[len] == '.') || (p[len] == '-') || (p[len] == '\0'))) { if (p[len] == '-') { p += len; q = strchr(++p, '.'); if (!q) { q = p + strlen(p); } memcpy(buf, p, q - p); buf[q - p] = '\0'; Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, TCL_INDEX_NONE)); } else { |
︙ | ︙ | |||
992 993 994 995 996 997 998 | /* * Initialise the rootCallframe. It cannot be allocated on the stack, as * it has to be in place before TclCreateExecEnv tries to use a variable. */ /* This is needed to satisfy GCC 3.3's strict aliasing rules */ | | | 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 | /* * Initialise the rootCallframe. It cannot be allocated on the stack, as * it has to be in place before TclCreateExecEnv tries to use a variable. */ /* This is needed to satisfy GCC 3.3's strict aliasing rules */ framePtr = (CallFrame *)Tcl_Alloc(sizeof(CallFrame)); (void) Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr, (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0); framePtr->objc = 0; iPtr->framePtr = framePtr; iPtr->varFramePtr = framePtr; iPtr->rootFramePtr = framePtr; |
︙ | ︙ | |||
1022 1023 1024 1025 1026 1027 1028 | /* * TIP #285, Script cancellation support. */ TclNewObj(iPtr->asyncCancelMsg); | | | 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 | /* * TIP #285, Script cancellation support. */ TclNewObj(iPtr->asyncCancelMsg); cancelInfo = (CancelInfo *)Tcl_Alloc(sizeof(CancelInfo)); cancelInfo->interp = interp; iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo); cancelInfo->async = iPtr->asyncCancel; cancelInfo->result = NULL; cancelInfo->length = 0; |
︙ | ︙ | |||
1086 1087 1088 1089 1090 1091 1092 | /* * Initialise the thread-specific data ekeko. Note that the thread's alloc * cache was already initialised by the call to alloc the interp struct. */ #if TCL_THREADS && defined(USE_THREAD_ALLOC) | | | 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 | /* * Initialise the thread-specific data ekeko. Note that the thread's alloc * cache was already initialised by the call to alloc the interp struct. */ #if TCL_THREADS && defined(USE_THREAD_ALLOC) iPtr->allocCache = (AllocCache *)TclpGetAllocCache(); #else iPtr->allocCache = NULL; #endif iPtr->pendingObjDataPtr = NULL; iPtr->asyncReadyPtr = TclGetAsyncReadyPtr(); iPtr->deferredCallbacks = NULL; |
︙ | ︙ | |||
1110 1111 1112 1113 1114 1115 1116 | && (cmdInfoPtr->nreProc == NULL)) { Tcl_Panic("builtin command with NULL object command proc and a NULL compile proc"); } hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable, cmdInfoPtr->name, &isNew); if (isNew) { | | | 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 | && (cmdInfoPtr->nreProc == NULL)) { Tcl_Panic("builtin command with NULL object command proc and a NULL compile proc"); } hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable, cmdInfoPtr->name, &isNew); if (isNew) { cmdPtr = (Command *)Tcl_Alloc(sizeof(Command)); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = iPtr->globalNsPtr; cmdPtr->refCount = 1; cmdPtr->cmdEpoch = 0; cmdPtr->compileProc = cmdInfoPtr->compileProc; cmdPtr->proc = NULL; cmdPtr->clientData = cmdPtr; |
︙ | ︙ | |||
1239 1240 1241 1242 1243 1244 1245 | if (nsPtr == NULL) { Tcl_Panic("can't create math operator namespace"); } Tcl_Export(interp, nsPtr, "*", 1); #define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */ memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN); for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){ | | < | 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 | if (nsPtr == NULL) { Tcl_Panic("can't create math operator namespace"); } Tcl_Export(interp, nsPtr, "*", 1); #define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */ memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN); for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){ TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)Tcl_Alloc(sizeof(TclOpCmdClientData)); occdPtr->op = opcmdInfoPtr->name; occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs; occdPtr->expected = opcmdInfoPtr->expected; strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name); cmdPtr = (Command *) Tcl_CreateObjCommand(interp, mathFuncName, opcmdInfoPtr->objProc, occdPtr, DeleteOpCmdClientData); |
︙ | ︙ | |||
1346 1347 1348 1349 1350 1351 1352 | return interp; } static void DeleteOpCmdClientData( void *clientData) { | | | 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 | return interp; } static void DeleteOpCmdClientData( void *clientData) { TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData; Tcl_Free(occdPtr); } /* * --------------------------------------------------------------------- * |
︙ | ︙ | |||
1476 1477 1478 1479 1480 1481 1482 | } Tcl_CreateObjCommand(interp, TclGetString(cmdName), BadEnsembleSubcommand, (void *)unsafePtr, NULL); TclDecrRefCount(cmdName); TclDecrRefCount(hideName); } else { /* | | | | 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 | } Tcl_CreateObjCommand(interp, TclGetString(cmdName), BadEnsembleSubcommand, (void *)unsafePtr, NULL); TclDecrRefCount(cmdName); TclDecrRefCount(hideName); } else { /* * Hide an ensemble main command (for compatibility). */ if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName, unsafePtr->ensembleNsName) != TCL_OK) { Tcl_Panic("problem making '%s' safe: %s", unsafePtr->ensembleNsName, Tcl_GetStringResult(interp)); } |
︙ | ︙ | |||
1559 1560 1561 1562 1563 1564 1565 | { Interp *iPtr = (Interp *) interp; static Tcl_ThreadDataKey assocDataCounterKey; int *assocDataCounterPtr = (int *) Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); int isNew; char buffer[32 + TCL_INTEGER_SPACE]; | | | | 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 | { Interp *iPtr = (Interp *) interp; static Tcl_ThreadDataKey assocDataCounterKey; int *assocDataCounterPtr = (int *) Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); int isNew; char buffer[32 + TCL_INTEGER_SPACE]; AssocData *dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData)); Tcl_HashEntry *hPtr; snprintf(buffer, sizeof(buffer), "Assoc Data Key #%d", *assocDataCounterPtr); (*assocDataCounterPtr)++; if (iPtr->assocData == NULL) { iPtr->assocData = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew); dPtr->proc = proc; dPtr->clientData = clientData; Tcl_SetHashValue(hPtr, dPtr); } |
︙ | ︙ | |||
1613 1614 1615 1616 1617 1618 1619 | hTablePtr = iPtr->assocData; if (hTablePtr == NULL) { return; } for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { | | | 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 | hTablePtr = iPtr->assocData; if (hTablePtr == NULL) { return; } for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) { dPtr = (AssocData *)Tcl_GetHashValue(hPtr); if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) { Tcl_Free(dPtr); Tcl_DeleteHashEntry(hPtr); return; } } } |
︙ | ︙ | |||
1655 1656 1657 1658 1659 1660 1661 | { Interp *iPtr = (Interp *) interp; AssocData *dPtr; Tcl_HashEntry *hPtr; int isNew; if (iPtr->assocData == NULL) { | | | | | 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 | { Interp *iPtr = (Interp *) interp; AssocData *dPtr; Tcl_HashEntry *hPtr; int isNew; if (iPtr->assocData == NULL) { iPtr->assocData = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS); } hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew); if (isNew == 0) { dPtr = (AssocData *)Tcl_GetHashValue(hPtr); } else { dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData)); } dPtr->proc = proc; dPtr->clientData = clientData; Tcl_SetHashValue(hPtr, dPtr); } |
︙ | ︙ | |||
1703 1704 1705 1706 1707 1708 1709 | if (iPtr->assocData == NULL) { return; } hPtr = Tcl_FindHashEntry(iPtr->assocData, name); if (hPtr == NULL) { return; } | | | 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 | if (iPtr->assocData == NULL) { return; } hPtr = Tcl_FindHashEntry(iPtr->assocData, name); if (hPtr == NULL) { return; } dPtr = (AssocData *)Tcl_GetHashValue(hPtr); Tcl_DeleteHashEntry(hPtr); if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); } Tcl_Free(dPtr); } |
︙ | ︙ | |||
1748 1749 1750 1751 1752 1753 1754 | if (iPtr->assocData == NULL) { return NULL; } hPtr = Tcl_FindHashEntry(iPtr->assocData, name); if (hPtr == NULL) { return NULL; } | | | 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 | if (iPtr->assocData == NULL) { return NULL; } hPtr = Tcl_FindHashEntry(iPtr->assocData, name); if (hPtr == NULL) { return NULL; } dPtr = (AssocData *)Tcl_GetHashValue(hPtr); if (procPtr != NULL) { *procPtr = dPtr->proc; } return dPtr->clientData; } /* |
︙ | ︙ | |||
1900 1901 1902 1903 1904 1905 1906 | * TIP #285, Script cancellation support. Delete this interp from the * global hash table of CancelInfo structs. */ Tcl_MutexLock(&cancelLock); hPtr = Tcl_FindHashEntry(&cancelTable, iPtr); if (hPtr != NULL) { | | | 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 | * TIP #285, Script cancellation support. Delete this interp from the * global hash table of CancelInfo structs. */ Tcl_MutexLock(&cancelLock); hPtr = Tcl_FindHashEntry(&cancelTable, iPtr); if (hPtr != NULL) { CancelInfo *cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr); if (cancelInfo != NULL) { if (cancelInfo->result != NULL) { Tcl_Free(cancelInfo->result); } Tcl_Free(cancelInfo); } |
︙ | ︙ | |||
1958 1959 1960 1961 1962 1963 1964 | * to create any new hidden or non-hidden commands. * Tcl_DeleteCommandFromToken will remove the entry from the * hiddenCmdTablePtr. */ hPtr = Tcl_FirstHashEntry(hTablePtr, &search); for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { | | < | | 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 | * to create any new hidden or non-hidden commands. * Tcl_DeleteCommandFromToken will remove the entry from the * hiddenCmdTablePtr. */ hPtr = Tcl_FirstHashEntry(hTablePtr, &search); for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { Tcl_DeleteCommandFromToken(interp, (Tcl_Command)Tcl_GetHashValue(hPtr)); } Tcl_DeleteHashTable(hTablePtr); Tcl_Free(hTablePtr); } if (iPtr->assocData != NULL) { AssocData *dPtr; hTablePtr = iPtr->assocData; /* * Invoke deletion callbacks; note that a callback can create new * callbacks, so we iterate. */ for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search); hPtr != NULL; hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) { dPtr = (AssocData *)Tcl_GetHashValue(hPtr); if (dPtr->proc != NULL) { dPtr->proc(dPtr->clientData, interp); } Tcl_DeleteHashEntry(hPtr); Tcl_Free(dPtr); } Tcl_DeleteHashTable(hTablePtr); |
︙ | ︙ | |||
2064 2065 2066 2067 2068 2069 2070 | * TIP #280 - Release the arrays for ByteCode/Proc extension, and * contents. */ for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { | | | 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 | * TIP #280 - Release the arrays for ByteCode/Proc extension, and * contents. */ for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { CmdFrame *cfPtr = (CmdFrame *)Tcl_GetHashValue(hPtr); Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr); procPtr->iPtr = NULL; if (cfPtr) { if (cfPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(cfPtr->data.eval.path); } |
︙ | ︙ | |||
2088 2089 2090 2091 2092 2093 2094 | /* * See also tclCompile.c, TclCleanupByteCode */ for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { | | | 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 | /* * See also tclCompile.c, TclCleanupByteCode */ for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { ExtCmdLoc *eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hPtr); if (eclPtr->type == TCL_LOCATION_SOURCE) { Tcl_DecrRefCount(eclPtr->path); } for (i=0; i<eclPtr->nuloc; i++) { Tcl_Free(eclPtr->loc[i].line); } |
︙ | ︙ | |||
2216 2217 2218 2219 2220 2221 2222 | * the source, in order to avoid potential confusion, lets prevent "::" in * the token too. - dl */ if (strstr(hiddenCmdToken, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use namespace qualifiers in hidden command" | | | 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 | * the source, in order to avoid potential confusion, lets prevent "::" in * the token too. - dl */ if (strstr(hiddenCmdToken, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use namespace qualifiers in hidden command" " token (rename)", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL); return TCL_ERROR; } /* * Find the command to hide. An error is returned if cmdName can't be * found. Look up the command only from the global namespace. Full path of |
︙ | ︙ | |||
2241 2242 2243 2244 2245 2246 2247 | /* * Check that the command is really in global namespace */ if (cmdPtr->nsPtr != iPtr->globalNsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only hide global namespace commands (use rename then hide)", | | | | 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 | /* * Check that the command is really in global namespace */ if (cmdPtr->nsPtr != iPtr->globalNsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only hide global namespace commands (use rename then hide)", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } /* * Initialize the hidden command table if necessary. */ hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr; if (hiddenCmdTablePtr == NULL) { hiddenCmdTablePtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS); iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr; } /* * It is an error to move an exposed command to a hidden command with * hiddenCmdToken if a hidden command with the name hiddenCmdToken already |
︙ | ︙ | |||
2371 2372 2373 2374 2375 2376 2377 | * trying to do an expose and a rename (to another namespace) at the same * time). */ if (strstr(cmdName, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot expose to a namespace (use expose to toplevel, then rename)", | | | | | 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 | * trying to do an expose and a rename (to another namespace) at the same * time). */ if (strstr(cmdName, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot expose to a namespace (use expose to toplevel, then rename)", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } /* * Get the command from the hidden command table: */ hPtr = NULL; hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr; if (hiddenCmdTablePtr != NULL) { hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken); } if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "unknown hidden command \"%s\"", hiddenCmdToken)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", hiddenCmdToken, (char *)NULL); return TCL_ERROR; } cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * Check that we have a true global namespace command (enforced by * Tcl_HideCommand but let's double check. (If it was not, we would not * really know how to handle it). */ if (cmdPtr->nsPtr != iPtr->globalNsPtr) { /* * This case is theoretically impossible, we might rather Tcl_Panic * than 'nicely' erroring out ? */ Tcl_SetObjResult(interp, Tcl_NewStringObj( "trying to expose a non-global command namespace command", TCL_INDEX_NONE)); return TCL_ERROR; } /* * This is the global table. */ |
︙ | ︙ | |||
2588 2589 2590 2591 2592 2593 2594 | break; } /* * An existing command conflicts. Try to delete it... */ | | | 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 | break; } /* * An existing command conflicts. Try to delete it... */ cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * Be careful to preserve any existing import links so we can restore * them down below. That way, you can redefine a command and its * import status will remain intact. */ |
︙ | ︙ | |||
2643 2644 2645 2646 2647 2648 2649 | * However, we do not need to recompute this just yet; next time we * need the info will be soon enough. */ TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } | | | 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 | * However, we do not need to recompute this just yet; next time we * need the info will be soon enough. */ TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } cmdPtr = (Command *)Tcl_Alloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = nsPtr; cmdPtr->refCount = 1; cmdPtr->cmdEpoch = 0; cmdPtr->compileProc = NULL; cmdPtr->objProc = InvokeStringCommand; |
︙ | ︙ | |||
2670 2671 2672 2673 2674 2675 2676 | * all of these references to point to the new command. */ if (oldRefPtr != NULL) { cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { Command *refCmdPtr = oldRefPtr->importedCmdPtr; | | | 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 | * all of these references to point to the new command. */ if (oldRefPtr != NULL) { cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { Command *refCmdPtr = oldRefPtr->importedCmdPtr; dataPtr = (ImportedCmdData *)refCmdPtr->objClientData; dataPtr->realCmdPtr = cmdPtr; oldRefPtr = oldRefPtr->nextPtr; } } /* * We just created a command, so in its namespace and all of its parent |
︙ | ︙ | |||
2763 2764 2765 2766 2767 2768 2769 | * name. */ void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { | | | 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 | * name. */ void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); info->proc = proc; info->clientData = clientData; info->deleteProc = deleteProc; info->deleteData = clientData; return Tcl_CreateObjCommand(interp, cmdName, (proc ? cmdWrapperProc : NULL), |
︙ | ︙ | |||
2868 2869 2870 2871 2872 2873 2874 | break; } /* * An existing command conflicts. Try to delete it... */ | | | 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 | break; } /* * An existing command conflicts. Try to delete it... */ cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * Command already exists; delete it. Be careful to preserve any * existing import links so we can restore them down below. That way, * you can redefine a command and its import status will remain * intact. */ |
︙ | ︙ | |||
2932 2933 2934 2935 2936 2937 2938 | * However, we do not need to recompute this just yet; next time we * need the info will be soon enough. */ TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } | | | 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 | * However, we do not need to recompute this just yet; next time we * need the info will be soon enough. */ TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); } cmdPtr = (Command *)Tcl_Alloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; cmdPtr->nsPtr = nsPtr; cmdPtr->refCount = 1; cmdPtr->cmdEpoch = 0; cmdPtr->compileProc = NULL; cmdPtr->objProc = proc; |
︙ | ︙ | |||
2960 2961 2962 2963 2964 2965 2966 | */ if (oldRefPtr != NULL) { cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { Command *refCmdPtr = oldRefPtr->importedCmdPtr; | | | 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 | */ if (oldRefPtr != NULL) { cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { Command *refCmdPtr = oldRefPtr->importedCmdPtr; dataPtr = (ImportedCmdData*)refCmdPtr->objClientData; cmdPtr->refCount++; TclCleanupCommandMacro(dataPtr->realCmdPtr); dataPtr->realCmdPtr = cmdPtr; oldRefPtr = oldRefPtr->nextPtr; } } |
︙ | ︙ | |||
3002 3003 3004 3005 3006 3007 3008 | * InvokeStringCommand allocates and frees storage. * *---------------------------------------------------------------------- */ int InvokeStringCommand( | | | | | 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 | * InvokeStringCommand allocates and frees storage. * *---------------------------------------------------------------------- */ int InvokeStringCommand( void *clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Command *cmdPtr = (Command *)clientData; int i, result; const char **argv = (const char **) TclStackAlloc(interp, (objc + 1) * sizeof(char *)); for (i = 0; i < objc; i++) { argv[i] = TclGetString(objv[i]); } |
︙ | ︙ | |||
3189 3190 3191 3192 3193 3194 3195 | * The trace function needs to get a fully qualified name for old and new * commands [Tcl bug #651271], or else there's no way for the trace * function to get the namespace from which the old command is being * renamed! */ Tcl_DStringInit(&newFullName); | | | | 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204 3205 | * The trace function needs to get a fully qualified name for old and new * commands [Tcl bug #651271], or else there's no way for the trace * function to get the namespace from which the old command is being * renamed! */ Tcl_DStringInit(&newFullName); Tcl_DStringAppend(&newFullName, newNsPtr->fullName, TCL_INDEX_NONE); if (newNsPtr != iPtr->globalNsPtr) { TclDStringAppendLiteral(&newFullName, "::"); } Tcl_DStringAppend(&newFullName, newTail, TCL_INDEX_NONE); cmdPtr->refCount++; CallCommandTraces(iPtr, cmdPtr, TclGetString(oldFullName), Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME); Tcl_DStringFree(&newFullName); /* * The new command name is okay, so remove the command from its current |
︙ | ︙ | |||
3296 3297 3298 3299 3300 3301 3302 | invokeObj2Command( void *clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; | | | 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 | invokeObj2Command( void *clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; Command *cmdPtr = (Command *)clientData; if (objc > INT_MAX) { return TclCommandWordLimitError(interp, objc); } if (cmdPtr->objProc != NULL) { result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv); } else { |
︙ | ︙ | |||
3370 3371 3372 3373 3374 3375 3376 | } info->clientData = infoPtr->objClientData2; } info->deleteProc = infoPtr->deleteProc; info->deleteData = infoPtr->deleteData; } else { if ((infoPtr->objProc2 != NULL) && (infoPtr->objProc2 != cmdWrapper2Proc)) { | | < | 3368 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 | } info->clientData = infoPtr->objClientData2; } info->deleteProc = infoPtr->deleteProc; info->deleteData = infoPtr->deleteData; } else { if ((infoPtr->objProc2 != NULL) && (infoPtr->objProc2 != cmdWrapper2Proc)) { CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); info->proc = infoPtr->objProc2; info->clientData = infoPtr->objClientData2; info->nreProc = NULL; info->deleteProc = infoPtr->deleteProc; info->deleteData = infoPtr->deleteData; cmdPtr->deleteProc = cmdWrapperDeleteProc; cmdPtr->deleteData = info; |
︙ | ︙ | |||
3462 3463 3464 3465 3466 3467 3468 | infoPtr->isNativeObjectProc = (cmdPtr->objProc != InvokeStringCommand); infoPtr->objProc = cmdPtr->objProc; infoPtr->objClientData = cmdPtr->objClientData; infoPtr->proc = cmdPtr->proc; infoPtr->clientData = cmdPtr->clientData; if (cmdPtr->deleteProc == cmdWrapperDeleteProc) { | | | 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 3469 3470 3471 3472 3473 | infoPtr->isNativeObjectProc = (cmdPtr->objProc != InvokeStringCommand); infoPtr->objProc = cmdPtr->objProc; infoPtr->objClientData = cmdPtr->objClientData; infoPtr->proc = cmdPtr->proc; infoPtr->clientData = cmdPtr->clientData; if (cmdPtr->deleteProc == cmdWrapperDeleteProc) { CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData; infoPtr->deleteProc = info->deleteProc; infoPtr->deleteData = info->deleteData; infoPtr->objProc2 = info->proc; infoPtr->objClientData2 = info->clientData; if (cmdPtr->objProc == cmdWrapperProc) { infoPtr->isNativeObjectProc = 2; } |
︙ | ︙ | |||
3516 3517 3518 3519 3520 3521 3522 | * interpreter began to be deleted, so there isn't really any command. * Just return an empty string. */ return ""; } | | | 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 3523 3524 3525 3526 3527 | * interpreter began to be deleted, so there isn't really any command. * Just return an empty string. */ return ""; } return (const char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); } /* *---------------------------------------------------------------------- * * Tcl_GetCommandFullName -- * |
︙ | ︙ | |||
3560 3561 3562 3563 3564 3565 3566 | /* * Add the full name of the containing namespace, followed by the "::" * separator, and the command name. */ if ((cmdPtr != NULL) && TclRoutineHasName(cmdPtr)) { if (cmdPtr->nsPtr != NULL) { | | < | | | 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 | /* * Add the full name of the containing namespace, followed by the "::" * separator, and the command name. */ if ((cmdPtr != NULL) && TclRoutineHasName(cmdPtr)) { if (cmdPtr->nsPtr != NULL) { Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, TCL_INDEX_NONE); if (cmdPtr->nsPtr != iPtr->globalNsPtr) { Tcl_AppendToObj(objPtr, "::", 2); } } if (cmdPtr->hPtr != NULL) { name = (char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); Tcl_AppendToObj(objPtr, name, TCL_INDEX_NONE); } } } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
3946 3947 3948 3949 3950 3951 3952 | * Transfers a message from the cancellation message to the interpreter. * *---------------------------------------------------------------------- */ static int CancelEvalProc( | | | | 3942 3943 3944 3945 3946 3947 3948 3949 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 | * Transfers a message from the cancellation message to the interpreter. * *---------------------------------------------------------------------- */ static int CancelEvalProc( void *clientData, /* Interp to cancel the script in progress. */ TCL_UNUSED(Tcl_Interp *), int code) /* Current return code from command. */ { CancelInfo *cancelInfo = (CancelInfo *)clientData; Interp *iPtr; if (cancelInfo != NULL) { Tcl_MutexLock(&cancelLock); iPtr = (Interp *) cancelInfo->interp; if (iPtr != NULL) { |
︙ | ︙ | |||
4024 4025 4026 4027 4028 4029 4030 | * deleted or when the last ByteCode referring to it is freed. * *---------------------------------------------------------------------- */ void TclCleanupCommand( | | | 4020 4021 4022 4023 4024 4025 4026 4027 4028 4029 4030 4031 4032 4033 4034 | * deleted or when the last ByteCode referring to it is freed. * *---------------------------------------------------------------------- */ void TclCleanupCommand( Command *cmdPtr) /* Points to the Command structure to * be freed. */ { if (cmdPtr->refCount-- <= 1) { Tcl_Free(cmdPtr); } } |
︙ | ︙ | |||
4069 4070 4071 4072 4073 4074 4075 | /* * If the interpreter has been deleted, return an error. */ if (iPtr->flags & DELETED) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 4065 4066 4067 4068 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 | /* * If the interpreter has been deleted, return an error. */ if (iPtr->flags & DELETED) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "attempt to call eval in deleted interpreter", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "IDELETE", "attempt to call eval in deleted interpreter", (char *)NULL); return TCL_ERROR; } if (iPtr->execEnvPtr->rewind) { return TCL_ERROR; |
︙ | ︙ | |||
4098 4099 4100 4101 4102 4103 4104 | */ if ((iPtr->numLevels <= iPtr->maxNestingDepth)) { return TCL_OK; } Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 | */ if ((iPtr->numLevels <= iPtr->maxNestingDepth)) { return TCL_OK; } Tcl_SetObjResult(interp, Tcl_NewStringObj( "too many nested evaluations (infinite loop?)", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", (char *)NULL); return TCL_ERROR; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
4232 4233 4234 4235 4236 4237 4238 | } else { id = "ICANCEL"; if (length == 0) { message = "eval canceled"; } } | | | 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 | } else { id = "ICANCEL"; if (length == 0) { message = "eval canceled"; } } Tcl_SetObjResult(interp, Tcl_NewStringObj(message, TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL); } /* * Return TCL_ERROR to the caller (not necessarily just the Tcl core * itself) that indicates further processing of the script or command in * progress should halt gracefully and as soon as possible. |
︙ | ︙ | |||
4303 4304 4305 4306 4307 4308 4309 | if (hPtr == NULL) { /* * No CancelInfo record for this interpreter. */ goto done; } | | | < | 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 | if (hPtr == NULL) { /* * No CancelInfo record for this interpreter. */ goto done; } cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr); /* * Populate information needed by the interpreter thread to fulfill the * cancellation request. Currently, clientData is ignored. If the * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not * allowed to catch the script cancellation because the evaluation stack * for the interp is completely unwound. */ if (resultObjPtr != NULL) { result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length); cancelInfo->result = (char *)Tcl_Realloc(cancelInfo->result, cancelInfo->length); memcpy(cancelInfo->result, result, cancelInfo->length); TclDecrRefCount(resultObjPtr); /* Discard their result object. */ } else { cancelInfo->result = NULL; cancelInfo->length = 0; } cancelInfo->clientData = clientData; |
︙ | ︙ | |||
4436 4437 4438 4439 4440 4441 4442 | static int EvalObjvCore( void *data[], Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { | | | | | 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 | static int EvalObjvCore( void *data[], Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { Command *cmdPtr = NULL, *preCmdPtr = (Command *)data[0]; int flags = PTR2INT(data[1]); Tcl_Size objc = PTR2INT(data[2]); Tcl_Obj **objv = (Tcl_Obj **)data[3]; Interp *iPtr = (Interp *) interp; Namespace *lookupNsPtr = NULL; int enterTracesDone = 0; /* * Push records for task to be done on return, in INVERSE order. First, if * needed, the exception handlers (as they should happen last). |
︙ | ︙ | |||
4596 4597 4598 4599 4600 4601 4602 | static int Dispatch( void *data[], Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { | | | | 4591 4592 4593 4594 4595 4596 4597 4598 4599 4600 4601 4602 4603 4604 4605 4606 4607 4608 | static int Dispatch( void *data[], Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *)data[0]; void *clientData = data[1]; Tcl_Size objc = PTR2INT(data[2]); Tcl_Obj **objv = (Tcl_Obj **)data[3]; Interp *iPtr = (Interp *) interp; #ifdef USE_DTRACE if (TCL_DTRACE_CMD_ARGS_ENABLED()) { const char *a[10]; Tcl_Size i = 0; |
︙ | ︙ | |||
4670 4671 4672 4673 4674 4675 4676 | iPtr->numLevels--; /* * If there is a tailcall, schedule it next */ if (data[1] && (data[1] != INT2PTR(1))) { | | | 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 | iPtr->numLevels--; /* * If there is a tailcall, schedule it next */ if (data[1] && (data[1] != INT2PTR(1))) { listPtr = (Tcl_Obj *)data[1]; data[1] = NULL; TclNRAddCallback(interp, TclNRTailcallEval, listPtr, NULL, NULL, NULL); } /* OPT ?? * Do not interrupt a series of cleanups with async or limit checks: |
︙ | ︙ | |||
4711 4712 4713 4714 4715 4716 4717 | * *---------------------------------------------------------------------- */ static void TEOV_PushExceptionHandlers( Tcl_Interp *interp, | | | 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 | * *---------------------------------------------------------------------- */ static void TEOV_PushExceptionHandlers( Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int flags) { Interp *iPtr = (Interp *) interp; /* * If any error processing is necessary, push the appropriate records. |
︙ | ︙ | |||
4764 4765 4766 4767 4768 4769 4770 | static int TEOV_RestoreVarFrame( void *data[], Tcl_Interp *interp, int result) { | | | 4759 4760 4761 4762 4763 4764 4765 4766 4767 4768 4769 4770 4771 4772 4773 | static int TEOV_RestoreVarFrame( void *data[], Tcl_Interp *interp, int result) { ((Interp *) interp)->varFramePtr = (CallFrame *)data[0]; return result; } static int TEOV_Exception( void *data[], Tcl_Interp *interp, |
︙ | ︙ | |||
4807 4808 4809 4810 4811 4812 4813 | Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr; const char *cmdString; Tcl_Size cmdLen; | | | | | 4802 4803 4804 4805 4806 4807 4808 4809 4810 4811 4812 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 4835 4836 4837 4838 | Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr; const char *cmdString; Tcl_Size cmdLen; Tcl_Size objc = PTR2INT(data[0]); Tcl_Obj **objv = (Tcl_Obj **)data[1]; if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { /* * If there was an error, a command string will be needed for the * error log: get it out of the itemPtr. The details depend on the * type. */ listPtr = Tcl_NewListObj(objc, objv); cmdString = TclGetStringFromObj(listPtr, &cmdLen); Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen); Tcl_DecrRefCount(listPtr); } iPtr->flags &= ~ERR_ALREADY_LOGGED; return result; } static int TEOV_NotFound( Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], Namespace *lookupNsPtr) { Command * cmdPtr; Interp *iPtr = (Interp *) interp; Tcl_Size i, newObjc, handlerObjc; Tcl_Obj **newObjv, **handlerObjv; |
︙ | ︙ | |||
4870 4871 4872 4873 4874 4875 4876 | * to hold both the handler prefix and all words of the command invocation * itself. */ TclListObjGetElements(NULL, currNsPtr->unknownHandlerPtr, &handlerObjc, &handlerObjv); newObjc = objc + handlerObjc; | | | 4865 4866 4867 4868 4869 4870 4871 4872 4873 4874 4875 4876 4877 4878 4879 | * to hold both the handler prefix and all words of the command invocation * itself. */ TclListObjGetElements(NULL, currNsPtr->unknownHandlerPtr, &handlerObjc, &handlerObjv); newObjc = objc + handlerObjc; newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc); /* * Copy command prefix from unknown handler and add on the real command's * full argument list. Note that we only use memcpy() once because we have * to increment the reference count of all the handler arguments anyway. */ |
︙ | ︙ | |||
4930 4931 4932 4933 4934 4935 4936 | static int TEOV_NotFoundCallback( void *data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; | | | | | | 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 4938 4939 4940 4941 4942 4943 | static int TEOV_NotFoundCallback( void *data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Size objc = PTR2INT(data[0]); Tcl_Obj **objv = (Tcl_Obj **)data[1]; Namespace *savedNsPtr = (Namespace *)data[2]; Tcl_Size i; if (savedNsPtr) { iPtr->varFramePtr->nsPtr = savedNsPtr; } /* * Release any resources we locked and allocated during the handler call. |
︙ | ︙ | |||
4957 4958 4959 4960 4961 4962 4963 | } static int TEOV_RunEnterTraces( Tcl_Interp *interp, Command **cmdPtrPtr, Tcl_Obj *commandPtr, | | | 4952 4953 4954 4955 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 | } static int TEOV_RunEnterTraces( Tcl_Interp *interp, Command **cmdPtrPtr, Tcl_Obj *commandPtr, Tcl_Size objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; Command *cmdPtr = *cmdPtrPtr; Tcl_Size length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch; int traceCode = TCL_OK; const char *command = TclGetStringFromObj(commandPtr, &length); |
︙ | ︙ | |||
5011 5012 5013 5014 5015 5016 5017 | TEOV_RunLeaveTraces( void *data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; int traceCode = TCL_OK; | | | | | | 5006 5007 5008 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 | TEOV_RunLeaveTraces( void *data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; int traceCode = TCL_OK; Tcl_Size objc = PTR2INT(data[0]); Tcl_Obj *commandPtr = (Tcl_Obj *)data[1]; Command *cmdPtr = (Command *)data[2]; Tcl_Obj **objv = (Tcl_Obj **)data[3]; Tcl_Size length; const char *command = TclGetStringFromObj(commandPtr, &length); if (!(cmdPtr->flags & CMD_DYING)) { if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) { traceCode = TclCheckExecutionTraces(interp, command, length, cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv); |
︙ | ︙ | |||
5189 5190 5191 5192 5193 5194 5195 | int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); int gotParse = 0; Tcl_Size i, objectsUsed = 0; /* These variables keep track of how much * state has been allocated while evaluating * the script, so that it can be freed * properly if an error occurs. */ | | < | < | | < | < | 5184 5185 5186 5187 5188 5189 5190 5191 5192 5193 5194 5195 5196 5197 5198 5199 5200 5201 5202 | int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS); int gotParse = 0; Tcl_Size i, objectsUsed = 0; /* These variables keep track of how much * state has been allocated while evaluating * the script, so that it can be freed * properly if an error occurs. */ Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); CmdFrame *eeFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); Tcl_Obj **stackObjArray = (Tcl_Obj **)TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *)); int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int)); Tcl_Size *linesStack = (Tcl_Size *)TclStackAlloc(interp, minObjs * sizeof(Tcl_Size)); /* TIP #280 Structures for tracking of command * locations. */ Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible * continuation lines. Initialized only if the * caller gave us a table of locations to * track, via scriptCLLocPtr. It always refers * to the table entry holding the location of |
︙ | ︙ | |||
5333 5334 5335 5336 5337 5338 5339 | Tcl_Size numWords = parsePtr->numWords; /* * Generate an array of objects for the words of the command. */ if (numWords > minObjs) { | | | 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 | Tcl_Size numWords = parsePtr->numWords; /* * Generate an array of objects for the words of the command. */ if (numWords > minObjs) { expand = (int *)Tcl_Alloc(numWords * sizeof(int)); objvSpace = (Tcl_Obj **) Tcl_Alloc(numWords * sizeof(Tcl_Obj *)); lineSpace = (Tcl_Size *) Tcl_Alloc(numWords * sizeof(Tcl_Size)); } expandRequested = 0; objv = objvSpace; |
︙ | ︙ | |||
5391 5392 5393 5394 5395 5396 5397 | &numElements); if (code == TCL_ERROR) { /* * Attempt to expand a non-list. */ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( | | < | 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 | &numElements); if (code == TCL_ERROR) { /* * Attempt to expand a non-list. */ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n (expanding word %" TCL_SIZE_MODIFIER "d)", objectsUsed)); Tcl_DecrRefCount(objv[objectsUsed]); break; } expandRequested = 1; expand[objectsUsed] = 1; additionalObjsCount = (numElements ? numElements : 1); |
︙ | ︙ | |||
5435 5436 5437 5438 5439 5440 5441 | Tcl_Obj **copy = objvSpace; Tcl_Size *lcopy = lineSpace; Tcl_Size wordIdx = numWords; Tcl_Size objIdx = objectsNeeded - 1; if ((numWords > minObjs) || (objectsNeeded > minObjs)) { | | < | < | 5425 5426 5427 5428 5429 5430 5431 5432 5433 5434 5435 5436 5437 5438 5439 5440 | Tcl_Obj **copy = objvSpace; Tcl_Size *lcopy = lineSpace; Tcl_Size wordIdx = numWords; Tcl_Size objIdx = objectsNeeded - 1; if ((numWords > minObjs) || (objectsNeeded > minObjs)) { objv = objvSpace = (Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *)); lines = lineSpace = (Tcl_Size *)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Size)); } objectsUsed = 0; while (wordIdx--) { if (expand[wordIdx]) { Tcl_Size numElements; Tcl_Obj **elements, *temp = copy[wordIdx]; |
︙ | ︙ | |||
5732 5733 5734 5735 5736 5737 5738 | *---------------------------------------------------------------------- */ void TclArgumentEnter( Tcl_Interp *interp, Tcl_Obj **objv, | | | > | 5720 5721 5722 5723 5724 5725 5726 5727 5728 5729 5730 5731 5732 5733 5734 5735 5736 5737 5738 5739 | *---------------------------------------------------------------------- */ void TclArgumentEnter( Tcl_Interp *interp, Tcl_Obj **objv, Tcl_Size objc, CmdFrame *cfPtr) { Interp *iPtr = (Interp *) interp; int isNew; Tcl_Size i; Tcl_HashEntry *hPtr; CFWord *cfwPtr; for (i = 1; i < objc; i++) { /* * Ignore argument words without line information (= dynamic). If they * are variables they may have location information associated with |
︙ | ︙ | |||
5759 5760 5761 5762 5763 5764 5765 | hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &isNew); if (isNew) { /* * The word is not on the stack yet, remember the current location * and initialize references. */ | | | | 5748 5749 5750 5751 5752 5753 5754 5755 5756 5757 5758 5759 5760 5761 5762 5763 5764 5765 5766 5767 5768 5769 5770 5771 5772 5773 | hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &isNew); if (isNew) { /* * The word is not on the stack yet, remember the current location * and initialize references. */ cfwPtr = (CFWord *)Tcl_Alloc(sizeof(CFWord)); cfwPtr->framePtr = cfPtr; cfwPtr->word = i; cfwPtr->refCount = 1; Tcl_SetHashValue(hPtr, cfwPtr); } else { /* * The word is already on the stack, its current location is not * relevant. Just remember the reference to prevent early removal. */ cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); cfwPtr->refCount++; } } } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
5800 5801 5802 5803 5804 5805 5806 | *---------------------------------------------------------------------- */ void TclArgumentRelease( Tcl_Interp *interp, Tcl_Obj **objv, | | | | | 5789 5790 5791 5792 5793 5794 5795 5796 5797 5798 5799 5800 5801 5802 5803 5804 5805 5806 5807 5808 5809 5810 5811 5812 5813 5814 5815 | *---------------------------------------------------------------------- */ void TclArgumentRelease( Tcl_Interp *interp, Tcl_Obj **objv, Tcl_Size objc) { Interp *iPtr = (Interp *) interp; Tcl_Size i; for (i = 1; i < objc; i++) { CFWord *cfwPtr; Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, objv[i]); if (!hPtr) { continue; } cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); if (cfwPtr->refCount-- > 1) { continue; } Tcl_Free(cfwPtr); Tcl_DeleteHashEntry(hPtr); |
︙ | ︙ | |||
5847 5848 5849 5850 5851 5852 5853 | *---------------------------------------------------------------------- */ void TclArgumentBCEnter( Tcl_Interp *interp, Tcl_Obj *objv[], | | | | | 5836 5837 5838 5839 5840 5841 5842 5843 5844 5845 5846 5847 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 5863 5864 5865 5866 | *---------------------------------------------------------------------- */ void TclArgumentBCEnter( Tcl_Interp *interp, Tcl_Obj *objv[], Tcl_Size objc, void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, Tcl_Size pc) { ExtCmdLoc *eclPtr; Tcl_Size word; ECL *ePtr; CFWordBC *lastPtr = NULL; Interp *iPtr = (Interp *) interp; Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); if (!hePtr) { return; } eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr); ePtr = &eclPtr->loc[cmd]; /* * ePtr->nline is the number of words originally parsed. * * objc is the number of elements getting invoked. * |
︙ | ︙ | |||
5899 5900 5901 5902 5903 5904 5905 | */ for (word = 1; word < objc; word++) { if (ePtr->line[word] >= 0) { int isNew; Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, objv[word], &isNew); | | | 5888 5889 5890 5891 5892 5893 5894 5895 5896 5897 5898 5899 5900 5901 5902 | */ for (word = 1; word < objc; word++) { if (ePtr->line[word] >= 0) { int isNew; Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, objv[word], &isNew); CFWordBC *cfwPtr = (CFWordBC *)Tcl_Alloc(sizeof(CFWordBC)); cfwPtr->framePtr = cfPtr; cfwPtr->obj = objv[word]; cfwPtr->pc = pc; cfwPtr->word = word; cfwPtr->nextPtr = lastPtr; lastPtr = cfwPtr; |
︙ | ︙ | |||
5923 5924 5925 5926 5927 5928 5929 | /* * The object is already on the stack, however it may have * a different location now (literal sharing may map * multiple location to a single Tcl_Obj*. Save the old * information in the new structure. */ | | | 5912 5913 5914 5915 5916 5917 5918 5919 5920 5921 5922 5923 5924 5925 5926 | /* * The object is already on the stack, however it may have * a different location now (literal sharing may map * multiple location to a single Tcl_Obj*. Save the old * information in the new structure. */ cfwPtr->prevPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); } Tcl_SetHashValue(hPtr, cfwPtr); } } /* for */ cfPtr->litarg = lastPtr; |
︙ | ︙ | |||
5965 5966 5967 5968 5969 5970 5971 | Interp *iPtr = (Interp *) interp; CFWordBC *cfwPtr = (CFWordBC *) cfPtr->litarg; while (cfwPtr) { CFWordBC *nextPtr = cfwPtr->nextPtr; Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, cfwPtr->obj); | | | 5954 5955 5956 5957 5958 5959 5960 5961 5962 5963 5964 5965 5966 5967 5968 | Interp *iPtr = (Interp *) interp; CFWordBC *cfwPtr = (CFWordBC *) cfPtr->litarg; while (cfwPtr) { CFWordBC *nextPtr = cfwPtr->nextPtr; Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, cfwPtr->obj); CFWordBC *xPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); if (xPtr != cfwPtr) { Tcl_Panic("TclArgumentBC Enter/Release Mismatch"); } if (cfwPtr->prevPtr) { Tcl_SetHashValue(hPtr, cfwPtr->prevPtr); |
︙ | ︙ | |||
6031 6032 6033 6034 6035 6036 6037 | /* * First look for location information recorded in the argument * stack. That is nearest. */ hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, obj); if (hPtr) { | | | | 6020 6021 6022 6023 6024 6025 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036 6037 6038 6039 6040 6041 6042 6043 6044 6045 6046 6047 6048 | /* * First look for location information recorded in the argument * stack. That is nearest. */ hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, obj); if (hPtr) { CFWord *cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr); *wordPtr = cfwPtr->word; *cfPtrPtr = cfwPtr->framePtr; return; } /* * Check if the Tcl_Obj has location information as a bytecode literal, in * that stack. */ hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, obj); if (hPtr) { CFWordBC *cfwPtr = (CFWordBC *)Tcl_GetHashValue(hPtr); framePtr = cfwPtr->framePtr; framePtr->data.tebc.pc = (char *) (((ByteCode *) framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc); *cfPtrPtr = cfwPtr->framePtr; *wordPtr = cfwPtr->word; return; |
︙ | ︙ | |||
6184 6185 6186 6187 6188 6189 6190 | * and TclInitCompileEnv), are special-cased to use the proper * line number directly instead of accessing the 'line' array. * * Note that we use (word==INTMIN) to signal that no command frame * should be pushed, as needed by alias and ensemble redirections. */ | | | 6173 6174 6175 6176 6177 6178 6179 6180 6181 6182 6183 6184 6185 6186 6187 | * and TclInitCompileEnv), are special-cased to use the proper * line number directly instead of accessing the 'line' array. * * Note that we use (word==INTMIN) to signal that no command frame * should be pushed, as needed by alias and ensemble redirections. */ eoFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); eoFramePtr->nline = 0; eoFramePtr->line = NULL; eoFramePtr->type = TCL_LOCATION_EVAL; eoFramePtr->level = (iPtr->cmdFramePtr == NULL? 1 : iPtr->cmdFramePtr->level + 1); eoFramePtr->framePtr = iPtr->framePtr; |
︙ | ︙ | |||
6293 6294 6295 6296 6297 6298 6299 | static int TEOEx_ByteCodeCallback( void *data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; | | | | 6282 6283 6284 6285 6286 6287 6288 6289 6290 6291 6292 6293 6294 6295 6296 6297 | static int TEOEx_ByteCodeCallback( void *data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; CallFrame *savedVarFramePtr = (CallFrame *)data[0]; Tcl_Obj *objPtr = (Tcl_Obj *)data[1]; int allowExceptions = PTR2INT(data[2]); if (iPtr->numLevels == 0) { if (result == TCL_RETURN) { result = TclUpdateReturnInfo(iPtr); } if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) { |
︙ | ︙ | |||
6339 6340 6341 6342 6343 6344 6345 | static int TEOEx_ListCallback( void *data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; | | | | | 6328 6329 6330 6331 6332 6333 6334 6335 6336 6337 6338 6339 6340 6341 6342 6343 6344 | static int TEOEx_ListCallback( void *data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr = (Tcl_Obj *)data[0]; CmdFrame *eoFramePtr = (CmdFrame *)data[1]; Tcl_Obj *objPtr = (Tcl_Obj *)data[2]; /* * Remove the cmdFrame */ if (eoFramePtr) { iPtr->cmdFramePtr = eoFramePtr->nextPtr; |
︙ | ︙ | |||
6388 6389 6390 6391 6392 6393 6394 | int returnCode) /* The unexpected result code. */ { char buf[TCL_INTEGER_SPACE]; Tcl_ResetResult(interp); if (returnCode == TCL_BREAK) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | | 6377 6378 6379 6380 6381 6382 6383 6384 6385 6386 6387 6388 6389 6390 6391 6392 6393 6394 | int returnCode) /* The unexpected result code. */ { char buf[TCL_INTEGER_SPACE]; Tcl_ResetResult(interp); if (returnCode == TCL_BREAK) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "invoked \"break\" outside of a loop", TCL_INDEX_NONE)); } else if (returnCode == TCL_CONTINUE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "invoked \"continue\" outside of a loop", TCL_INDEX_NONE)); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "command returned bad code: %d", returnCode)); } snprintf(buf, sizeof(buf), "%d", returnCode); Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, (char *)NULL); } |
︙ | ︙ | |||
6437 6438 6439 6440 6441 6442 6443 | if (*exprstring == '\0') { /* * Legacy compatibility - return 0 for the zero-length string. */ *ptr = 0; } else { | | | 6426 6427 6428 6429 6430 6431 6432 6433 6434 6435 6436 6437 6438 6439 6440 | if (*exprstring == '\0') { /* * Legacy compatibility - return 0 for the zero-length string. */ *ptr = 0; } else { exprPtr = Tcl_NewStringObj(exprstring, TCL_INDEX_NONE); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprLongObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); } return result; } |
︙ | ︙ | |||
6462 6463 6464 6465 6466 6467 6468 | if (*exprstring == '\0') { /* * Legacy compatibility - return 0 for the zero-length string. */ *ptr = 0.0; } else { | | | 6451 6452 6453 6454 6455 6456 6457 6458 6459 6460 6461 6462 6463 6464 6465 | if (*exprstring == '\0') { /* * Legacy compatibility - return 0 for the zero-length string. */ *ptr = 0.0; } else { exprPtr = Tcl_NewStringObj(exprstring, TCL_INDEX_NONE); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprDoubleObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); /* Discard the expression object. */ } return result; } |
︙ | ︙ | |||
6487 6488 6489 6490 6491 6492 6493 | * An empty string. Just set the result boolean to 0 (false). */ *ptr = 0; return TCL_OK; } else { int result; | | | 6476 6477 6478 6479 6480 6481 6482 6483 6484 6485 6486 6487 6488 6489 6490 | * An empty string. Just set the result boolean to 0 (false). */ *ptr = 0; return TCL_OK; } else { int result; Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, TCL_INDEX_NONE); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprBooleanObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); return result; } } |
︙ | ︙ | |||
6700 6701 6702 6703 6704 6705 6706 | * or TCL_INVOKE_NO_TRACEBACK. */ { if (interp == NULL) { return TCL_ERROR; } if ((objc < 1) || (objv == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 6689 6690 6691 6692 6693 6694 6695 6696 6697 6698 6699 6700 6701 6702 6703 | * or TCL_INVOKE_NO_TRACEBACK. */ { if (interp == NULL) { return TCL_ERROR; } if ((objc < 1) || (objv == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal argument vector", TCL_INDEX_NONE)); return TCL_ERROR; } if ((flags & TCL_INVOKE_HIDDEN) == 0) { Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN"); } return Tcl_NRCallObjProc(interp, TclNRInvoke, NULL, objc, objv); } |
︙ | ︙ | |||
6734 6735 6736 6737 6738 6739 6740 | if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid hidden command name \"%s\"", cmdName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, (char *)NULL); return TCL_ERROR; } | | | 6723 6724 6725 6726 6727 6728 6729 6730 6731 6732 6733 6734 6735 6736 6737 | if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "invalid hidden command name \"%s\"", cmdName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, (char *)NULL); return TCL_ERROR; } cmdPtr = (Command *)Tcl_GetHashValue(hPtr); /* * Avoid the exception-handling brain damage when numLevels == 0 */ iPtr->numLevels++; Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL); |
︙ | ︙ | |||
6758 6759 6760 6761 6762 6763 6764 | static int NRPostInvoke( TCL_UNUSED(void **), Tcl_Interp *interp, int result) { | | | 6747 6748 6749 6750 6751 6752 6753 6754 6755 6756 6757 6758 6759 6760 6761 | static int NRPostInvoke( TCL_UNUSED(void **), Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *)interp; iPtr->numLevels--; return result; } /* *--------------------------------------------------------------------------- |
︙ | ︙ | |||
6799 6800 6801 6802 6803 6804 6805 | if (expr[0] == '\0') { /* * An empty string. Just set the interpreter's result to 0. */ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); } else { | | | 6788 6789 6790 6791 6792 6793 6794 6795 6796 6797 6798 6799 6800 6801 6802 | if (expr[0] == '\0') { /* * An empty string. Just set the interpreter's result to 0. */ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); } else { Tcl_Obj *resultPtr, *exprObj = Tcl_NewStringObj(expr, TCL_INDEX_NONE); Tcl_IncrRefCount(exprObj); code = Tcl_ExprObj(interp, exprObj, &resultPtr); Tcl_DecrRefCount(exprObj); if (code == TCL_OK) { Tcl_SetObjResult(interp, resultPtr); Tcl_DecrRefCount(resultPtr); |
︙ | ︙ | |||
6913 6914 6915 6916 6917 6918 6919 | Tcl_DStringInit(&buf); while (1) { string = va_arg(argList, char *); if (string == NULL) { break; } | | | | 6902 6903 6904 6905 6906 6907 6908 6909 6910 6911 6912 6913 6914 6915 6916 6917 6918 6919 | Tcl_DStringInit(&buf); while (1) { string = va_arg(argList, char *); if (string == NULL) { break; } Tcl_DStringAppend(&buf, string, TCL_INDEX_NONE); } result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), TCL_INDEX_NONE, 0); Tcl_DStringFree(&buf); return result; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
7219 7220 7221 7222 7223 7224 7225 | } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root)); } return TCL_OK; negarg: Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 7208 7209 7210 7211 7212 7213 7214 7215 7216 7217 7218 7219 7220 7221 7222 | } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root)); } return TCL_OK; negarg: Tcl_SetObjResult(interp, Tcl_NewStringObj( "square root of negative argument", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", (char *)NULL); return TCL_ERROR; } static int ExprSqrtFunc( |
︙ | ︙ | |||
7353 7354 7355 7356 7357 7358 7359 | Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Parameter vector. */ { int code; double d1, d2; | | | 7342 7343 7344 7345 7346 7347 7348 7349 7350 7351 7352 7353 7354 7355 7356 | Tcl_Interp *interp, /* The interpreter in which to execute the * function. */ int objc, /* Actual parameter count. */ Tcl_Obj *const *objv) /* Parameter vector. */ { int code; double d1, d2; BuiltinBinaryFunc *func = (BuiltinBinaryFunc *)clientData; if (objc != 3) { MathFuncWrongNumArgs(interp, 3, objc, objv); return TCL_ERROR; } code = Tcl_GetDoubleFromObj(interp, objv[1], &d1); #ifdef ACCEPT_NAN |
︙ | ︙ | |||
7436 7437 7438 7439 7440 7441 7442 | bytes++; numBytes--; } } goto unChanged; } else if (l == WIDE_MIN) { if (sizeof(Tcl_WideInt) > sizeof(int64_t)) { | | | 7425 7426 7427 7428 7429 7430 7431 7432 7433 7434 7435 7436 7437 7438 7439 | bytes++; numBytes--; } } goto unChanged; } else if (l == WIDE_MIN) { if (sizeof(Tcl_WideInt) > sizeof(int64_t)) { Tcl_WideUInt ul = -(Tcl_WideUInt)WIDE_MIN; if (mp_init(&big) != MP_OKAY || mp_unpack(&big, 1, 1, sizeof(Tcl_WideInt), 0, 0, &ul) != MP_OKAY) { return TCL_ERROR; } if (mp_neg(&big, &big) != MP_OKAY) { return TCL_ERROR; } |
︙ | ︙ | |||
7572 7573 7574 7575 7576 7577 7578 | } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { return TCL_ERROR; } if (type == TCL_NUMBER_DOUBLE) { d = *((const double *) ptr); | | | 7561 7562 7563 7564 7565 7566 7567 7568 7569 7570 7571 7572 7573 7574 7575 | } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { return TCL_ERROR; } if (type == TCL_NUMBER_DOUBLE) { d = *((const double *) ptr); if ((d >= (double)WIDE_MAX) || (d <= (double)WIDE_MIN)) { mp_int big; if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) { /* Infinity */ return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); |
︙ | ︙ | |||
7814 7815 7816 7817 7818 7819 7820 | fractPart = modf(*((const double *) ptr), &intPart); if (fractPart <= -0.5) { min++; } else if (fractPart >= 0.5) { max--; } | | | | 7803 7804 7805 7806 7807 7808 7809 7810 7811 7812 7813 7814 7815 7816 7817 7818 7819 7820 7821 7822 7823 7824 7825 7826 7827 7828 7829 7830 7831 7832 7833 7834 7835 7836 | fractPart = modf(*((const double *) ptr), &intPart); if (fractPart <= -0.5) { min++; } else if (fractPart >= 0.5) { max--; } if ((intPart >= (double)max) || (intPart <= (double)min)) { mp_int big; mp_err err = MP_OKAY; if (Tcl_InitBignumFromDouble(interp, intPart, &big) != TCL_OK) { /* Infinity */ return TCL_ERROR; } if (fractPart <= -0.5) { err = mp_sub_d(&big, 1, &big); } else if (fractPart >= 0.5) { err = mp_add_d(&big, 1, &big); } if (err != MP_OKAY) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); return TCL_OK; } else { Tcl_WideInt result = (Tcl_WideInt)intPart; if (fractPart <= -0.5) { result--; } else if (fractPart >= 0.5) { result++; } Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result)); |
︙ | ︙ | |||
8544 8545 8546 8547 8548 8549 8550 | { if (objc > INT_MAX) { Tcl_WrongNumArgs(interp, 1, objv, "?args?"); return TCL_ERROR; } NRE_callback *rootPtr = TOP_CB(interp); | | < | 8533 8534 8535 8536 8537 8538 8539 8540 8541 8542 8543 8544 8545 8546 8547 | { if (objc > INT_MAX) { Tcl_WrongNumArgs(interp, 1, objv, "?args?"); return TCL_ERROR; } NRE_callback *rootPtr = TOP_CB(interp); CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); info->clientData = clientData; info->proc = objProc; TclNRAddCallback(interp, Dispatch, wrapperNRObjProc, info, INT2PTR(objc), objv); return TclNRRunCallbacks(interp, TCL_OK, rootPtr); } |
︙ | ︙ | |||
8616 8617 8618 8619 8620 8621 8622 | * name, provides NR implementation */ void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { | | < | 8604 8605 8606 8607 8608 8609 8610 8611 8612 8613 8614 8615 8616 8617 8618 | * name, provides NR implementation */ void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); info->proc = proc; info->clientData = clientData; info->nreProc = nreProc; info->deleteProc = deleteProc; info->deleteData = clientData; return Tcl_NRCreateCommand(interp, cmdName, |
︙ | ︙ | |||
8733 8734 8735 8736 8737 8738 8739 | * 3. when the NRCommand callback runs, it schedules the tailcall callback * to run immediately after it returns * * One delicate point is to properly define the NRCommand where the tailcall * will execute. There are functions whose purpose is to help define the * precise spot: * TclMarkTailcall: if the NEXT command to be pushed tailcalls, execution | | | | | | | | 8720 8721 8722 8723 8724 8725 8726 8727 8728 8729 8730 8731 8732 8733 8734 8735 8736 8737 8738 8739 8740 8741 | * 3. when the NRCommand callback runs, it schedules the tailcall callback * to run immediately after it returns * * One delicate point is to properly define the NRCommand where the tailcall * will execute. There are functions whose purpose is to help define the * precise spot: * TclMarkTailcall: if the NEXT command to be pushed tailcalls, execution * should continue right here * TclSkipTailcall: if the NEXT command to be pushed tailcalls, execution * should continue after the CURRENT command is fully returned ("skip * the next command: we are redirecting to it, tailcalls should run * after WE return") * TclPushTailcallPoint: the search for a tailcalling spot cannot traverse * this point. This is special for OO, as some of the oo constructs * that behave like commands may not push an NRCommand callback. */ void TclMarkTailcall( Tcl_Interp *interp) { Interp *iPtr = (Interp *) interp; |
︙ | ︙ | |||
8841 8842 8843 8844 8845 8846 8847 | if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?"); return TCL_ERROR; } if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 8828 8829 8830 8831 8832 8833 8834 8835 8836 8837 8838 8839 8840 8841 8842 | if (objc < 1) { Tcl_WrongNumArgs(interp, 1, objv, "?command? ?arg ...?"); return TCL_ERROR; } if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "tailcall can only be called from a proc, lambda or method", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL); return TCL_ERROR; } /* * Invocation without args just clears a scheduled tailcall; invocation * with an argument replaces any previously scheduled tailcall. |
︙ | ︙ | |||
8871 8872 8873 8874 8875 8876 8877 | Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; /* * The tailcall data is in a Tcl list: the first element is the * namespace, the rest the command to be tailcalled. */ | | | 8858 8859 8860 8861 8862 8863 8864 8865 8866 8867 8868 8869 8870 8871 8872 | Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; /* * The tailcall data is in a Tcl list: the first element is the * namespace, the rest the command to be tailcalled. */ nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, TCL_INDEX_NONE); listPtr = Tcl_NewListObj(objc, objv); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); iPtr->varFramePtr->tailcallPtr = listPtr; } return TCL_RETURN; } |
︙ | ︙ | |||
8897 8898 8899 8900 8901 8902 8903 | int TclNRTailcallEval( void *data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; | | | 8884 8885 8886 8887 8888 8889 8890 8891 8892 8893 8894 8895 8896 8897 8898 | int TclNRTailcallEval( void *data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr; Tcl_Namespace *nsPtr; Tcl_Size objc; Tcl_Obj **objv; TclListObjGetElements(interp, listPtr, &objc, &objv); nsObjPtr = objv[0]; |
︙ | ︙ | |||
9003 9004 9005 9006 9007 9008 9009 | if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?returnValue?"); return TCL_ERROR; } if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 8990 8991 8992 8993 8994 8995 8996 8997 8998 8999 9000 9001 9002 9003 9004 | if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?returnValue?"); return TCL_ERROR; } if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "yield can only be called in a coroutine", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL); return TCL_ERROR; } if (objc == 2) { Tcl_SetObjResult(interp, objv[1]); } |
︙ | ︙ | |||
9036 9037 9038 9039 9040 9041 9042 | if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?"); return TCL_ERROR; } if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | | | 9023 9024 9025 9026 9027 9028 9029 9030 9031 9032 9033 9034 9035 9036 9037 9038 9039 9040 9041 9042 9043 9044 9045 9046 9047 9048 9049 9050 9051 9052 9053 9054 9055 9056 9057 | if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?"); return TCL_ERROR; } if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "yieldto can only be called in a coroutine", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL); return TCL_ERROR; } if (((Namespace *) nsPtr)->flags & NS_DYING) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "yieldto called in deleted namespace", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", (char *)NULL); return TCL_ERROR; } /* * Add the tailcall in the caller env, then just yield. * * This is essentially code from TclNRTailcallObjCmd */ listPtr = Tcl_NewListObj(objc, objv); nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, TCL_INDEX_NONE); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); /* * Add the callback in the caller's env, then instruct TEBC to yield. */ iPtr->execEnvPtr = corPtr->callerEEPtr; |
︙ | ︙ | |||
9078 9079 9080 9081 9082 9083 9084 | static int RewindCoroutineCallback( void *data[], Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { | | | 9065 9066 9067 9068 9069 9070 9071 9072 9073 9074 9075 9076 9077 9078 9079 | static int RewindCoroutineCallback( void *data[], Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { return Tcl_RestoreInterpState(interp, (Tcl_InterpState)data[0]); } static int RewindCoroutine( CoroutineData *corPtr, int result) { |
︙ | ︙ | |||
9103 9104 9105 9106 9107 9108 9109 | return TclNRInterpCoroutine(corPtr, interp, 0, NULL); } static void DeleteCoroutine( void *clientData) { | | | | 9090 9091 9092 9093 9094 9095 9096 9097 9098 9099 9100 9101 9102 9103 9104 9105 9106 9107 9108 9109 9110 9111 9112 9113 9114 9115 9116 9117 9118 9119 | return TclNRInterpCoroutine(corPtr, interp, 0, NULL); } static void DeleteCoroutine( void *clientData) { CoroutineData *corPtr = (CoroutineData *)clientData; Tcl_Interp *interp = corPtr->eePtr->interp; NRE_callback *rootPtr = TOP_CB(interp); if (COR_IS_SUSPENDED(corPtr)) { TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK), rootPtr); } } static int NRCoroutineCallerCallback( void *data[], Tcl_Interp *interp, int result) { CoroutineData *corPtr = (CoroutineData *)data[0]; Command *cmdPtr = corPtr->cmdPtr; /* * This is the last callback in the caller execEnv, right before switching * to the coroutine's */ |
︙ | ︙ | |||
9164 9165 9166 9167 9168 9169 9170 | static int NRCoroutineExitCallback( void *data[], Tcl_Interp *interp, int result) { | | | 9151 9152 9153 9154 9155 9156 9157 9158 9159 9160 9161 9162 9163 9164 9165 | static int NRCoroutineExitCallback( void *data[], Tcl_Interp *interp, int result) { CoroutineData *corPtr = (CoroutineData *)data[0]; Command *cmdPtr = corPtr->cmdPtr; /* * This runs at the bottom of the Coroutine's execEnv: it will be executed * when the coroutine returns or is wound down, but not when it yields. It * deletes the coroutine and restores the caller's environment. */ |
︙ | ︙ | |||
9229 9230 9231 9232 9233 9234 9235 | int TclNRCoroutineActivateCallback( void *data[], Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { | | | 9216 9217 9218 9219 9220 9221 9222 9223 9224 9225 9226 9227 9228 9229 9230 | int TclNRCoroutineActivateCallback( void *data[], Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { CoroutineData *corPtr = (CoroutineData *)data[0]; void *stackLevel = TclGetCStackPtr(); if (!corPtr->stackLevel) { /* * -- Coroutine is suspended -- * Push the callback to restore the caller's context on yield or * return. |
︙ | ︙ | |||
9268 9269 9270 9271 9272 9273 9274 | if (corPtr->stackLevel != stackLevel) { NRE_callback *runPtr; iPtr->execEnvPtr = corPtr->callerEEPtr; if (corPtr->yieldPtr) { for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { if (runPtr->data[1] == corPtr->yieldPtr) { | | | | 9255 9256 9257 9258 9259 9260 9261 9262 9263 9264 9265 9266 9267 9268 9269 9270 9271 9272 9273 9274 9275 9276 9277 9278 9279 | if (corPtr->stackLevel != stackLevel) { NRE_callback *runPtr; iPtr->execEnvPtr = corPtr->callerEEPtr; if (corPtr->yieldPtr) { for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { if (runPtr->data[1] == corPtr->yieldPtr) { Tcl_DecrRefCount((Tcl_Obj *)runPtr->data[1]); runPtr->data[1] = NULL; corPtr->yieldPtr = NULL; break; } } } iPtr->execEnvPtr = corPtr->eePtr; Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot yield: C stack busy", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", (char *)NULL); return TCL_ERROR; } void *type = data[1]; if (type == CORO_ACTIVATE_YIELD) { |
︙ | ︙ | |||
9325 9326 9327 9328 9329 9330 9331 | TclNREvalList( void *data[], Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { Tcl_Size objc; Tcl_Obj **objv; | | | 9312 9313 9314 9315 9316 9317 9318 9319 9320 9321 9322 9323 9324 9325 9326 | TclNREvalList( void *data[], Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { Tcl_Size objc; Tcl_Obj **objv; Tcl_Obj *listPtr = (Tcl_Obj *)data[0]; Tcl_IncrRefCount(listPtr); TclMarkTailcall(interp); TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); |
︙ | ︙ | |||
9367 9368 9369 9370 9371 9372 9373 | /* * Look up the coroutine. */ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | | | | | | 9354 9355 9356 9357 9358 9359 9360 9361 9362 9363 9364 9365 9366 9367 9368 9369 9370 9371 9372 9373 9374 9375 9376 9377 9378 9379 9380 9381 9382 9383 9384 9385 9386 9387 9388 9389 9390 9391 9392 9393 9394 9395 9396 9397 9398 9399 | /* * Look up the coroutine. */ cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only get coroutine type of a coroutine", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", TclGetString(objv[1]), (char *)NULL); return TCL_ERROR; } /* * An active coroutine is "active". Can't tell what it might do in the * future. */ corPtr = (CoroutineData *)cmdPtr->objClientData; if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("active", TCL_INDEX_NONE)); return TCL_OK; } /* * Inactive coroutines are classified by the (effective) command used to * suspend them, which matters when you're injecting a probe. */ switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", TCL_INDEX_NONE)); return TCL_OK; case COROUTINE_ARGUMENTS_ARBITRARY: Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", TCL_INDEX_NONE)); return TCL_OK; default: Tcl_SetObjResult(interp, Tcl_NewStringObj( "unknown coroutine type", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL); return TCL_ERROR; } } /* *---------------------------------------------------------------------- |
︙ | ︙ | |||
9427 9428 9429 9430 9431 9432 9433 | /* * How to get a coroutine from its handle. */ Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { | | | | | 9414 9415 9416 9417 9418 9419 9420 9421 9422 9423 9424 9425 9426 9427 9428 9429 9430 9431 9432 9433 | /* * How to get a coroutine from its handle. */ Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", TclGetString(objPtr), (char *)NULL); return NULL; } return (CoroutineData *)cmdPtr->objClientData; } static int TclNRCoroInjectObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, int objc, |
︙ | ︙ | |||
9461 9462 9463 9464 9465 9466 9467 | corPtr = GetCoroutineFromObj(interp, objv[1], "can only inject a command into a coroutine"); if (!corPtr) { return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 9448 9449 9450 9451 9452 9453 9454 9455 9456 9457 9458 9459 9460 9461 9462 | corPtr = GetCoroutineFromObj(interp, objv[1], "can only inject a command into a coroutine"); if (!corPtr) { return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only inject a command into a suspended coroutine", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); return TCL_ERROR; } /* * Add the callback to the coro's execEnv, so that it is the first thing * to happen when the coro is resumed. |
︙ | ︙ | |||
9507 9508 9509 9510 9511 9512 9513 | "can only inject a probe command into a coroutine"); if (!corPtr) { return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only inject a probe command into a suspended coroutine", | | | 9494 9495 9496 9497 9498 9499 9500 9501 9502 9503 9504 9505 9506 9507 9508 | "can only inject a probe command into a coroutine"); if (!corPtr) { return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only inject a probe command into a suspended coroutine", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); return TCL_ERROR; } /* * Add the callback to the coro's execEnv, so that it is the first thing * to happen when the coro is resumed. |
︙ | ︙ | |||
9581 9582 9583 9584 9585 9586 9587 | static int InjectHandler( void *data[], Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { | | | | 9568 9569 9570 9571 9572 9573 9574 9575 9576 9577 9578 9579 9580 9581 9582 9583 | static int InjectHandler( void *data[], Tcl_Interp *interp, TCL_UNUSED(int) /*result*/) { CoroutineData *corPtr = (CoroutineData *)data[0]; Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; Tcl_Size nargs = PTR2INT(data[2]); void *isProbe = data[3]; Tcl_Size objc; Tcl_Obj **objv; if (!isProbe) { /* |
︙ | ︙ | |||
9628 9629 9630 9631 9632 9633 9634 | static int InjectHandlerPostCall( void *data[], Tcl_Interp *interp, int result) { | | | | 9615 9616 9617 9618 9619 9620 9621 9622 9623 9624 9625 9626 9627 9628 9629 9630 | static int InjectHandlerPostCall( void *data[], Tcl_Interp *interp, int result) { CoroutineData *corPtr = (CoroutineData *)data[0]; Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; Tcl_Size nargs = PTR2INT(data[2]); void *isProbe = data[3]; /* * Delete the command words for what we just executed. */ |
︙ | ︙ | |||
9698 9699 9700 9701 9702 9703 9704 | corPtr = GetCoroutineFromObj(interp, objv[1], "can only inject a command into a coroutine"); if (!corPtr) { return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 9685 9686 9687 9688 9689 9690 9691 9692 9693 9694 9695 9696 9697 9698 9699 | corPtr = GetCoroutineFromObj(interp, objv[1], "can only inject a command into a coroutine"); if (!corPtr) { return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "can only inject a command into a suspended coroutine", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); return TCL_ERROR; } /* * Add the callback to the coro's execEnv, so that it is the first thing * to happen when the coro is resumed. |
︙ | ︙ | |||
9723 9724 9725 9726 9727 9728 9729 | int TclNRInterpCoroutine( void *clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { | | | 9710 9711 9712 9713 9714 9715 9716 9717 9718 9719 9720 9721 9722 9723 9724 | int TclNRInterpCoroutine( void *clientData, Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { CoroutineData *corPtr = (CoroutineData *)clientData; if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "coroutine \"%s\" is already running", TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", (char *)NULL); return TCL_ERROR; |
︙ | ︙ | |||
9752 9753 9754 9755 9756 9757 9758 | return TCL_ERROR; } break; default: if (corPtr->nargs + 1 != objc) { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong coro nargs; how did we get here? " | | | 9739 9740 9741 9742 9743 9744 9745 9746 9747 9748 9749 9750 9751 9752 9753 | return TCL_ERROR; } break; default: if (corPtr->nargs + 1 != objc) { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong coro nargs; how did we get here? " "not implemented!", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); return TCL_ERROR; } /* fallthrough */ case COROUTINE_ARGUMENTS_ARBITRARY: if (objc > 1) { Tcl_SetObjResult(interp, Tcl_NewListObj(objc - 1, objv + 1)); |
︙ | ︙ | |||
9791 9792 9793 9794 9795 9796 9797 | int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Command *cmdPtr; CoroutineData *corPtr; const char *procName, *simpleName; Namespace *nsPtr, *altNsPtr, *cxtNsPtr, | | | 9778 9779 9780 9781 9782 9783 9784 9785 9786 9787 9788 9789 9790 9791 9792 | int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Command *cmdPtr; CoroutineData *corPtr; const char *procName, *simpleName; Namespace *nsPtr, *altNsPtr, *cxtNsPtr, *inNsPtr = (Namespace *)TclGetCurrentNamespace(interp); Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?"); return TCL_ERROR; } |
︙ | ︙ | |||
9823 9824 9825 9826 9827 9828 9829 | } /* * We ARE creating the coroutine command: allocate the corresponding * struct and create the corresponding command. */ | | | | < | 9810 9811 9812 9813 9814 9815 9816 9817 9818 9819 9820 9821 9822 9823 9824 9825 9826 9827 9828 9829 9830 9831 9832 9833 9834 9835 9836 9837 9838 9839 9840 9841 9842 9843 9844 9845 9846 | } /* * We ARE creating the coroutine command: allocate the corresponding * struct and create the corresponding command. */ corPtr = (CoroutineData *)Tcl_Alloc(sizeof(CoroutineData)); cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine, corPtr, DeleteCoroutine); corPtr->cmdPtr = cmdPtr; cmdPtr->refCount++; /* * #280. * Provide the new coroutine with its own copy of the lineLABCPtr * hashtable for literal command arguments in bytecode. Note that that * CFWordBC chains are not duplicated, only the entrypoints to them. This * means that in the presence of coroutines each chain is potentially a * tree. Like the chain -> tree conversion of the CmdFrame stack. */ { Tcl_HashSearch hSearch; Tcl_HashEntry *hePtr; corPtr->lineLABCPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable)); Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch); hePtr; hePtr = Tcl_NextHashEntry(&hSearch)) { int isNew; Tcl_HashEntry *newPtr = Tcl_CreateHashEntry(corPtr->lineLABCPtr, |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
1844 1845 1846 1847 1848 1849 1850 | static void ArgumentBCEnter( Tcl_Interp *interp, ByteCode *codePtr, TEBCdata *tdPtr, const unsigned char *pc, | | | 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 | static void ArgumentBCEnter( Tcl_Interp *interp, ByteCode *codePtr, TEBCdata *tdPtr, const unsigned char *pc, Tcl_Size objc, Tcl_Obj **objv) { Tcl_Size cmd; if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) { TclArgumentBCEnter(interp, objv, objc, codePtr, &tdPtr->cmdFrame, cmd, pc - codePtr->codeStart); |
︙ | ︙ | |||
9163 9164 9165 9166 9167 9168 9169 | * *---------------------------------------------------------------------- */ Tcl_Obj * TclGetSourceFromFrame( CmdFrame *cfPtr, | | | | 9163 9164 9165 9166 9167 9168 9169 9170 9171 9172 9173 9174 9175 9176 9177 9178 9179 9180 9181 9182 9183 9184 9185 | * *---------------------------------------------------------------------- */ Tcl_Obj * TclGetSourceFromFrame( CmdFrame *cfPtr, Tcl_Size objc, Tcl_Obj *const objv[]) { if (cfPtr == NULL) { return Tcl_NewListObj(objc, objv); } if (cfPtr->cmdObj == NULL) { if (cfPtr->cmd == NULL) { ByteCode *codePtr = (ByteCode *)cfPtr->data.tebc.codePtr; cfPtr->cmd = GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL); } if (cfPtr->cmd) { cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len); } else { |
︙ | ︙ | |||
9553 9554 9555 9556 9557 9558 9559 | * None. * *---------------------------------------------------------------------- */ int TclLog2( | | | 9553 9554 9555 9556 9557 9558 9559 9560 9561 9562 9563 9564 9565 9566 9567 | * None. * *---------------------------------------------------------------------- */ int TclLog2( int value) /* The integer for which to compute the log * base 2. */ { int n = value; int result = 0; while (n > 1) { n = n >> 1; |
︙ | ︙ |
Changes to generic/tclIO.c.
︙ | ︙ | |||
3031 3032 3033 3034 3035 3036 3037 | */ DiscardInputQueued(statePtr, 1); if (statePtr->curOutPtr != NULL) { ReleaseChannelBuffer(statePtr->curOutPtr); } DiscardOutputQueued(statePtr); | | | 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 | */ DiscardInputQueued(statePtr, 1); if (statePtr->curOutPtr != NULL) { ReleaseChannelBuffer(statePtr->curOutPtr); } DiscardOutputQueued(statePtr); DeleteTimerHandler(statePtr); if (statePtr->chanMsg) { Tcl_DecrRefCount(statePtr->chanMsg); } if (statePtr->unreportedMsg) { Tcl_DecrRefCount(statePtr->unreportedMsg); |
︙ | ︙ |
Changes to generic/tclIORChan.c.
︙ | ︙ | |||
2312 2313 2314 2315 2316 2317 2318 | } static inline void CleanRefChannelInstance( ReflectedChannel *rcPtr) { if (rcPtr->name) { | | | 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 | } static inline void CleanRefChannelInstance( ReflectedChannel *rcPtr) { if (rcPtr->name) { /* * Reset obj-type (channel is deleted or dead anyway) to avoid leakage * by cyclic references (see bug [79474c58800cdf94]). */ TclFreeInternalRep(rcPtr->name); Tcl_DecrRefCount(rcPtr->name); rcPtr->name = NULL; } |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
3257 3258 3259 3260 3261 3262 3263 | MODULE_SCOPE void TclAdvanceLines(Tcl_Size *line, const char *start, const char *end); MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, const unsigned char *bytes, Tcl_Size len); MODULE_SCOPE void TclAppendUtfToUtf(Tcl_Obj *objPtr, const char *bytes, Tcl_Size numBytes); MODULE_SCOPE void TclArgumentEnter(Tcl_Interp *interp, | | | | | 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 | MODULE_SCOPE void TclAdvanceLines(Tcl_Size *line, const char *start, const char *end); MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, const unsigned char *bytes, Tcl_Size len); MODULE_SCOPE void TclAppendUtfToUtf(Tcl_Obj *objPtr, const char *bytes, Tcl_Size numBytes); MODULE_SCOPE void TclArgumentEnter(Tcl_Interp *interp, Tcl_Obj *objv[], Tcl_Size objc, CmdFrame *cf); MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp, Tcl_Obj *objv[], Tcl_Size objc); MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, Tcl_Obj *objv[], Tcl_Size objc, void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, Tcl_Size pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, CmdFrame **cfPtrPtr, int *wordPtr); MODULE_SCOPE int TclAsyncNotifier(int sigNumber, Tcl_ThreadId threadId, |
︙ | ︙ | |||
3384 3385 3386 3387 3388 3389 3390 | int *modePtr, int flags); MODULE_SCOPE CmdFrame * TclGetCmdFrameForProcedure(Proc *procPtr); MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp, Tcl_Obj *value, int *code); MODULE_SCOPE Proc * TclGetLambdaFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **nsObjPtrPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); | | | 3384 3385 3386 3387 3388 3389 3390 3391 3392 3393 3394 3395 3396 3397 3398 | int *modePtr, int flags); MODULE_SCOPE CmdFrame * TclGetCmdFrameForProcedure(Proc *procPtr); MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp, Tcl_Obj *value, int *code); MODULE_SCOPE Proc * TclGetLambdaFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **nsObjPtrPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, Tcl_Size objc, Tcl_Obj *const objv[]); MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr, Tcl_Size *sizePtr); MODULE_SCOPE int TclGetLoadedLibraries(Tcl_Interp *interp, const char *targetName, const char *packageName); MODULE_SCOPE int TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *, |
︙ | ︙ |
Changes to tests/oo.test.
︙ | ︙ | |||
3476 3477 3478 3479 3480 3481 3482 | for {set n 1} {$n <= $nworkers} {incr n} { lappend workers [set worker [[self] new]] $worker schedule {*}$args } return [uplevel 1 $script] } finally { foreach worker $workers {$worker destroy} | | | 3476 3477 3478 3479 3480 3481 3482 3483 3484 3485 3486 3487 3488 3489 3490 | for {set n 1} {$n <= $nworkers} {incr n} { lappend workers [set worker [[self] new]] $worker schedule {*}$args } return [uplevel 1 $script] } finally { foreach worker $workers {$worker destroy} } } method run {nworkers} { set result {} set stopvar [my varname stop] set stop false my WithWorkers $nworkers [list my Work [my varname result]] { after idle [namespace code {set stop true}] |
︙ | ︙ |