Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Make Tcl_Size signed by default, but allow extension to make it unsigned (experimental) |
|---|---|
| Timelines: | family | ancestors | descendants | both | optional-unsigned-size |
| Files: | files | file ages | folders |
| SHA3-256: |
4f88786745ad31b9cb05b46d0f681776 |
| User & Date: | jan.nijtmans 2023-04-06 16:10:43.068 |
Context
|
2023-04-06
| ||
| 18:35 | Merge 9.0 Leaf check-in: 60606cb13f user: jan.nijtmans tags: optional-unsigned-size | |
| 16:10 | Make Tcl_Size signed by default, but allow extension to make it unsigned (experimental) check-in: 4f88786745 user: jan.nijtmans tags: optional-unsigned-size | |
| 12:24 | Merge bug-[fa3d9fd818fa0072]. check-in: b66d50b4d4 user: pooryorick tags: trunk, main | |
| 09:52 | Eliminate TCL_SIZE_CMP() for now, not a good idea for Tcl 9.0 Closed-Leaf check-in: d00062f436 user: jan.nijtmans tags: optional-signed-size | |
Changes
Changes to generic/tcl.h.
| ︙ | ︙ | |||
309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 | #define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val))) #define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val))) #define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val))) #define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val))) #if TCL_MAJOR_VERSION < 9 typedef int Tcl_Size; #else typedef size_t Tcl_Size; #endif #ifdef _WIN32 # if TCL_MAJOR_VERSION > 8 || defined(_WIN64) || defined(_USE_64BIT_TIME_T) typedef struct __stat64 Tcl_StatBuf; # elif defined(_USE_32BIT_TIME_T) typedef struct _stati64 Tcl_StatBuf; | > > > > > > > > > | 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 |
#define Tcl_WideAsLong(val) ((long)((Tcl_WideInt)(val)))
#define Tcl_LongAsWide(val) ((Tcl_WideInt)((long)(val)))
#define Tcl_WideAsDouble(val) ((double)((Tcl_WideInt)(val)))
#define Tcl_DoubleAsWide(val) ((Tcl_WideInt)((double)(val)))
#if TCL_MAJOR_VERSION < 9
typedef int Tcl_Size;
#define TCL_SIZE_ISNEG(index) ((index) < 0)
#elif !defined(TCL_UNSIGNED_SIZE) && !defined(BUILD_tcl)
typedef ptrdiff_t Tcl_Size;
#define TCL_SIZE_ISNEG(index) (((index) == TCL_INDEX_NONE) \
|| ((sizeof(int) != sizeof(size_t)) && ((ptrdiff_t)(index) < 0) \
&& (Tcl_Panic("Tcl_Size overflow %s:%d", __FILE__, __LINE__), 1)))
#else
typedef size_t Tcl_Size;
#define TCL_SIZE_ISNEG(index) (((index) == TCL_INDEX_NONE) \
|| ((sizeof(int) != sizeof(size_t)) && ((ptrdiff_t)(index) < 0) \
&& (Tcl_Panic("Tcl_Size overflow %s:%d", __FILE__, __LINE__), 1)))
#endif
#ifdef _WIN32
# if TCL_MAJOR_VERSION > 8 || defined(_WIN64) || defined(_USE_64BIT_TIME_T)
typedef struct __stat64 Tcl_StatBuf;
# elif defined(_USE_32BIT_TIME_T)
typedef struct _stati64 Tcl_StatBuf;
|
| ︙ | ︙ | |||
550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 | int argc, const char *argv[]); typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, void *cmdClientData, int argc, const char *argv[]); typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp, size_t level, const char *command, Tcl_Command commandInfo, size_t objc, struct Tcl_Obj *const *objv); typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData); typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr); typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); #define Tcl_EncodingFreeProc Tcl_FreeProc | > > > > > > | 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 | int argc, const char *argv[]); typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, void *cmdClientData, int argc, const char *argv[]); typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); #if !defined(TCL_UNSIGNED_SIZE) && !defined(BUILD_tcl) typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp, ptrdiff_t level, const char *command, Tcl_Command commandInfo, ptrdiff_t objc, struct Tcl_Obj *const *objv); #else typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp, size_t level, const char *command, Tcl_Command commandInfo, size_t objc, struct Tcl_Obj *const *objv); #endif typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData); typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *dupPtr); typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); #define Tcl_EncodingFreeProc Tcl_FreeProc |
| ︙ | ︙ | |||
575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 | typedef void (Tcl_FreeProc) (void *blockPtr); typedef void (Tcl_IdleProc) (void *clientData); typedef void (Tcl_InterpDeleteProc) (void *clientData, Tcl_Interp *interp); typedef void (Tcl_NamespaceDeleteProc) (void *clientData); typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp, size_t objc, struct Tcl_Obj *const *objv); typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp); typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags); typedef void (Tcl_PanicProc) (const char *format, ...); typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan, char *address, int port); typedef void (Tcl_TimerProc) (void *clientData); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); | > > > > > | 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 | typedef void (Tcl_FreeProc) (void *blockPtr); typedef void (Tcl_IdleProc) (void *clientData); typedef void (Tcl_InterpDeleteProc) (void *clientData, Tcl_Interp *interp); typedef void (Tcl_NamespaceDeleteProc) (void *clientData); typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); #if !defined(TCL_UNSIGNED_SIZE) && !defined(BUILD_tcl) typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp, ptrdiff_t objc, struct Tcl_Obj *const *objv); #else typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp, size_t objc, struct Tcl_Obj *const *objv); #endif typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp); typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags); typedef void (Tcl_PanicProc) (const char *format, ...); typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan, char *address, int port); typedef void (Tcl_TimerProc) (void *clientData); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); |
| ︙ | ︙ | |||
2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 |
EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
#endif
#if defined(_WIN32) && defined(UNICODE)
#ifndef USE_TCL_STUBS
# define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
#endif
# define Tcl_MainEx Tcl_MainExW
EXTERN TCL_NORETURN void Tcl_MainExW(size_t argc, wchar_t **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif
#if defined(USE_TCL_STUBS) && (TCL_MAJOR_VERSION > 8)
#define Tcl_SetPanicProc(panicProc) \
TclInitStubTable(((const char *(*)(Tcl_PanicProc *))TclStubCall((void *)panicProc))(panicProc))
#define Tcl_InitSubsystems() \
TclInitStubTable(((const char *(*)(void))TclStubCall((void *)1))())
#define Tcl_FindExecutable(argv0) \
| > > > > > | 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353 2354 2355 2356 |
EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
#endif
#if defined(_WIN32) && defined(UNICODE)
#ifndef USE_TCL_STUBS
# define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
#endif
# define Tcl_MainEx Tcl_MainExW
#if !defined(TCL_UNSIGNED_SIZE) && !defined(BUILD_tcl)
EXTERN TCL_NORETURN void Tcl_MainExW(ptrdiff_t argc, wchar_t **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#else
EXTERN TCL_NORETURN void Tcl_MainExW(size_t argc, wchar_t **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif
#endif
#if defined(USE_TCL_STUBS) && (TCL_MAJOR_VERSION > 8)
#define Tcl_SetPanicProc(panicProc) \
TclInitStubTable(((const char *(*)(Tcl_PanicProc *))TclStubCall((void *)panicProc))(panicProc))
#define Tcl_InitSubsystems() \
TclInitStubTable(((const char *(*)(void))TclStubCall((void *)1))())
#define Tcl_FindExecutable(argv0) \
|
| ︙ | ︙ |
Changes to generic/tclAlloc.c.
| ︙ | ︙ | |||
247 248 249 250 251 252 253 | * None. * *---------------------------------------------------------------------- */ void * TclpAlloc( | | | 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 |
* None.
*
*----------------------------------------------------------------------
*/
void *
TclpAlloc(
TCL_HASH_TYPE numBytes) /* Number of bytes to allocate. */
{
union overhead *overPtr;
size_t bucket;
size_t amount;
struct block *bigBlockPtr = NULL;
if (!allocInit) {
|
| ︙ | ︙ | |||
690 691 692 693 694 695 696 | * *---------------------------------------------------------------------- */ #undef TclpAlloc void * TclpAlloc( | | | 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 |
*
*----------------------------------------------------------------------
*/
#undef TclpAlloc
void *
TclpAlloc(
TCL_HASH_TYPE numBytes) /* Number of bytes to allocate. */
{
return malloc(numBytes);
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ |
Changes to generic/tclArithSeries.c.
| ︙ | ︙ | |||
39 40 41 42 43 44 45 | */ static void DupArithSeriesInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FreeArithSeriesInternalRep (Tcl_Obj *listPtr); static int SetArithSeriesFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfArithSeries (Tcl_Obj *arithSeriesObj); static Tcl_Obj *ArithSeriesObjStep(Tcl_Obj *arithSeriesPtr); | | | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | */ static void DupArithSeriesInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FreeArithSeriesInternalRep (Tcl_Obj *listPtr); static int SetArithSeriesFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfArithSeries (Tcl_Obj *arithSeriesObj); static Tcl_Obj *ArithSeriesObjStep(Tcl_Obj *arithSeriesPtr); static size_t ArithSeriesObjLength(Tcl_Obj *arithSeriesPtr); /* * The structure below defines the arithmetic series Tcl object type by * means of procedures that can be invoked by generic object code. * * The arithmetic series object is a special case of Tcl list representing * an interval of an arithmetic series in constant space. |
| ︙ | ︙ | |||
470 471 472 473 474 475 476 | * * Side Effects: * * None. * *---------------------------------------------------------------------- */ | | | 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 |
*
* Side Effects:
*
* None.
*
*----------------------------------------------------------------------
*/
size_t ArithSeriesObjLength(Tcl_Obj *arithSeriesObj)
{
ArithSeries *arithSeriesRepPtr = (ArithSeries*)
arithSeriesObj->internalRep.twoPtrValue.ptr1;
return arithSeriesRepPtr->len;
}
/*
|
| ︙ | ︙ | |||
726 727 728 729 730 731 732 |
Tcl_Size toIdx) /* Index of last element to include. */
{
ArithSeries *arithSeriesRepPtr;
Tcl_Obj *startObj, *endObj, *stepObj;
ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr);
| | | 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 |
Tcl_Size toIdx) /* Index of last element to include. */
{
ArithSeries *arithSeriesRepPtr;
Tcl_Obj *startObj, *endObj, *stepObj;
ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr);
if (TCL_SIZE_ISNEG(fromIdx)) {
fromIdx = 0;
}
if (fromIdx > toIdx) {
Tcl_Obj *obj;
TclNewObj(obj);
return obj;
}
|
| ︙ | ︙ |
Changes to generic/tclAssembly.c.
| ︙ | ︙ | |||
1363 1364 1365 1366 1367 1368 1369 |
Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName");
goto cleanup;
}
if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
goto cleanup;
}
localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
| | | 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 |
Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName");
goto cleanup;
}
if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
goto cleanup;
}
localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
if (TCL_SIZE_ISNEG(localVar)) {
goto cleanup;
}
BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
TclEmitInt4(localVar, envPtr);
break;
case ASSEM_CLOCK_READ:
|
| ︙ | ︙ | |||
1423 1424 1425 1426 1427 1428 1429 |
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
goto cleanup;
}
localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
| | | | 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 |
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
goto cleanup;
}
localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
if (TCL_SIZE_ISNEG(localVar)) {
goto cleanup;
}
BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
TclEmitInt4(localVar, envPtr);
break;
case ASSEM_DICT_UNSET:
if (parsePtr->numWords != 3) {
Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
goto cleanup;
}
localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
if (TCL_SIZE_ISNEG(localVar)) {
goto cleanup;
}
BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
TclEmitInt4(localVar, envPtr);
break;
case ASSEM_END_CATCH:
|
| ︙ | ︙ | |||
1635 1636 1637 1638 1639 1640 1641 |
case ASSEM_LVT:
if (parsePtr->numWords != 2) {
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
goto cleanup;
}
localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
| | | | | | 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 |
case ASSEM_LVT:
if (parsePtr->numWords != 2) {
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
goto cleanup;
}
localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
if (TCL_SIZE_ISNEG(localVar)) {
goto cleanup;
}
BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0);
break;
case ASSEM_LVT1:
if (parsePtr->numWords != 2) {
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
goto cleanup;
}
localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
if (TCL_SIZE_ISNEG(localVar) || CheckOneByte(interp, localVar)) {
goto cleanup;
}
BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
break;
case ASSEM_LVT1_SINT1:
if (parsePtr->numWords != 3) {
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varName imm8");
goto cleanup;
}
localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
if (TCL_SIZE_ISNEG(localVar) || CheckOneByte(interp, localVar)
|| GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
|| CheckSignedOneByte(interp, opnd)) {
goto cleanup;
}
BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
TclEmitInt1(opnd, envPtr);
break;
case ASSEM_LVT4:
if (parsePtr->numWords != 2) {
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
goto cleanup;
}
localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
if (TCL_SIZE_ISNEG(localVar)) {
goto cleanup;
}
BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0);
break;
case ASSEM_OVER:
if (parsePtr->numWords != 2) {
|
| ︙ | ︙ | |||
1738 1739 1740 1741 1742 1743 1744 |
Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
goto cleanup;
}
localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
| | | 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 |
Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
goto cleanup;
}
localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
if (TCL_SIZE_ISNEG(localVar)) {
goto cleanup;
}
BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0);
TclEmitInt4(localVar, envPtr);
break;
default:
|
| ︙ | ︙ | |||
2322 2323 2324 2325 2326 2327 2328 |
varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen);
if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
Tcl_DecrRefCount(varNameObj);
return TCL_INDEX_NONE;
}
localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);
Tcl_DecrRefCount(varNameObj);
| | | 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 2335 2336 |
varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen);
if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
Tcl_DecrRefCount(varNameObj);
return TCL_INDEX_NONE;
}
localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);
Tcl_DecrRefCount(varNameObj);
if (TCL_SIZE_ISNEG(localVar)) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot use this instruction to create a variable"
" in a non-proc context", TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
}
return TCL_INDEX_NONE;
|
| ︙ | ︙ |
Changes to generic/tclBasic.c.
| ︙ | ︙ | |||
609 610 611 612 613 614 615 |
*----------------------------------------------------------------------
*/
static int
buildInfoObjCmd2(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
| | | 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 |
*----------------------------------------------------------------------
*/
static int
buildInfoObjCmd2(
void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
Tcl_Size objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
if (objc - 1 > 1) {
Tcl_WrongNumArgs(interp, 1, objv, "?option?");
return TCL_ERROR;
}
if (objc == 2) {
|
| ︙ | ︙ | |||
3287 3288 3289 3290 3291 3292 3293 |
*----------------------------------------------------------------------
*/
static int
invokeObj2Command(
void *clientData, /* Points to command's Command structure. */
Tcl_Interp *interp, /* Current interpreter. */
| | | | 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 |
*----------------------------------------------------------------------
*/
static int
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) {
objc = TCL_INDEX_NONE;
}
if (cmdPtr->objProc != NULL) {
result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
} else {
result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
cmdPtr->objClientData, objc, objv);
}
return result;
}
static int cmdWrapper2Proc(void *clientData,
Tcl_Interp *interp,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
Command *cmdPtr = (Command *)clientData;
return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
}
int
|
| ︙ | ︙ | |||
4366 4367 4368 4369 4370 4371 4372 |
*----------------------------------------------------------------------
*/
int
Tcl_EvalObjv(
Tcl_Interp *interp, /* Interpreter in which to evaluate the
* command. Also used for error reporting. */
| | | | 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 |
*----------------------------------------------------------------------
*/
int
Tcl_EvalObjv(
Tcl_Interp *interp, /* Interpreter in which to evaluate the
* command. Also used for error reporting. */
Tcl_Size objc, /* Number of words in command. */
Tcl_Obj *const objv[], /* An array of pointers to objects that are
* the words that make up the command. */
int flags) /* Collection of OR-ed bits that control the
* evaluation of the script. Only
* TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
* TCL_EVAL_NOERR are currently supported. */
{
int result;
NRE_callback *rootPtr = TOP_CB(interp);
result = TclNREvalObjv(interp, objc, objv, flags, NULL);
return TclNRRunCallbacks(interp, result, rootPtr);
}
int
TclNREvalObjv(
Tcl_Interp *interp, /* Interpreter in which to evaluate the
* command. Also used for error reporting. */
Tcl_Size objc, /* Number of words in command. */
Tcl_Obj *const objv[], /* An array of pointers to objects that are
* the words that make up the command. */
int flags, /* Collection of OR-ed bits that control the
* evaluation of the script. Only
* TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
* TCL_EVAL_NOERR are currently supported. */
Command *cmdPtr) /* NULL if the Command is to be looked up
|
| ︙ | ︙ | |||
5085 5086 5087 5088 5089 5090 5091 |
int
Tcl_EvalTokensStandard(
Tcl_Interp *interp, /* Interpreter in which to lookup variables,
* execute nested commands, and report
* errors. */
Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to
* evaluate and concatenate. */
| | | 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 |
int
Tcl_EvalTokensStandard(
Tcl_Interp *interp, /* Interpreter in which to lookup variables,
* execute nested commands, and report
* errors. */
Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to
* evaluate and concatenate. */
Tcl_Size count) /* Number of tokens to consider at tokenPtr.
* Must be at least 1. */
{
return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
NULL, NULL);
}
/*
|
| ︙ | ︙ | |||
5118 5119 5120 5121 5122 5123 5124 |
*/
int
Tcl_EvalEx(
Tcl_Interp *interp, /* Interpreter in which to evaluate the
* script. Also used for error reporting. */
const char *script, /* First character of script to evaluate. */
| | | | 5118 5119 5120 5121 5122 5123 5124 5125 5126 5127 5128 5129 5130 5131 5132 5133 5134 5135 5136 5137 5138 5139 5140 5141 5142 5143 5144 5145 5146 5147 |
*/
int
Tcl_EvalEx(
Tcl_Interp *interp, /* Interpreter in which to evaluate the
* script. Also used for error reporting. */
const char *script, /* First character of script to evaluate. */
Tcl_Size numBytes, /* Number of bytes in script. If TCL_INDEX_NONE, the
* script consists of all bytes up to the
* first null character. */
int flags) /* Collection of OR-ed bits that control the
* evaluation of the script. Only
* TCL_EVAL_GLOBAL is currently supported. */
{
return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script);
}
int
TclEvalEx(
Tcl_Interp *interp, /* Interpreter in which to evaluate the
* script. Also used for error reporting. */
const char *script, /* First character of script to evaluate. */
size_t numBytes, /* Number of bytes in script. If TCL_INDEX_NONE, the
* script consists of all bytes up to the
* first NUL character. */
int flags, /* Collection of OR-ed bits that control the
* evaluation of the script. Only
* TCL_EVAL_GLOBAL is currently supported. */
size_t line, /* The line the script starts on. */
int *clNextOuter, /* Information about an outer context for */
|
| ︙ | ︙ | |||
5199 5200 5201 5202 5203 5204 5205 |
if (clNextOuter) {
clNext = clNextOuter;
} else {
clNext = &iPtr->scriptCLLocPtr->loc[0];
}
}
| | | 5199 5200 5201 5202 5203 5204 5205 5206 5207 5208 5209 5210 5211 5212 5213 |
if (clNextOuter) {
clNext = clNextOuter;
} else {
clNext = &iPtr->scriptCLLocPtr->loc[0];
}
}
if (TCL_SIZE_ISNEG(numBytes)) {
numBytes = strlen(script);
}
Tcl_ResetResult(interp);
savedVarFramePtr = iPtr->varFramePtr;
if (flags & TCL_EVAL_GLOBAL) {
iPtr->varFramePtr = iPtr->rootFramePtr;
|
| ︙ | ︙ | |||
5848 5849 5850 5851 5852 5853 5854 |
* ensemble dispatch. Ensemble subcommands that lead to script
* evaluation are not supposed to get compiled, because a command
* such as [info level] in the script can expose some of the dispatch
* shenanigans. This means that we don't have to tend to the
* housekeeping, and can escape now.
*/
| | | 5848 5849 5850 5851 5852 5853 5854 5855 5856 5857 5858 5859 5860 5861 5862 |
* ensemble dispatch. Ensemble subcommands that lead to script
* evaluation are not supposed to get compiled, because a command
* such as [info level] in the script can expose some of the dispatch
* shenanigans. This means that we don't have to tend to the
* housekeeping, and can escape now.
*/
if (ePtr->nline != (Tcl_Size)objc) {
return;
}
/*
* Having disposed of the ensemble cases, we can state...
* A few truths ...
* (1) ePtr->nline == objc
|
| ︙ | ︙ | |||
6907 6908 6909 6910 6911 6912 6913 | * * Side effects: * None. * *---------------------------------------------------------------------- */ | | | | | 6907 6908 6909 6910 6911 6912 6913 6914 6915 6916 6917 6918 6919 6920 6921 6922 6923 6924 6925 6926 6927 6928 |
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_Size
Tcl_SetRecursionLimit(
Tcl_Interp *interp, /* Interpreter whose nesting limit is to be
* set. */
Tcl_Size depth) /* New value for maximimum depth. */
{
Interp *iPtr = (Interp *) interp;
Tcl_Size old;
old = iPtr->maxNestingDepth;
if (depth + 1 > 1) {
iPtr->maxNestingDepth = depth;
}
return old;
}
|
| ︙ | ︙ | |||
8470 8471 8472 8473 8474 8475 8476 |
*/
int
Tcl_NRCallObjProc(
Tcl_Interp *interp,
Tcl_ObjCmdProc *objProc,
void *clientData,
| | | 8470 8471 8472 8473 8474 8475 8476 8477 8478 8479 8480 8481 8482 8483 8484 |
*/
int
Tcl_NRCallObjProc(
Tcl_Interp *interp,
Tcl_ObjCmdProc *objProc,
void *clientData,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
NRE_callback *rootPtr = TOP_CB(interp);
TclNRAddCallback(interp, Dispatch, objProc, clientData,
INT2PTR(objc), objv);
return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
|
| ︙ | ︙ | |||
8653 8654 8655 8656 8657 8658 8659 |
return TclNREvalObjEx(interp, objPtr, flags, NULL, INT_MIN);
}
int
Tcl_NREvalObjv(
Tcl_Interp *interp, /* Interpreter in which to evaluate the
* command. Also used for error reporting. */
| | | | 8653 8654 8655 8656 8657 8658 8659 8660 8661 8662 8663 8664 8665 8666 8667 8668 8669 8670 8671 8672 8673 8674 8675 8676 8677 8678 8679 8680 8681 8682 |
return TclNREvalObjEx(interp, objPtr, flags, NULL, INT_MIN);
}
int
Tcl_NREvalObjv(
Tcl_Interp *interp, /* Interpreter in which to evaluate the
* command. Also used for error reporting. */
Tcl_Size objc, /* Number of words in command. */
Tcl_Obj *const objv[], /* An array of pointers to objects that are
* the words that make up the command. */
int flags) /* Collection of OR-ed bits that control the
* evaluation of the script. Only
* TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
* TCL_EVAL_NOERR are currently supported. */
{
return TclNREvalObjv(interp, objc, objv, flags, NULL);
}
int
Tcl_NRCmdSwap(
Tcl_Interp *interp,
Tcl_Command cmd,
Tcl_Size objc,
Tcl_Obj *const objv[],
int flags)
{
return TclNREvalObjv(interp, objc, objv, flags|TCL_EVAL_NOERR,
(Command *) cmd);
}
|
| ︙ | ︙ |
Changes to generic/tclBinary.c.
| ︙ | ︙ | |||
218 219 220 221 222 223 224 |
#undef Tcl_NewByteArrayObj
Tcl_Obj *
Tcl_NewByteArrayObj(
const unsigned char *bytes, /* The array of bytes used to initialize the
* new object. */
| | | 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 |
#undef Tcl_NewByteArrayObj
Tcl_Obj *
Tcl_NewByteArrayObj(
const unsigned char *bytes, /* The array of bytes used to initialize the
* new object. */
Tcl_Size numBytes) /* Number of bytes in the array */
{
#ifdef TCL_MEM_DEBUG
return Tcl_DbNewByteArrayObj(bytes, numBytes, "unknown", 0);
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *objPtr;
TclNewObj(objPtr);
|
| ︙ | ︙ | |||
261 262 263 264 265 266 267 |
*/
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewByteArrayObj(
const unsigned char *bytes, /* The array of bytes used to initialize the
* new object. */
| | | | 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 |
*/
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewByteArrayObj(
const unsigned char *bytes, /* The array of bytes used to initialize the
* new object. */
Tcl_Size numBytes, /* Number of bytes in the array */
const char *file, /* The name of the source file calling this
* procedure; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
Tcl_SetByteArrayObj(objPtr, bytes, numBytes);
return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewByteArrayObj(
const unsigned char *bytes, /* The array of bytes used to initialize the
* new object. */
Tcl_Size numBytes, /* Number of bytes in the array */
TCL_UNUSED(const char *) /*file*/,
TCL_UNUSED(int) /*line*/)
{
return Tcl_NewByteArrayObj(bytes, numBytes);
}
#endif /* TCL_MEM_DEBUG */
|
| ︙ | ︙ | |||
309 310 311 312 313 314 315 |
*/
void
Tcl_SetByteArrayObj(
Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */
const unsigned char *bytes, /* The array of bytes to use as the new value.
* May be NULL even if numBytes > 0. */
| | | 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 |
*/
void
Tcl_SetByteArrayObj(
Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */
const unsigned char *bytes, /* The array of bytes to use as the new value.
* May be NULL even if numBytes > 0. */
Tcl_Size numBytes) /* Number of bytes in the array */
{
ByteArray *byteArrayPtr;
Tcl_ObjInternalRep ir;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
}
|
| ︙ | ︙ | |||
427 428 429 430 431 432 433 |
*
*----------------------------------------------------------------------
*/
unsigned char *
Tcl_SetByteArrayLength(
Tcl_Obj *objPtr, /* The ByteArray object. */
| | | 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 |
*
*----------------------------------------------------------------------
*/
unsigned char *
Tcl_SetByteArrayLength(
Tcl_Obj *objPtr, /* The ByteArray object. */
Tcl_Size numBytes) /* Number of bytes in resized array */
{
ByteArray *byteArrayPtr;
Tcl_ObjInternalRep *irPtr;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
}
|
| ︙ | ︙ | |||
490 491 492 493 494 495 496 |
size_t limit,
int demandProper,
ByteArray **byteArrayPtrPtr)
{
size_t length;
const char *src = Tcl_GetStringFromObj(objPtr, &length);
size_t numBytes
| | | 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 |
size_t limit,
int demandProper,
ByteArray **byteArrayPtrPtr)
{
size_t length;
const char *src = Tcl_GetStringFromObj(objPtr, &length);
size_t numBytes
= (!TCL_SIZE_ISNEG(limit) && limit < length) ? limit : length;
ByteArray *byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(numBytes));
unsigned char *dst = byteArrayPtr->bytes;
unsigned char *dstEnd = dst + numBytes;
const char *srcEnd = src + length;
int proper = 1;
for (; src < srcEnd && dst < dstEnd; ) {
|
| ︙ | ︙ | |||
726 727 728 729 730 731 732 |
ByteArray *byteArrayPtr;
size_t needed;
Tcl_ObjInternalRep *irPtr;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
}
| | | 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 |
ByteArray *byteArrayPtr;
size_t needed;
Tcl_ObjInternalRep *irPtr;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
}
if (TCL_SIZE_ISNEG(len)) {
Tcl_Panic("%s must be called with definite number of bytes to append",
"TclAppendBytesToByteArray");
}
if (len == 0) {
/*
* Append zero bytes is a no-op.
*/
|
| ︙ | ︙ | |||
984 985 986 987 988 989 990 |
}
if (count == BINARY_ALL) {
count = listc;
} else if (count > listc) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"number of elements in list does not match count",
| | | 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 |
}
if (count == BINARY_ALL) {
count = listc;
} else if (count > listc) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"number of elements in list does not match count",
TCL_INDEX_NONE));
return TCL_ERROR;
}
if (TclListObjGetElementsM(interp, objv[arg], &listc,
&listv) != TCL_OK) {
return TCL_ERROR;
}
arg++;
|
| ︙ | ︙ |
Changes to generic/tclCkalloc.c.
| ︙ | ︙ | |||
378 379 380 381 382 383 384 | * and __LINE__. * *---------------------------------------------------------------------- */ void * Tcl_DbCkalloc( | | | 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 |
* and __LINE__.
*
*----------------------------------------------------------------------
*/
void *
Tcl_DbCkalloc(
TCL_HASH_TYPE size,
const char *file,
int line)
{
struct mem_header *result = NULL;
if (validate_memory) {
Tcl_ValidateAllMemory(file, line);
|
| ︙ | ︙ | |||
468 469 470 471 472 473 474 |
Tcl_MutexUnlock(ckallocMutexPtr);
return result->body;
}
void *
Tcl_AttemptDbCkalloc(
| | | 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 |
Tcl_MutexUnlock(ckallocMutexPtr);
return result->body;
}
void *
Tcl_AttemptDbCkalloc(
TCL_HASH_TYPE size,
const char *file,
int line)
{
struct mem_header *result = NULL;
if (validate_memory) {
Tcl_ValidateAllMemory(file, line);
|
| ︙ | ︙ | |||
653 654 655 656 657 658 659 |
*
*--------------------------------------------------------------------
*/
void *
Tcl_DbCkrealloc(
void *ptr,
| | | 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 |
*
*--------------------------------------------------------------------
*/
void *
Tcl_DbCkrealloc(
void *ptr,
TCL_HASH_TYPE size,
const char *file,
int line)
{
char *newPtr;
size_t copySize;
struct mem_header *memp;
|
| ︙ | ︙ | |||
684 685 686 687 688 689 690 |
Tcl_DbCkfree(ptr, file, line);
return newPtr;
}
void *
Tcl_AttemptDbCkrealloc(
void *ptr,
| | | 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 |
Tcl_DbCkfree(ptr, file, line);
return newPtr;
}
void *
Tcl_AttemptDbCkrealloc(
void *ptr,
TCL_HASH_TYPE size,
const char *file,
int line)
{
char *newPtr;
size_t copySize;
struct mem_header *memp;
|
| ︙ | ︙ | |||
735 736 737 738 739 740 741 | * Same as the debug versions. * *---------------------------------------------------------------------- */ void * Tcl_Alloc( | | | | | | 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 |
* Same as the debug versions.
*
*----------------------------------------------------------------------
*/
void *
Tcl_Alloc(
TCL_HASH_TYPE size)
{
return Tcl_DbCkalloc(size, "unknown", 0);
}
void *
Tcl_AttemptAlloc(
TCL_HASH_TYPE size)
{
return Tcl_AttemptDbCkalloc(size, "unknown", 0);
}
void
Tcl_Free(
void *ptr)
{
Tcl_DbCkfree(ptr, "unknown", 0);
}
void *
Tcl_Realloc(
void *ptr,
TCL_HASH_TYPE size)
{
return Tcl_DbCkrealloc(ptr, size, "unknown", 0);
}
void *
Tcl_AttemptRealloc(
void *ptr,
TCL_HASH_TYPE size)
{
return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0);
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
1028 1029 1030 1031 1032 1033 1034 | * that memory was actually allocated. * *---------------------------------------------------------------------- */ void * Tcl_Alloc( | | | 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 |
* that memory was actually allocated.
*
*----------------------------------------------------------------------
*/
void *
Tcl_Alloc(
TCL_HASH_TYPE size)
{
void *result = TclpAlloc(size);
/*
* Most systems will not alloc(0), instead bumping it to one so that NULL
* isn't returned. Some systems (AIX, Tru64) will alloc(0) by returning
* NULL, so we have to check that the NULL we get is not in response to
|
| ︙ | ︙ | |||
1050 1051 1052 1053 1054 1055 1056 |
Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes", size);
}
return result;
}
void *
Tcl_DbCkalloc(
| | | 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 |
Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes", size);
}
return result;
}
void *
Tcl_DbCkalloc(
TCL_HASH_TYPE size,
const char *file,
int line)
{
void *result = TclpAlloc(size);
if ((result == NULL) && size) {
fflush(stdout);
|
| ︙ | ︙ | |||
1077 1078 1079 1080 1081 1082 1083 | * check that memory was actually allocated. * *---------------------------------------------------------------------- */ void * Tcl_AttemptAlloc( | | | | | | 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 |
* check that memory was actually allocated.
*
*----------------------------------------------------------------------
*/
void *
Tcl_AttemptAlloc(
TCL_HASH_TYPE size)
{
return (char *)TclpAlloc(size);
}
void *
Tcl_AttemptDbCkalloc(
TCL_HASH_TYPE size,
TCL_UNUSED(const char *) /*file*/,
TCL_UNUSED(int) /*line*/)
{
return (char *)TclpAlloc(size);
}
/*
*----------------------------------------------------------------------
*
* Tcl_Realloc --
*
* Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does check
* that memory was actually allocated.
*
*----------------------------------------------------------------------
*/
void *
Tcl_Realloc(
void *ptr,
TCL_HASH_TYPE size)
{
void *result = TclpRealloc(ptr, size);
if ((result == NULL) && size) {
Tcl_Panic("unable to realloc %" TCL_Z_MODIFIER "u bytes", size);
}
return result;
}
void *
Tcl_DbCkrealloc(
void *ptr,
TCL_HASH_TYPE size,
const char *file,
int line)
{
void *result = TclpRealloc(ptr, size);
if ((result == NULL) && size) {
fflush(stdout);
|
| ︙ | ︙ | |||
1146 1147 1148 1149 1150 1151 1152 |
*
*----------------------------------------------------------------------
*/
void *
Tcl_AttemptRealloc(
void *ptr,
| | | | 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 |
*
*----------------------------------------------------------------------
*/
void *
Tcl_AttemptRealloc(
void *ptr,
TCL_HASH_TYPE size)
{
return (char *)TclpRealloc(ptr, size);
}
void *
Tcl_AttemptDbCkrealloc(
void *ptr,
TCL_HASH_TYPE size,
TCL_UNUSED(const char *) /*file*/,
TCL_UNUSED(int) /*line*/)
{
return (char *)TclpRealloc(ptr, size);
}
/*
|
| ︙ | ︙ |
Changes to generic/tclCmdIL.c.
| ︙ | ︙ | |||
2723 2724 2725 2726 2727 2728 2729 |
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[])
/* Argument objects. */
{
int result;
| | | 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 |
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[])
/* Argument objects. */
{
int result;
Tcl_Size listLen, first, last;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 1, objv, "list first last");
return TCL_ERROR;
}
result = TclListObjLengthM(interp, objv[1], &listLen);
if (result != TCL_OK) {
|
| ︙ | ︙ | |||
3908 3909 3910 3911 3912 3913 3914 |
}
} else if (returnSubindices) {
size_t j;
TclNewIndexObj(itemPtr, i+groupOffset);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_Obj *elObj;
| < | | 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 |
}
} else if (returnSubindices) {
size_t j;
TclNewIndexObj(itemPtr, i+groupOffset);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_Obj *elObj;
TclNewIndexObj(elObj, TclIndexDecode(sortInfo.indexv[j], listc));
Tcl_ListObjAppendElement(interp, itemPtr, elObj);
}
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
} else {
Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewWideIntObj(i));
}
}
|
| ︙ | ︙ | |||
3932 3933 3934 3935 3936 3937 3938 |
} else if (!inlineReturn) {
if (returnSubindices) {
size_t j;
TclNewIndexObj(itemPtr, index+groupOffset);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_Obj *elObj;
| < | | 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 3941 3942 3943 3944 3945 |
} else if (!inlineReturn) {
if (returnSubindices) {
size_t j;
TclNewIndexObj(itemPtr, index+groupOffset);
for (j=0 ; j<sortInfo.indexc ; j++) {
Tcl_Obj *elObj;
TclNewIndexObj(elObj, TclIndexDecode(sortInfo.indexv[j], listc));
Tcl_ListObjAppendElement(interp, itemPtr, elObj);
}
Tcl_SetObjResult(interp, itemPtr);
} else {
Tcl_Obj *elObj;
TclNewIndexObj(elObj, index);
Tcl_SetObjResult(interp, elObj);
|
| ︙ | ︙ |
Changes to generic/tclCmdMZ.c.
| ︙ | ︙ | |||
257 258 259 260 261 262 263 |
objPtr = objv[1];
stringLength = Tcl_GetCharLength(objPtr);
if (startIndex) {
TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
Tcl_DecrRefCount(startIndex);
| | | 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 |
objPtr = objv[1];
stringLength = Tcl_GetCharLength(objPtr);
if (startIndex) {
TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
Tcl_DecrRefCount(startIndex);
if (TCL_SIZE_ISNEG(offset)) {
offset = TCL_INDEX_START;
}
}
regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
if (regExpr == NULL) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
368 369 370 371 372 373 374 | Tcl_Obj *objs[2]; /* * Only adjust the match area if there was a match for that * area. (Scriptics Bug 4391/SF Bug #219232) */ | | | 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 |
Tcl_Obj *objs[2];
/*
* Only adjust the match area if there was a match for that
* area. (Scriptics Bug 4391/SF Bug #219232)
*/
if (i <= (int)info.nsubs && !TCL_SIZE_ISNEG(info.matches[i].start)) {
start = offset + info.matches[i].start;
end = offset + info.matches[i].end;
/*
* Adjust index so it refers to the last character in the
* match instead of the first character after the match.
*/
|
| ︙ | ︙ | |||
581 582 583 584 585 586 587 |
objv += idx;
if (startIndex) {
size_t stringLength = Tcl_GetCharLength(objv[1]);
TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
Tcl_DecrRefCount(startIndex);
| | | 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 |
objv += idx;
if (startIndex) {
size_t stringLength = Tcl_GetCharLength(objv[1]);
TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
Tcl_DecrRefCount(startIndex);
if (TCL_SIZE_ISNEG(offset)) {
offset = TCL_INDEX_START;
}
}
if (all && (offset == TCL_INDEX_START) && (command == 0)
&& (strpbrk(TclGetString(objv[2]), "&\\") == NULL)
&& (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
|
| ︙ | ︙ | |||
780 781 782 783 784 785 786 |
numArgs = numParts + info.nsubs + 1;
args = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj*) * numArgs);
memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);
for (idx = 0 ; idx <= info.nsubs ; idx++) {
subStart = info.matches[idx].start;
subEnd = info.matches[idx].end;
| | | 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 |
numArgs = numParts + info.nsubs + 1;
args = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj*) * numArgs);
memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);
for (idx = 0 ; idx <= info.nsubs ; idx++) {
subStart = info.matches[idx].start;
subEnd = info.matches[idx].end;
if (!TCL_SIZE_ISNEG(subStart) && !TCL_SIZE_ISNEG(subEnd)) {
args[idx + numParts] = Tcl_NewUnicodeObj(
wstring + offset + subStart, subEnd - subStart);
} else {
args[idx + numParts] = Tcl_NewObj();
}
Tcl_IncrRefCount(args[idx + numParts]);
}
|
| ︙ | ︙ | |||
884 885 886 887 888 889 890 |
Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
wsrc - wfirstChar);
}
if (idx <= info.nsubs) {
subStart = info.matches[idx].start;
subEnd = info.matches[idx].end;
| | | 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 |
Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
wsrc - wfirstChar);
}
if (idx <= info.nsubs) {
subStart = info.matches[idx].start;
subEnd = info.matches[idx].end;
if (!TCL_SIZE_ISNEG(subStart) && !TCL_SIZE_ISNEG(subEnd)) {
Tcl_AppendUnicodeToObj(resultPtr,
wstring + offset + subStart, subEnd - subStart);
}
}
if (*wsrc == '\\') {
wsrc++;
|
| ︙ | ︙ | |||
1407 1408 1409 1410 1411 1412 1413 |
*/
end = Tcl_GetCharLength(objv[1]) - 1;
if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) {
return TCL_ERROR;
}
| | | 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 |
*/
end = Tcl_GetCharLength(objv[1]) - 1;
if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) {
return TCL_ERROR;
}
if (!TCL_SIZE_ISNEG(index) && (index + 1 <= end + 1)) {
int ch = Tcl_GetUniChar(objv[1], index);
if (ch == -1) {
return TCL_OK;
}
/*
|
| ︙ | ︙ | |||
1477 1478 1479 1480 1481 1482 1483 |
}
length = Tcl_GetCharLength(objv[1]);
if (TclGetIntForIndexM(interp, objv[2], length, &index) != TCL_OK) {
return TCL_ERROR;
}
| | | 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 |
}
length = Tcl_GetCharLength(objv[1]);
if (TclGetIntForIndexM(interp, objv[2], length, &index) != TCL_OK) {
return TCL_ERROR;
}
if (TCL_SIZE_ISNEG(index)) {
index = TCL_INDEX_START;
}
if (index > length) {
index = length;
}
outObj = TclStringReplace(interp, objv[1], index, 0, objv[3],
|
| ︙ | ︙ | |||
2303 2304 2305 2306 2307 2308 2309 |
end = Tcl_GetCharLength(objv[1]) - 1;
if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) {
return TCL_ERROR;
}
| | | 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 |
end = Tcl_GetCharLength(objv[1]) - 1;
if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) {
return TCL_ERROR;
}
if (!TCL_SIZE_ISNEG(last)) {
Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
2410 2411 2412 2413 2414 2415 2416 |
/*
* The following test screens out most empty substrings as candidates for
* replacement. When they are detected, no replacement is done, and the
* result is the original string.
*/
| | | | 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432 2433 2434 2435 2436 2437 |
/*
* The following test screens out most empty substrings as candidates for
* replacement. When they are detected, no replacement is done, and the
* result is the original string.
*/
if (TCL_SIZE_ISNEG(last) || /* Range ends before start of string */
(first + 1 > end + 1) || /* Range begins after end of string */
(last + 1 < first + 1)) { /* Range begins after it starts */
/*
* BUT!!! when (end < 0) -- an empty original string -- we can
* have (first <= end < 0 <= last) and an empty string is permitted
* to be replaced.
*/
Tcl_SetObjResult(interp, objv[1]);
} else {
Tcl_Obj *resultPtr;
if (TCL_SIZE_ISNEG(first)) {
first = TCL_INDEX_START;
}
if (last + 1 > end + 1) {
last = end;
}
resultPtr = TclStringReplace(interp, objv[1], first,
|
| ︙ | ︙ | |||
2522 2523 2524 2525 2526 2527 2528 |
index = length - 1;
}
cur = 0;
if (index + 1 > 1) {
p = &string[index];
(void)TclUniCharToUCS4(p, &ch);
| | | 2522 2523 2524 2525 2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 |
index = length - 1;
}
cur = 0;
if (index + 1 > 1) {
p = &string[index];
(void)TclUniCharToUCS4(p, &ch);
for (cur = index; !TCL_SIZE_ISNEG(cur); cur--) {
int delta = 0;
const Tcl_UniChar *next;
if (!Tcl_UniCharIsWordChar(ch)) {
break;
}
|
| ︙ | ︙ | |||
2584 2585 2586 2587 2588 2589 2590 |
return TCL_ERROR;
}
string = Tcl_GetUnicodeFromObj(objv[1], &length);
if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
return TCL_ERROR;
}
| | | 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 |
return TCL_ERROR;
}
string = Tcl_GetUnicodeFromObj(objv[1], &length);
if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK) {
return TCL_ERROR;
}
if (TCL_SIZE_ISNEG(index)) {
index = TCL_INDEX_START;
}
if (index + 1 <= length + 1) {
p = &string[index];
end = string+length;
for (cur = index; p < end; cur++) {
p += TclUniCharToUCS4(p, &ch);
|
| ︙ | ︙ | |||
2902 2903 2904 2905 2906 2907 2908 |
const char *start, *end;
Tcl_Obj *resultPtr;
length1 = Tcl_NumUtfChars(string1, length1) - 1;
if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
return TCL_ERROR;
}
| | | 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 |
const char *start, *end;
Tcl_Obj *resultPtr;
length1 = Tcl_NumUtfChars(string1, length1) - 1;
if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
return TCL_ERROR;
}
if (TCL_SIZE_ISNEG(first)) {
first = 0;
}
last = first;
if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
&last) != TCL_OK)) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
2987 2988 2989 2990 2991 2992 2993 |
const char *start, *end;
Tcl_Obj *resultPtr;
length1 = Tcl_NumUtfChars(string1, length1) - 1;
if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
return TCL_ERROR;
}
| | | 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 |
const char *start, *end;
Tcl_Obj *resultPtr;
length1 = Tcl_NumUtfChars(string1, length1) - 1;
if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
return TCL_ERROR;
}
if (TCL_SIZE_ISNEG(first)) {
first = TCL_INDEX_START;
}
last = first;
if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
&last) != TCL_OK)) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
3072 3073 3074 3075 3076 3077 3078 |
const char *start, *end;
Tcl_Obj *resultPtr;
length1 = Tcl_NumUtfChars(string1, length1) - 1;
if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
return TCL_ERROR;
}
| | | 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 |
const char *start, *end;
Tcl_Obj *resultPtr;
length1 = Tcl_NumUtfChars(string1, length1) - 1;
if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
return TCL_ERROR;
}
if (TCL_SIZE_ISNEG(first)) {
first = TCL_INDEX_START;
}
last = first;
if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
&last) != TCL_OK)) {
return TCL_ERROR;
|
| ︙ | ︙ |
Changes to generic/tclCompCmds.c.
| ︙ | ︙ | |||
283 284 285 286 287 288 289 |
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *dataTokenPtr;
int isScalar, localIndex, code = TCL_OK;
int isDataLiteral, isDataValid, isDataEven;
| | | 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 |
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *dataTokenPtr;
int isScalar, localIndex, code = TCL_OK;
int isDataLiteral, isDataValid, isDataEven;
Tcl_Size len;
int keyVar, valVar, infoIndex;
int fwd, offsetBack, offsetFwd;
Tcl_Obj *literalObj;
ForeachInfo *infoPtr;
if (parsePtr->numWords != 3) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
389 390 391 392 393 394 395 |
*/
keyVar = AnonymousLocal(envPtr);
valVar = AnonymousLocal(envPtr);
infoPtr = (ForeachInfo *)Tcl_Alloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *));
infoPtr->numLists = 1;
| | | 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 |
*/
keyVar = AnonymousLocal(envPtr);
valVar = AnonymousLocal(envPtr);
infoPtr = (ForeachInfo *)Tcl_Alloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *));
infoPtr->numLists = 1;
infoPtr->varLists[0] = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + 2 * sizeof(Tcl_Size));
infoPtr->varLists[0]->numVars = 2;
infoPtr->varLists[0]->varIndexes[0] = keyVar;
infoPtr->varLists[0]->varIndexes[1] = valVar;
infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);
/*
* Start issuing instructions to write to the array.
|
| ︙ | ︙ | |||
887 888 889 890 891 892 893 |
break;
}
(void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
}
if (listObj != NULL) {
Tcl_Obj **objs;
const char *bytes;
| | | 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 |
break;
}
(void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
}
if (listObj != NULL) {
Tcl_Obj **objs;
const char *bytes;
Tcl_Size len, slen;
TclListObjGetElementsM(NULL, listObj, &len, &objs);
objPtr = Tcl_ConcatObj(len, objs);
Tcl_DecrRefCount(listObj);
bytes = Tcl_GetStringFromObj(objPtr, &slen);
PushLiteral(envPtr, bytes, slen);
Tcl_DecrRefCount(objPtr);
|
| ︙ | ︙ | |||
1074 1075 1076 1077 1078 1079 1080 |
/*
* Parse the increment amount, if present.
*/
if (parsePtr->numWords == 4) {
const char *word;
| | | 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 |
/*
* Parse the increment amount, if present.
*/
if (parsePtr->numWords == 4) {
const char *word;
Tcl_Size numBytes;
int code;
Tcl_Token *incrTokenPtr;
Tcl_Obj *intObj;
incrTokenPtr = TokenAfter(keyTokenPtr);
if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
|
| ︙ | ︙ | |||
1289 1290 1291 1292 1293 1294 1295 |
{
DefineLineInformation; /* TIP #280 */
int worker; /* Temp var for building the value in. */
Tcl_Token *tokenPtr;
Tcl_Obj *keyObj, *valueObj, *dictObj;
const char *bytes;
int i;
| | | 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 |
{
DefineLineInformation; /* TIP #280 */
int worker; /* Temp var for building the value in. */
Tcl_Token *tokenPtr;
Tcl_Obj *keyObj, *valueObj, *dictObj;
const char *bytes;
int i;
Tcl_Size len;
if ((parsePtr->numWords & 1) == 0) {
return TCL_ERROR;
}
/*
* See if we can build the value at compile time...
|
| ︙ | ︙ | |||
1524 1525 1526 1527 1528 1529 1530 |
* construct a new dictionary with the loop
* body result. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr;
int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset;
| | | 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 |
* construct a new dictionary with the loop
* body result. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr;
int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset;
Tcl_Size numVars;
int endTargetOffset;
int collectVar = -1; /* Index of temp var holding the result
* dict. */
const char **argv;
Tcl_DString buffer;
/*
|
| ︙ | ︙ | |||
2289 2290 2291 2292 2293 2294 2295 |
}
static void
PrintDictUpdateInfo(
void *clientData,
Tcl_Obj *appendObj,
TCL_UNUSED(ByteCode *),
| | | | | | 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 2319 2320 2321 2322 2323 2324 |
}
static void
PrintDictUpdateInfo(
void *clientData,
Tcl_Obj *appendObj,
TCL_UNUSED(ByteCode *),
TCL_UNUSED(TCL_HASH_TYPE))
{
DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData;
Tcl_Size i;
for (i=0 ; i<duiPtr->length ; i++) {
if (i) {
Tcl_AppendToObj(appendObj, ", ", TCL_INDEX_NONE);
}
Tcl_AppendPrintfToObj(appendObj, "%%v%" TCL_Z_MODIFIER "u", duiPtr->varIndices[i]);
}
}
static void
DisassembleDictUpdateInfo(
void *clientData,
Tcl_Obj *dictObj,
TCL_UNUSED(ByteCode *),
TCL_UNUSED(TCL_HASH_TYPE))
{
DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData;
Tcl_Size i;
Tcl_Obj *variables;
TclNewObj(variables);
for (i=0 ; i<duiPtr->length ; i++) {
Tcl_ListObjAppendElement(NULL, variables,
Tcl_NewWideIntObj(duiPtr->varIndices[i]));
}
|
| ︙ | ︙ | |||
2686 2687 2688 2689 2690 2691 2692 |
ForeachInfo *infoPtr=NULL; /* Points to the structure describing this
* foreach command. Stored in a AuxData
* record in the ByteCode. */
Tcl_Token *tokenPtr, *bodyTokenPtr;
int jumpBackOffset, infoIndex, range;
int numWords, numLists, i, code = TCL_OK;
| | | 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 |
ForeachInfo *infoPtr=NULL; /* Points to the structure describing this
* foreach command. Stored in a AuxData
* record in the ByteCode. */
Tcl_Token *tokenPtr, *bodyTokenPtr;
int jumpBackOffset, infoIndex, range;
int numWords, numLists, i, code = TCL_OK;
Tcl_Size j;
Tcl_Obj *varListObj = NULL;
/*
* If the foreach command isn't in a procedure, don't compile it inline:
* the payoff is too small.
*/
|
| ︙ | ︙ | |||
2738 2739 2740 2741 2742 2743 2744 |
*/
TclNewObj(varListObj);
for (i = 0, tokenPtr = parsePtr->tokenPtr;
i < numWords-1;
i++, tokenPtr = TokenAfter(tokenPtr)) {
ForeachVarList *varListPtr;
| | | | | 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 |
*/
TclNewObj(varListObj);
for (i = 0, tokenPtr = parsePtr->tokenPtr;
i < numWords-1;
i++, tokenPtr = TokenAfter(tokenPtr)) {
ForeachVarList *varListPtr;
Tcl_Size numVars;
if (i%2 != 1) {
continue;
}
/*
* If the variable list is empty, we can enter an infinite loop when
* the interpreted version would not. Take care to ensure this does
* not happen. [Bug 1671138]
*/
if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
TCL_OK != TclListObjLengthM(NULL, varListObj, &numVars) ||
numVars == 0) {
code = TCL_ERROR;
goto done;
}
varListPtr = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes)
+ numVars * sizeof(Tcl_Size));
varListPtr->numVars = numVars;
infoPtr->varLists[i/2] = varListPtr;
infoPtr->numLists++;
for (j = 0; j < numVars; j++) {
Tcl_Obj *varNameObj;
const char *bytes;
int varIndex;
Tcl_Size length;
Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
bytes = Tcl_GetStringFromObj(varNameObj, &length);
varIndex = LocalScalar(bytes, length, envPtr);
if (varIndex < 0) {
code = TCL_ERROR;
|
| ︙ | ︙ | |||
2972 2973 2974 2975 2976 2977 2978 |
*/
static void
PrintForeachInfo(
void *clientData,
Tcl_Obj *appendObj,
TCL_UNUSED(ByteCode *),
| | | | 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 |
*/
static void
PrintForeachInfo(
void *clientData,
Tcl_Obj *appendObj,
TCL_UNUSED(ByteCode *),
TCL_UNUSED(TCL_HASH_TYPE))
{
ForeachInfo *infoPtr = (ForeachInfo *)clientData;
ForeachVarList *varsPtr;
Tcl_Size i, j;
Tcl_AppendToObj(appendObj, "data=[", TCL_INDEX_NONE);
for (i=0 ; i<infoPtr->numLists ; i++) {
if (i) {
Tcl_AppendToObj(appendObj, ", ", TCL_INDEX_NONE);
}
|
| ︙ | ︙ | |||
3012 3013 3014 3015 3016 3017 3018 |
}
static void
PrintNewForeachInfo(
void *clientData,
Tcl_Obj *appendObj,
TCL_UNUSED(ByteCode *),
| | | | 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 |
}
static void
PrintNewForeachInfo(
void *clientData,
Tcl_Obj *appendObj,
TCL_UNUSED(ByteCode *),
TCL_UNUSED(TCL_HASH_TYPE))
{
ForeachInfo *infoPtr = (ForeachInfo *)clientData;
ForeachVarList *varsPtr;
Tcl_Size i, j;
Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+" TCL_Z_MODIFIER "d, vars=",
infoPtr->loopCtTemp);
for (i=0 ; i<infoPtr->numLists ; i++) {
if (i) {
Tcl_AppendToObj(appendObj, ",", TCL_INDEX_NONE);
}
|
| ︙ | ︙ | |||
3042 3043 3044 3045 3046 3047 3048 |
}
static void
DisassembleForeachInfo(
void *clientData,
Tcl_Obj *dictObj,
TCL_UNUSED(ByteCode *),
| | | | 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 |
}
static void
DisassembleForeachInfo(
void *clientData,
Tcl_Obj *dictObj,
TCL_UNUSED(ByteCode *),
TCL_UNUSED(TCL_HASH_TYPE))
{
ForeachInfo *infoPtr = (ForeachInfo *)clientData;
ForeachVarList *varsPtr;
Tcl_Size i, j;
Tcl_Obj *objPtr, *innerPtr;
/*
* Data stores.
*/
TclNewObj(objPtr);
|
| ︙ | ︙ | |||
3089 3090 3091 3092 3093 3094 3095 |
}
static void
DisassembleNewForeachInfo(
void *clientData,
Tcl_Obj *dictObj,
TCL_UNUSED(ByteCode *),
| | | | 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 |
}
static void
DisassembleNewForeachInfo(
void *clientData,
Tcl_Obj *dictObj,
TCL_UNUSED(ByteCode *),
TCL_UNUSED(TCL_HASH_TYPE))
{
ForeachInfo *infoPtr = (ForeachInfo *)clientData;
ForeachVarList *varsPtr;
Tcl_Size i, j;
Tcl_Obj *objPtr, *innerPtr;
/*
* Jump offset.
*/
Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", TCL_INDEX_NONE),
|
| ︙ | ︙ |
Changes to generic/tclCompCmdsGR.c.
| ︙ | ︙ | |||
2374 2375 2376 2377 2378 2379 2380 |
int index = envPtr->exceptArrayNext - 1;
int enclosingCatch = 0;
while (index >= 0) {
ExceptionRange range = envPtr->exceptArrayPtr[index];
if ((range.type == CATCH_EXCEPTION_RANGE)
| | | 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 |
int index = envPtr->exceptArrayNext - 1;
int enclosingCatch = 0;
while (index >= 0) {
ExceptionRange range = envPtr->exceptArrayPtr[index];
if ((range.type == CATCH_EXCEPTION_RANGE)
&& TCL_SIZE_ISNEG(range.catchOffset)) {
enclosingCatch = 1;
break;
}
index--;
}
if (!enclosingCatch) {
/*
|
| ︙ | ︙ |
Changes to generic/tclCompCmdsSZ.c.
| ︙ | ︙ | |||
917 918 919 920 921 922 923 |
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *mapTokenPtr, *stringTokenPtr;
Tcl_Obj *mapObj, **objv;
const char *bytes;
| | | 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 |
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *mapTokenPtr, *stringTokenPtr;
Tcl_Obj *mapObj, **objv;
const char *bytes;
Tcl_Size len, slen;
/*
* We only handle the case:
*
* string map {foo bar} $thing
*
* That is, a literal two-element list (doesn't need to be brace-quoted,
|
| ︙ | ︙ | |||
1520 1521 1522 1523 1524 1525 1526 |
size_t numBytes,
int flags,
size_t line,
CompileEnv *envPtr)
{
Tcl_Token *endTokenPtr, *tokenPtr;
int breakOffset = 0, count = 0;
| | | 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 |
size_t numBytes,
int flags,
size_t line,
CompileEnv *envPtr)
{
Tcl_Token *endTokenPtr, *tokenPtr;
int breakOffset = 0, count = 0;
Tcl_Size bline = line;
Tcl_Parse parse;
Tcl_InterpState state = NULL;
TclSubstParse(interp, bytes, numBytes, flags, &parse, &state);
if (state != NULL) {
Tcl_ResetResult(interp);
}
|
| ︙ | ︙ | |||
1545 1546 1547 1548 1549 1550 1551 |
if (tokenPtr->type != TCL_TOKEN_TEXT && tokenPtr->type != TCL_TOKEN_BS) {
PUSH("");
count++;
}
for (endTokenPtr = tokenPtr + parse.numTokens;
tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) {
| | | 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 |
if (tokenPtr->type != TCL_TOKEN_TEXT && tokenPtr->type != TCL_TOKEN_BS) {
PUSH("");
count++;
}
for (endTokenPtr = tokenPtr + parse.numTokens;
tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) {
Tcl_Size length;
int literal, catchRange, breakJump;
char buf[4] = "";
JumpFixup startFixup, okFixup, returnFixup, breakFixup;
JumpFixup continueFixup, otherFixup, endFixup;
switch (tokenPtr->type) {
case TCL_TOKEN_TEXT:
|
| ︙ | ︙ | |||
1577 1578 1579 1580 1581 1582 1583 |
* TCL_OK or TCL_ERROR from the substituted variable read; if so,
* there is no need to generate elaborate exception-management
* code. Note that the first component of TCL_TOKEN_VARIABLE is
* always TCL_TOKEN_TEXT...
*/
if (tokenPtr->numComponents > 1) {
| | | 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 |
* TCL_OK or TCL_ERROR from the substituted variable read; if so,
* there is no need to generate elaborate exception-management
* code. Note that the first component of TCL_TOKEN_VARIABLE is
* always TCL_TOKEN_TEXT...
*/
if (tokenPtr->numComponents > 1) {
Tcl_Size i;
int foundCommand = 0;
for (i=2 ; i<=tokenPtr->numComponents ; i++) {
if (tokenPtr[i].type == TCL_TOKEN_COMMAND) {
foundCommand = 1;
break;
}
|
| ︙ | ︙ | |||
1941 1942 1943 1944 1945 1946 1947 |
* copies of the string from the input token for the generated tokens (it
* causes a crash during exception handling). When multiple tokens are
* available at this point, this is pretty easy.
*/
if (numWords == 1) {
const char *bytes;
| | | | 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 |
* copies of the string from the input token for the generated tokens (it
* causes a crash during exception handling). When multiple tokens are
* available at this point, this is pretty easy.
*/
if (numWords == 1) {
const char *bytes;
Tcl_Size maxLen, numBytes;
Tcl_Size bline; /* TIP #280: line of the pattern/action list,
* and start of list for when tracking the
* location. This list comes immediately after
* the value we switch on. */
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
2586 2587 2588 2589 2590 2591 2592 |
}
static void
PrintJumptableInfo(
void *clientData,
Tcl_Obj *appendObj,
TCL_UNUSED(ByteCode *),
| | | 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 |
}
static void
PrintJumptableInfo(
void *clientData,
Tcl_Obj *appendObj,
TCL_UNUSED(ByteCode *),
TCL_HASH_TYPE pcOffset)
{
JumptableInfo *jtPtr = (JumptableInfo *)clientData;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
const char *keyPtr;
size_t offset, i = 0;
|
| ︙ | ︙ | |||
2615 2616 2617 2618 2619 2620 2621 |
}
static void
DisassembleJumptableInfo(
void *clientData,
Tcl_Obj *dictObj,
TCL_UNUSED(ByteCode *),
| | | 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 |
}
static void
DisassembleJumptableInfo(
void *clientData,
Tcl_Obj *dictObj,
TCL_UNUSED(ByteCode *),
TCL_UNUSED(TCL_HASH_TYPE))
{
JumptableInfo *jtPtr = (JumptableInfo *)clientData;
Tcl_Obj *mapping;
Tcl_HashEntry *hPtr;
Tcl_HashSearch search;
const char *keyPtr;
size_t offset;
|
| ︙ | ︙ | |||
2712 2713 2714 2715 2716 2717 2718 |
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
int numWords = parsePtr->numWords;
Tcl_Token *codeToken, *msgToken;
Tcl_Obj *objPtr;
int codeKnown, codeIsList, codeIsValid;
| | | 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 |
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation; /* TIP #280 */
int numWords = parsePtr->numWords;
Tcl_Token *codeToken, *msgToken;
Tcl_Obj *objPtr;
int codeKnown, codeIsList, codeIsValid;
Tcl_Size len;
if (numWords != 3) {
return TCL_ERROR;
}
codeToken = TokenAfter(parsePtr->tokenPtr);
msgToken = TokenAfter(codeToken);
|
| ︙ | ︙ | |||
2853 2854 2855 2856 2857 2858 2859 |
memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers);
matchCodes = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);
resultVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);
optionVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);
for (i=0 ; i<numHandlers ; i++) {
Tcl_Obj *tmpObj, **objv;
| | | 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 |
memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers);
matchCodes = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);
resultVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);
optionVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);
for (i=0 ; i<numHandlers ; i++) {
Tcl_Obj *tmpObj, **objv;
Tcl_Size objc;
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
goto failedToCompile;
}
if (tokenPtr[1].size == 4
&& !strncmp(tokenPtr[1].start, "trap", 4)) {
/*
|
| ︙ | ︙ | |||
2918 2919 2920 2921 2922 2923 2924 |
}
if (TclListObjGetElementsM(NULL, tmpObj, &objc, &objv) != TCL_OK
|| (objc > 2)) {
TclDecrRefCount(tmpObj);
goto failedToCompile;
}
if (objc > 0) {
| | | | 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 |
}
if (TclListObjGetElementsM(NULL, tmpObj, &objc, &objv) != TCL_OK
|| (objc > 2)) {
TclDecrRefCount(tmpObj);
goto failedToCompile;
}
if (objc > 0) {
Tcl_Size len;
const char *varname = Tcl_GetStringFromObj(objv[0], &len);
resultVarIndices[i] = LocalScalar(varname, len, envPtr);
if (resultVarIndices[i] < 0) {
TclDecrRefCount(tmpObj);
goto failedToCompile;
}
} else {
resultVarIndices[i] = -1;
}
if (objc == 2) {
Tcl_Size len;
const char *varname = Tcl_GetStringFromObj(objv[1], &len);
optionVarIndices[i] = LocalScalar(varname, len, envPtr);
if (optionVarIndices[i] < 0) {
TclDecrRefCount(tmpObj);
goto failedToCompile;
}
|
| ︙ | ︙ | |||
3052 3053 3054 3055 3056 3057 3058 |
int *resultVars,
int *optionVars,
Tcl_Token **handlerTokens)
{
DefineLineInformation; /* TIP #280 */
int range, resultVar, optionsVar;
int i, j, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0;
| | | 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 |
int *resultVars,
int *optionVars,
Tcl_Token **handlerTokens)
{
DefineLineInformation; /* TIP #280 */
int range, resultVar, optionsVar;
int i, j, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0;
Tcl_Size slen, len;
int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
int *noError;
char buf[TCL_INTEGER_SPACE];
resultVar = AnonymousLocal(envPtr);
optionsVar = AnonymousLocal(envPtr);
if (resultVar < 0 || optionsVar < 0) {
|
| ︙ | ︙ | |||
3266 3267 3268 3269 3270 3271 3272 |
Tcl_Token *finallyToken) /* Not NULL */
{
DefineLineInformation; /* TIP #280 */
int range, resultVar, optionsVar, i, j, forwardsNeedFixing = 0;
int trapZero = 0, afterBody = 0, finalOK, finalError, noFinalError;
int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
char buf[TCL_INTEGER_SPACE];
| | | 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 |
Tcl_Token *finallyToken) /* Not NULL */
{
DefineLineInformation; /* TIP #280 */
int range, resultVar, optionsVar, i, j, forwardsNeedFixing = 0;
int trapZero = 0, afterBody = 0, finalOK, finalError, noFinalError;
int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
char buf[TCL_INTEGER_SPACE];
Tcl_Size slen, len;
resultVar = AnonymousLocal(envPtr);
optionsVar = AnonymousLocal(envPtr);
if (resultVar < 0 || optionsVar < 0) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
3676 3677 3678 3679 3680 3681 3682 |
continue;
}
}
return TCL_ERROR;
}
if (varCount == 0) {
const char *bytes;
| | | 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 |
continue;
}
}
return TCL_ERROR;
}
if (varCount == 0) {
const char *bytes;
Tcl_Size len;
bytes = Tcl_GetStringFromObj(leadingWord, &len);
if (i == 1 && len == 11 && !strncmp("-nocomplain", bytes, 11)) {
flags = 0;
haveFlags++;
} else if (i == (2 - flags) && len == 2 && !strncmp("--", bytes, 2)) {
haveFlags++;
|
| ︙ | ︙ | |||
4069 4070 4071 4072 4073 4074 4075 |
Tcl_Parse *parsePtr,
const char *identity,
int instruction,
CompileEnv *envPtr)
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
| | | 4069 4070 4071 4072 4073 4074 4075 4076 4077 4078 4079 4080 4081 4082 4083 |
Tcl_Parse *parsePtr,
const char *identity,
int instruction,
CompileEnv *envPtr)
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
Tcl_Size words;
/* TODO: Consider support for compiling expanded args. */
for (words=1 ; words<parsePtr->numWords ; words++) {
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, words);
}
if (parsePtr->numWords <= 2) {
|
| ︙ | ︙ | |||
4172 4173 4174 4175 4176 4177 4178 |
/*
* No local variable space!
*/
return TCL_ERROR;
} else {
int tmpIndex = AnonymousLocal(envPtr);
| | | 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 |
/*
* No local variable space!
*/
return TCL_ERROR;
} else {
int tmpIndex = AnonymousLocal(envPtr);
Tcl_Size words;
tokenPtr = TokenAfter(parsePtr->tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 1);
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 2);
STORE(tmpIndex);
TclEmitOpcode(instruction, envPtr);
|
| ︙ | ︙ | |||
4308 4309 4310 4311 4312 4313 4314 |
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
TCL_UNUSED(Command *),
CompileEnv *envPtr)
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
| | | 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 |
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
TCL_UNUSED(Command *),
CompileEnv *envPtr)
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
Tcl_Size words;
/*
* This one has its own implementation because the ** operator is the only
* one with right associativity.
*/
for (words=1 ; words<parsePtr->numWords ; words++) {
|
| ︙ | ︙ | |||
4509 4510 4511 4512 4513 4514 4515 |
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
TCL_UNUSED(Command *),
CompileEnv *envPtr)
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
| | | 4509 4510 4511 4512 4513 4514 4515 4516 4517 4518 4519 4520 4521 4522 4523 |
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
TCL_UNUSED(Command *),
CompileEnv *envPtr)
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
Tcl_Size words;
/* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords == 1) {
/*
* Fallback to direct eval to report syntax error.
*/
|
| ︙ | ︙ | |||
4554 4555 4556 4557 4558 4559 4560 |
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
TCL_UNUSED(Command *),
CompileEnv *envPtr)
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
| | | 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 |
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
TCL_UNUSED(Command *),
CompileEnv *envPtr)
{
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr = parsePtr->tokenPtr;
Tcl_Size words;
/* TODO: Consider support for compiling expanded args. */
if (parsePtr->numWords == 1) {
/*
* Fallback to direct eval to report syntax error.
*/
|
| ︙ | ︙ |
Changes to generic/tclCompExpr.c.
| ︙ | ︙ | |||
1856 1857 1858 1859 1860 1861 1862 |
*----------------------------------------------------------------------
*/
int
Tcl_ParseExpr(
Tcl_Interp *interp, /* Used for error reporting. */
const char *start, /* Start of source string to parse. */
| | | | 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 |
*----------------------------------------------------------------------
*/
int
Tcl_ParseExpr(
Tcl_Interp *interp, /* Used for error reporting. */
const char *start, /* Start of source string to parse. */
Tcl_Size numBytes, /* Number of bytes in string. If -1, the
* string consists of all bytes up to the
* first null character. */
Tcl_Parse *parsePtr) /* Structure to fill with information about
* the parsed expression; any previous
* information in the structure is ignored. */
{
int code;
OpNode *opTree = NULL; /* Will point to the tree of operators. */
Tcl_Obj *litList; /* List to hold the literals. */
Tcl_Obj *funcList; /* List to hold the functon names. */
Tcl_Parse *exprParsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
/* Holds the Tcl_Tokens of substitutions. */
TclNewObj(litList);
TclNewObj(funcList);
if (TCL_SIZE_ISNEG(numBytes)) {
numBytes = (start ? strlen(start) : 0);
}
code = ParseExpr(interp, start, numBytes, &opTree, litList, funcList,
exprParsePtr, 1 /* parseOnly */);
Tcl_DecrRefCount(funcList);
Tcl_DecrRefCount(litList);
|
| ︙ | ︙ | |||
2193 2194 2195 2196 2197 2198 2199 |
*----------------------------------------------------------------------
*/
void
TclCompileExpr(
Tcl_Interp *interp, /* Used for error reporting. */
const char *script, /* The source script to compile. */
| | | 2193 2194 2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 |
*----------------------------------------------------------------------
*/
void
TclCompileExpr(
Tcl_Interp *interp, /* Used for error reporting. */
const char *script, /* The source script to compile. */
Tcl_Size numBytes, /* Number of bytes in script. */
CompileEnv *envPtr, /* Holds resulting instructions. */
int optimize) /* 0 for one-off expressions. */
{
OpNode *opTree = NULL; /* Will point to the tree of operators */
Tcl_Obj *litList; /* List to hold the literals */
Tcl_Obj *funcList; /* List to hold the functon names*/
Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
|
| ︙ | ︙ |
Changes to generic/tclCompile.c.
| ︙ | ︙ | |||
676 677 678 679 680 681 682 | static ByteCode * CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); static void DupByteCodeInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static unsigned char * EncodeCmdLocMap(CompileEnv *envPtr, ByteCode *codePtr, unsigned char *startPtr); static void EnterCmdExtentData(CompileEnv *envPtr, | | | | | | 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 | static ByteCode * CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); static void DupByteCodeInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static unsigned char * EncodeCmdLocMap(CompileEnv *envPtr, ByteCode *codePtr, unsigned char *startPtr); static void EnterCmdExtentData(CompileEnv *envPtr, Tcl_Size cmdNumber, Tcl_Size numSrcBytes, Tcl_Size numCodeBytes); static void EnterCmdStartData(CompileEnv *envPtr, Tcl_Size cmdNumber, Tcl_Size srcOffset, Tcl_Size codeOffset); static void FreeByteCodeInternalRep(Tcl_Obj *objPtr); static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr); static int GetCmdLocEncodingSize(CompileEnv *envPtr); static int IsCompactibleCompileEnv(CompileEnv *envPtr); static void PreventCycle(Tcl_Obj *objPtr, CompileEnv *envPtr); #ifdef TCL_COMPILE_STATS static void RecordByteCodeStats(ByteCode *codePtr); #endif /* TCL_COMPILE_STATS */ static int SetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void StartExpanding(CompileEnv *envPtr); /* * TIP #280: Helper for building the per-word line information of all compiled * commands. */ static void EnterCmdWordData(ExtCmdLoc *eclPtr, Tcl_Size srcOffset, Tcl_Token *tokenPtr, const char *cmd, Tcl_Size numWords, Tcl_Size line, int *clNext, int **lines, CompileEnv *envPtr); static void ReleaseCmdWordData(ExtCmdLoc *eclPtr); /* * tclByteCodeType provides the standard type management procedures for the * bytecode type. */ |
| ︙ | ︙ | |||
772 773 774 775 776 777 778 |
Tcl_Obj *objPtr, /* The object to make a ByteCode object. */
CompileHookProc *hookProc, /* Procedure to invoke after compilation. */
void *clientData) /* Hook procedure private data. */
{
Interp *iPtr = (Interp *) interp;
CompileEnv compEnv; /* Compilation environment structure allocated
* in frame. */
| | | 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 |
Tcl_Obj *objPtr, /* The object to make a ByteCode object. */
CompileHookProc *hookProc, /* Procedure to invoke after compilation. */
void *clientData) /* Hook procedure private data. */
{
Interp *iPtr = (Interp *) interp;
CompileEnv compEnv; /* Compilation environment structure allocated
* in frame. */
Tcl_Size length;
int result = TCL_OK;
const char *stringPtr;
Proc *procPtr = iPtr->compiledProcPtr;
ContLineLoc *clLocPtr;
#ifdef TCL_COMPILE_DEBUG
if (!traceInitialized) {
|
| ︙ | ︙ | |||
1387 1388 1389 1390 1391 1392 1393 |
TclReleaseByteCode(codePtr);
}
static void
ReleaseCmdWordData(
ExtCmdLoc *eclPtr)
{
| | | 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 |
TclReleaseByteCode(codePtr);
}
static void
ReleaseCmdWordData(
ExtCmdLoc *eclPtr)
{
Tcl_Size i;
if (eclPtr->type == TCL_LOCATION_SOURCE) {
Tcl_DecrRefCount(eclPtr->path);
}
for (i=0 ; i<eclPtr->nuloc ; i++) {
Tcl_Free(eclPtr->loc[i].line);
}
|
| ︙ | ︙ | |||
1549 1550 1551 1552 1553 1554 1555 | * ctx.data.tebc.codePtr is used instead. */ TclGetSrcInfoForPc(ctxPtr); pc = 1; } | | | 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 |
* ctx.data.tebc.codePtr is used instead.
*/
TclGetSrcInfoForPc(ctxPtr);
pc = 1;
}
if ((ctxPtr->nline <= (Tcl_Size)word) || (ctxPtr->line[word] < 0)) {
/*
* Word is not a literal, relative counting.
*/
envPtr->line = 1;
envPtr->extCmdMapPtr->type =
(envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC);
|
| ︙ | ︙ | |||
1643 1644 1645 1646 1647 1648 1649 |
}
if (envPtr->iPtr) {
/*
* We never converted to Bytecode, so free the things we would
* have transferred to it.
*/
| | | 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 |
}
if (envPtr->iPtr) {
/*
* We never converted to Bytecode, so free the things we would
* have transferred to it.
*/
Tcl_Size i;
LiteralEntry *entryPtr = envPtr->literalArrayPtr;
AuxData *auxDataPtr = envPtr->auxDataArrayPtr;
for (i = 0; i < envPtr->literalArrayNext; i++) {
TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, entryPtr->objPtr);
entryPtr++;
}
|
| ︙ | ︙ | |||
1744 1745 1746 1747 1748 1749 1750 |
Tcl_AppendToObj(tempPtr, tokenPtr->start, tokenPtr->size);
}
break;
case TCL_TOKEN_BS:
if (tempPtr != NULL) {
char utfBuf[4] = "";
| | | 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 |
Tcl_AppendToObj(tempPtr, tokenPtr->start, tokenPtr->size);
}
break;
case TCL_TOKEN_BS:
if (tempPtr != NULL) {
char utfBuf[4] = "";
Tcl_Size length = TclParseBackslash(tokenPtr->start,
tokenPtr->size, NULL, utfBuf);
Tcl_AppendToObj(tempPtr, utfBuf, length);
}
break;
default:
|
| ︙ | ︙ | |||
1808 1809 1810 1811 1812 1813 1814 |
Tcl_Interp *interp,
Tcl_Obj *cmdObj,
CompileEnv *envPtr)
{
const char *bytes;
Command *cmdPtr;
int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME;
| | | 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 |
Tcl_Interp *interp,
Tcl_Obj *cmdObj,
CompileEnv *envPtr)
{
const char *bytes;
Command *cmdPtr;
int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME;
Tcl_Size length;
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
extraLiteralFlags |= LITERAL_UNSHARED;
}
bytes = Tcl_GetStringFromObj(cmdObj, &length);
|
| ︙ | ︙ | |||
2319 2320 2321 2322 2323 2324 2325 |
void
TclCompileVarSubst(
Tcl_Interp *interp,
Tcl_Token *tokenPtr,
CompileEnv *envPtr)
{
const char *p, *name = tokenPtr[1].start;
| | | | 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 2332 2333 2334 |
void
TclCompileVarSubst(
Tcl_Interp *interp,
Tcl_Token *tokenPtr,
CompileEnv *envPtr)
{
const char *p, *name = tokenPtr[1].start;
Tcl_Size i, nameBytes = tokenPtr[1].size;
Tcl_Size localVar;
int localVarName = 1;
/*
* Determine how the variable name should be handled: if it contains any
* namespace qualifiers it is not a local variable (localVarName=-1); if
* it looks like an array element and the token has a single component, it
* should not be created here [Bug 569438] (localVarName=0); otherwise,
|
| ︙ | ︙ | |||
2352 2353 2354 2355 2356 2357 2358 |
* of local variables in a procedure frame.
*/
localVar = TCL_INDEX_NONE;
if (localVarName != -1) {
localVar = TclFindCompiledLocal(name, nameBytes, localVarName, envPtr);
}
| | | | | 2352 2353 2354 2355 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 |
* of local variables in a procedure frame.
*/
localVar = TCL_INDEX_NONE;
if (localVarName != -1) {
localVar = TclFindCompiledLocal(name, nameBytes, localVarName, envPtr);
}
if (TCL_SIZE_ISNEG(localVar)) {
PushLiteral(envPtr, name, nameBytes);
}
/*
* Emit instructions to load the variable.
*/
TclAdvanceLines(&envPtr->line, tokenPtr[1].start,
tokenPtr[1].start + tokenPtr[1].size);
if (tokenPtr->numComponents == 1) {
if (TCL_SIZE_ISNEG(localVar)) {
TclEmitOpcode(INST_LOAD_STK, envPtr);
} else if (localVar <= 255) {
TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr);
} else {
TclEmitInstInt4(INST_LOAD_SCALAR4, localVar, envPtr);
}
} else {
TclCompileTokens(interp, tokenPtr+2, tokenPtr->numComponents-1, envPtr);
if (TCL_SIZE_ISNEG(localVar)) {
TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
} else if (localVar <= 255) {
TclEmitInstInt1(INST_LOAD_ARRAY1, localVar, envPtr);
} else {
TclEmitInstInt4(INST_LOAD_ARRAY4, localVar, envPtr);
}
}
|
| ︙ | ︙ | |||
2396 2397 2398 2399 2400 2401 2402 |
* Must be at least 1. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
Tcl_DString textBuffer; /* Holds concatenated chars from adjacent
* TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
char buffer[4] = "";
int i, numObjsToConcat, adjust;
| | | 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 |
* Must be at least 1. */
CompileEnv *envPtr) /* Holds the resulting instructions. */
{
Tcl_DString textBuffer; /* Holds concatenated chars from adjacent
* TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
char buffer[4] = "";
int i, numObjsToConcat, adjust;
Tcl_Size length;
unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
int isLiteral, maxNumCL, numCL;
int *clPosition = NULL;
int depth = TclGetStackDepth(envPtr);
int count = count1;
|
| ︙ | ︙ | |||
2772 2773 2774 2775 2776 2777 2778 |
*/
static void
PreventCycle(
Tcl_Obj *objPtr,
CompileEnv *envPtr)
{
| | | | 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 |
*/
static void
PreventCycle(
Tcl_Obj *objPtr,
CompileEnv *envPtr)
{
Tcl_Size i;
for (i = 0; i < envPtr->literalArrayNext; i++) {
if (objPtr == TclFetchLiteral(envPtr, i)) {
/*
* Prevent circular reference where the bytecode internalrep of
* a value contains a literal which is that same value.
* If this is allowed to happen, refcount decrements may not
* reach zero, and memory may leak. Bugs 467523, 3357771
*
* NOTE: [Bugs 3392070, 3389764] We make a copy based completely
* on the string value, and do not call Tcl_DuplicateObj() so we
* can be sure we do not have any lingering cycles hiding in
* the internalrep.
*/
Tcl_Size numBytes;
const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);
Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes);
Tcl_IncrRefCount(copyPtr);
TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr);
envPtr->literalArrayPtr[i].objPtr = copyPtr;
|
| ︙ | ︙ | |||
2989 2990 2991 2992 2993 2994 2995 | * Side effects: * Creates and registers a new local variable if create is 1 and the * variable is unknown, or if the name is NULL. * *---------------------------------------------------------------------- */ | | | | | | | | 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 3019 3020 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 |
* Side effects:
* Creates and registers a new local variable if create is 1 and the
* variable is unknown, or if the name is NULL.
*
*----------------------------------------------------------------------
*/
Tcl_Size
TclFindCompiledLocal(
const char *name, /* Points to first character of the name of a
* scalar or array variable. If NULL, a
* temporary var should be created. */
Tcl_Size nameBytes, /* Number of bytes in the name. */
int create, /* If 1, allocate a local frame entry for the
* variable if it is new. */
CompileEnv *envPtr) /* Points to the current compile environment*/
{
CompiledLocal *localPtr;
Tcl_Size localVar = TCL_INDEX_NONE;
Tcl_Size i;
Proc *procPtr;
/*
* If not creating a temporary, does a local variable of the specified
* name already exist?
*/
procPtr = envPtr->procPtr;
if (procPtr == NULL) {
/*
* Compiling a non-body script: give it read access to the LVT in the
* current localCache
*/
LocalCache *cachePtr = envPtr->iPtr->varFramePtr->localCachePtr;
const char *localName;
Tcl_Obj **varNamePtr;
Tcl_Size len;
if (!cachePtr || !name) {
return TCL_INDEX_NONE;
}
varNamePtr = &cachePtr->varName0;
for (i=0; i < cachePtr->numVars; varNamePtr++, i++) {
if (*varNamePtr) {
localName = Tcl_GetStringFromObj(*varNamePtr, &len);
if ((len == nameBytes) && !strncmp(name, localName, len)) {
return i;
}
}
}
return TCL_INDEX_NONE;
}
if (name != NULL) {
Tcl_Size localCt = procPtr->numCompiledLocals;
localPtr = procPtr->firstLocalPtr;
for (i = 0; i < localCt; i++) {
if (!TclIsVarTemporary(localPtr)) {
char *localName = localPtr->name;
if ((nameBytes == localPtr->nameLength) &&
|
| ︙ | ︙ | |||
3167 3168 3169 3170 3171 3172 3173 |
*/
static void
EnterCmdStartData(
CompileEnv *envPtr, /* Points to the compilation environment
* structure in which to enter command
* location information. */
| | | | | | 3167 3168 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 |
*/
static void
EnterCmdStartData(
CompileEnv *envPtr, /* Points to the compilation environment
* structure in which to enter command
* location information. */
Tcl_Size cmdIndex, /* Index of the command whose start data is
* being set. */
Tcl_Size srcOffset, /* Offset of first char of the command. */
Tcl_Size codeOffset) /* Offset of first byte of command code. */
{
CmdLocation *cmdLocPtr;
if (TCL_SIZE_ISNEG(cmdIndex) || (cmdIndex >= envPtr->numCommands)) {
Tcl_Panic("EnterCmdStartData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex);
}
if (cmdIndex >= envPtr->cmdMapEnd) {
/*
* Expand the command location array by allocating more storage from
* the heap. The currently allocated CmdLocation entries are stored
|
| ︙ | ︙ | |||
3246 3247 3248 3249 3250 3251 3252 |
*/
static void
EnterCmdExtentData(
CompileEnv *envPtr, /* Points to the compilation environment
* structure in which to enter command
* location information. */
| | | | | | 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 |
*/
static void
EnterCmdExtentData(
CompileEnv *envPtr, /* Points to the compilation environment
* structure in which to enter command
* location information. */
Tcl_Size cmdIndex, /* Index of the command whose source and code
* length data is being set. */
Tcl_Size numSrcBytes, /* Number of command source chars. */
Tcl_Size numCodeBytes) /* Offset of last byte of command code. */
{
CmdLocation *cmdLocPtr;
if (TCL_SIZE_ISNEG(cmdIndex) || (cmdIndex >= envPtr->numCommands)) {
Tcl_Panic("EnterCmdExtentData: bad command index %" TCL_Z_MODIFIER "u", cmdIndex);
}
if (cmdIndex > envPtr->cmdMapEnd) {
Tcl_Panic("EnterCmdExtentData: missing start data for command %" TCL_Z_MODIFIER "u",
cmdIndex);
}
|
| ︙ | ︙ | |||
3292 3293 3294 3295 3296 3297 3298 |
*/
static void
EnterCmdWordData(
ExtCmdLoc *eclPtr, /* Points to the map environment structure in
* which to enter command location
* information. */
| | | | | | 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 |
*/
static void
EnterCmdWordData(
ExtCmdLoc *eclPtr, /* Points to the map environment structure in
* which to enter command location
* information. */
Tcl_Size srcOffset, /* Offset of first char of the command. */
Tcl_Token *tokenPtr,
const char *cmd,
Tcl_Size numWords,
Tcl_Size line,
int *clNext,
int **wlines,
CompileEnv *envPtr)
{
ECL *ePtr;
const char *last;
Tcl_Size wordIdx, wordLine;
int *wwlines, *wordNext;
if (eclPtr->nuloc >= eclPtr->nloc) {
/*
* Expand the ECL array by allocating more storage from the heap. The
* currently allocated ECL entries are stored from eclPtr->loc[0] up
* to eclPtr->loc[eclPtr->nuloc-1] (inclusive).
|
| ︙ | ︙ | |||
3369 3370 3371 3372 3373 3374 3375 | * the array in expanded: a new array of double the size is allocated, if * envPtr->mallocedExceptArray is non-zero the old array is freed, and * ExceptionRange entries are copied from the old array to the new one. * *---------------------------------------------------------------------- */ | | | | 3369 3370 3371 3372 3373 3374 3375 3376 3377 3378 3379 3380 3381 3382 3383 3384 3385 3386 3387 3388 3389 3390 3391 |
* the array in expanded: a new array of double the size is allocated, if
* envPtr->mallocedExceptArray is non-zero the old array is freed, and
* ExceptionRange entries are copied from the old array to the new one.
*
*----------------------------------------------------------------------
*/
Tcl_Size
TclCreateExceptRange(
ExceptionRangeType type, /* The kind of ExceptionRange desired. */
CompileEnv *envPtr)/* Points to CompileEnv for which to create a
* new ExceptionRange structure. */
{
ExceptionRange *rangePtr;
ExceptionAux *auxPtr;
Tcl_Size index = envPtr->exceptArrayNext;
if (index >= envPtr->exceptArrayEnd) {
/*
* Expand the ExceptionRange array. The currently allocated entries
* are stored between elements 0 and (envPtr->exceptArrayNext - 1)
* [inclusive].
*/
|
| ︙ | ︙ | |||
3508 3509 3510 3511 3512 3513 3514 |
Tcl_Panic("trying to add 'break' fixup to full exception range");
}
if (++auxPtr->numBreakTargets > auxPtr->allocBreakTargets) {
auxPtr->allocBreakTargets *= 2;
auxPtr->allocBreakTargets += 2;
if (auxPtr->breakTargets) {
| | | 3508 3509 3510 3511 3512 3513 3514 3515 3516 3517 3518 3519 3520 3521 3522 |
Tcl_Panic("trying to add 'break' fixup to full exception range");
}
if (++auxPtr->numBreakTargets > auxPtr->allocBreakTargets) {
auxPtr->allocBreakTargets *= 2;
auxPtr->allocBreakTargets += 2;
if (auxPtr->breakTargets) {
auxPtr->breakTargets = (TCL_HASH_TYPE *)Tcl_Realloc(auxPtr->breakTargets,
sizeof(size_t) * auxPtr->allocBreakTargets);
} else {
auxPtr->breakTargets =
(size_t *)Tcl_Alloc(sizeof(size_t) * auxPtr->allocBreakTargets);
}
}
auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr);
|
| ︙ | ︙ | |||
3730 3731 3732 3733 3734 3735 3736 | * * Side effects: * If there is not enough room in the CompileEnv's AuxData array, its size * is doubled. *---------------------------------------------------------------------- */ | | | | 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 |
*
* Side effects:
* If there is not enough room in the CompileEnv's AuxData array, its size
* is doubled.
*----------------------------------------------------------------------
*/
Tcl_Size
TclCreateAuxData(
void *clientData, /* The compilation auxiliary data to store in
* the new aux data record. */
const AuxDataType *typePtr, /* Pointer to the type to attach to this
* AuxData */
CompileEnv *envPtr)/* Points to the CompileEnv for which a new
* aux data structure is to be allocated. */
{
Tcl_Size index; /* Index for the new AuxData structure. */
AuxData *auxDataPtr;
/* Points to the new AuxData structure */
index = envPtr->auxDataArrayNext;
if (index >= envPtr->auxDataArrayEnd) {
/*
* Expand the AuxData array. The currently allocated entries are
|
| ︙ | ︙ | |||
4412 4413 4414 4415 4416 4417 4418 |
ByteCode *codePtr, /* ByteCode in which to encode envPtr's
* command location information. */
unsigned char *startPtr) /* Points to the first byte in codePtr's
* memory block where the location information
* is to be stored. */
{
CmdLocation *mapPtr = envPtr->cmdMapPtr;
| | | | | | 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 |
ByteCode *codePtr, /* ByteCode in which to encode envPtr's
* command location information. */
unsigned char *startPtr) /* Points to the first byte in codePtr's
* memory block where the location information
* is to be stored. */
{
CmdLocation *mapPtr = envPtr->cmdMapPtr;
Tcl_Size i, codeDelta, codeLen, srcLen, prevOffset;
Tcl_Size numCmds = envPtr->numCommands;
unsigned char *p = startPtr;
int srcDelta;
/*
* Encode the code offset for each command as a sequence of deltas.
*/
codePtr->codeDeltaStart = p;
prevOffset = 0;
for (i = 0; i < numCmds; i++) {
codeDelta = mapPtr[i].codeOffset - prevOffset;
if (TCL_SIZE_ISNEG(codeDelta)) {
Tcl_Panic("EncodeCmdLocMap: bad code offset");
} else if (codeDelta <= 127) {
TclStoreInt1AtPtr(codeDelta, p);
p++;
} else {
TclStoreInt1AtPtr(0xFF, p);
p++;
TclStoreInt4AtPtr(codeDelta, p);
p += 4;
}
prevOffset = mapPtr[i].codeOffset;
}
/*
* Encode the code length for each command.
*/
codePtr->codeLengthStart = p;
for (i = 0; i < numCmds; i++) {
codeLen = mapPtr[i].numCodeBytes;
if (TCL_SIZE_ISNEG(codeLen)) {
Tcl_Panic("EncodeCmdLocMap: bad code length");
} else if (codeLen <= 127) {
TclStoreInt1AtPtr(codeLen, p);
p++;
} else {
TclStoreInt1AtPtr(0xFF, p);
p++;
|
| ︙ | ︙ | |||
4486 4487 4488 4489 4490 4491 4492 |
/*
* Encode the source length for each command.
*/
codePtr->srcLengthStart = p;
for (i = 0; i < numCmds; i++) {
srcLen = mapPtr[i].numSrcBytes;
| | | 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4498 4499 4500 |
/*
* Encode the source length for each command.
*/
codePtr->srcLengthStart = p;
for (i = 0; i < numCmds; i++) {
srcLen = mapPtr[i].numSrcBytes;
if (TCL_SIZE_ISNEG(srcLen)) {
Tcl_Panic("EncodeCmdLocMap: bad source length");
} else if (srcLen <= 127) {
TclStoreInt1AtPtr(srcLen, p);
p++;
} else {
TclStoreInt1AtPtr(0xFF, p);
p++;
|
| ︙ | ︙ |
Changes to generic/tclDecls.h.
| ︙ | ︙ | |||
4229 4230 4231 4232 4233 4234 4235 |
*/
#define Tcl_EvalObj(interp, objPtr) \
Tcl_EvalObjEx(interp, objPtr, 0)
#define Tcl_GlobalEvalObj(interp, objPtr) \
Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
| | | 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 |
*/
#define Tcl_EvalObj(interp, objPtr) \
Tcl_EvalObjEx(interp, objPtr, 0)
#define Tcl_GlobalEvalObj(interp, objPtr) \
Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
#if !defined(TCL_UNSIGNED_SIZE) && !defined(BUILD_tcl) && TCL_MAJOR_VERSION > 8
# ifdef USE_TCL_STUBS
# undef Tcl_Gets
# undef Tcl_GetsObj
# undef Tcl_Read
# undef Tcl_Ungets
# undef Tcl_Write
# undef Tcl_ReadChars
|
| ︙ | ︙ |
Changes to generic/tclDictObj.c.
| ︙ | ︙ | |||
775 776 777 778 779 780 781 |
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclTraceDictPath(
Tcl_Interp *interp,
Tcl_Obj *dictPtr,
| | | | 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 |
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclTraceDictPath(
Tcl_Interp *interp,
Tcl_Obj *dictPtr,
Tcl_Size keyc,
Tcl_Obj *const keyv[],
int flags)
{
Dict *dict, *newDict;
Tcl_Size i;
DictGetInternalRep(dictPtr, dict);
if (dict == NULL) {
if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
return NULL;
}
DictGetInternalRep(dictPtr, dict);
|
| ︙ | ︙ | |||
1277 1278 1279 1280 1281 1282 1283 |
*----------------------------------------------------------------------
*/
int
Tcl_DictObjPutKeyList(
Tcl_Interp *interp,
Tcl_Obj *dictPtr,
| | | 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 |
*----------------------------------------------------------------------
*/
int
Tcl_DictObjPutKeyList(
Tcl_Interp *interp,
Tcl_Obj *dictPtr,
Tcl_Size keyc,
Tcl_Obj *const keyv[],
Tcl_Obj *valuePtr)
{
Dict *dict;
Tcl_HashEntry *hPtr;
int isNew;
|
| ︙ | ︙ | |||
1338 1339 1340 1341 1342 1343 1344 |
*----------------------------------------------------------------------
*/
int
Tcl_DictObjRemoveKeyList(
Tcl_Interp *interp,
Tcl_Obj *dictPtr,
| | | 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 |
*----------------------------------------------------------------------
*/
int
Tcl_DictObjRemoveKeyList(
Tcl_Interp *interp,
Tcl_Obj *dictPtr,
Tcl_Size keyc,
Tcl_Obj *const keyv[])
{
Dict *dict;
if (Tcl_IsShared(dictPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_DictObjRemoveKeyList");
}
|
| ︙ | ︙ |
Changes to generic/tclEncoding.c.
| ︙ | ︙ | |||
494 495 496 497 498 499 500 |
searchPath = Tcl_GetEncodingSearchPath();
Tcl_IncrRefCount(searchPath);
TclListObjLengthM(NULL, searchPath, &numDirs);
map = Tcl_NewDictObj();
Tcl_IncrRefCount(map);
| | | 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 |
searchPath = Tcl_GetEncodingSearchPath();
Tcl_IncrRefCount(searchPath);
TclListObjLengthM(NULL, searchPath, &numDirs);
map = Tcl_NewDictObj();
Tcl_IncrRefCount(map);
for (i = numDirs-1; !TCL_SIZE_ISNEG(i); i--) {
/*
* Iterate backwards through the search path so as we overwrite
* entries found, we favor files earlier on the search path.
*/
Tcl_Size j, numFiles;
Tcl_Obj *directory, *matchFileList;
|
| ︙ | ︙ | |||
1244 1245 1246 1247 1248 1249 1250 |
if (encoding == NULL) {
encoding = systemEncoding;
}
encodingPtr = (Encoding *)encoding;
if (src == NULL) {
srcLen = 0;
| | | 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 |
if (encoding == NULL) {
encoding = systemEncoding;
}
encodingPtr = (Encoding *)encoding;
if (src == NULL) {
srcLen = 0;
} else if (TCL_SIZE_ISNEG(srcLen)) {
srcLen = encodingPtr->lengthProc(src);
}
flags |= TCL_ENCODING_START;
if (encodingPtr->toUtfProc == UtfToUtfProc) {
flags |= ENCODING_INPUT;
}
|
| ︙ | ︙ | |||
1383 1384 1385 1386 1387 1388 1389 |
if (encoding == NULL) {
encoding = systemEncoding;
}
encodingPtr = (Encoding *) encoding;
if (src == NULL) {
srcLen = 0;
| | | 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 |
if (encoding == NULL) {
encoding = systemEncoding;
}
encodingPtr = (Encoding *) encoding;
if (src == NULL) {
srcLen = 0;
} else if (TCL_SIZE_ISNEG(srcLen)) {
srcLen = encodingPtr->lengthProc(src);
}
if (statePtr == NULL) {
flags |= TCL_ENCODING_START | TCL_ENCODING_END;
statePtr = &state;
}
if (srcLen > INT_MAX) {
|
| ︙ | ︙ | |||
1572 1573 1574 1575 1576 1577 1578 |
if (encoding == NULL) {
encoding = systemEncoding;
}
encodingPtr = (Encoding *) encoding;
if (src == NULL) {
srcLen = 0;
| | | 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 |
if (encoding == NULL) {
encoding = systemEncoding;
}
encodingPtr = (Encoding *) encoding;
if (src == NULL) {
srcLen = 0;
} else if (TCL_SIZE_ISNEG(srcLen)) {
srcLen = strlen(src);
}
flags |= TCL_ENCODING_START;
while (1) {
int srcChunkLen, srcChunkRead;
int dstChunkLen, dstChunkWrote, dstChunkChars;
|
| ︙ | ︙ | |||
1712 1713 1714 1715 1716 1717 1718 |
if (encoding == NULL) {
encoding = systemEncoding;
}
encodingPtr = (Encoding *) encoding;
if (src == NULL) {
srcLen = 0;
| | | 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 |
if (encoding == NULL) {
encoding = systemEncoding;
}
encodingPtr = (Encoding *) encoding;
if (src == NULL) {
srcLen = 0;
} else if (TCL_SIZE_ISNEG(srcLen)) {
srcLen = strlen(src);
}
if (statePtr == NULL) {
flags |= TCL_ENCODING_START | TCL_ENCODING_END;
statePtr = &state;
}
if (srcLen > INT_MAX) {
|
| ︙ | ︙ |
Changes to generic/tclEnsemble.c.
| ︙ | ︙ | |||
102 103 104 105 106 107 108 |
/*
* The internal rep for caching ensemble subcommand lookups and spelling
* corrections.
*/
typedef struct {
| | | 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 |
/*
* The internal rep for caching ensemble subcommand lookups and spelling
* corrections.
*/
typedef struct {
Tcl_Size epoch; /* Used to confirm when the data in this
* really structure matches up with the
* ensemble. */
Command *token; /* Reference to the command for which this
* structure is a cache of the resolution. */
Tcl_Obj *fix; /* Corrected spelling, if needed. */
Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand hash
* table. */
|
| ︙ | ︙ | |||
185 186 187 188 189 190 191 |
"subcommand", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch (index) {
case ENS_CREATE: {
const char *name;
| | | 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 |
"subcommand", 0, &index) != TCL_OK) {
return TCL_ERROR;
}
switch (index) {
case ENS_CREATE: {
const char *name;
Tcl_Size len;
int allocatedMapFlag = 0;
/*
* Defaults
*/
Tcl_Obj *subcmdObj = NULL;
Tcl_Obj *mapObj = NULL;
int permitPrefix = 1;
|
| ︙ | ︙ | |||
499 500 501 502 503 504 505 |
Tcl_NewStringObj(ensembleConfigOptions[CONF_UNKNOWN],-1));
Tcl_GetEnsembleUnknownHandler(NULL, token, &tmpObj);
Tcl_ListObjAppendElement(NULL, resultObj,
(tmpObj != NULL) ? tmpObj : Tcl_NewObj());
Tcl_SetObjResult(interp, resultObj);
} else {
| | | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 |
Tcl_NewStringObj(ensembleConfigOptions[CONF_UNKNOWN],-1));
Tcl_GetEnsembleUnknownHandler(NULL, token, &tmpObj);
Tcl_ListObjAppendElement(NULL, resultObj,
(tmpObj != NULL) ? tmpObj : Tcl_NewObj());
Tcl_SetObjResult(interp, resultObj);
} else {
Tcl_Size len;
int allocatedMapFlag = 0;
Tcl_Obj *subcmdObj = NULL, *mapObj = NULL, *paramObj = NULL,
*unknownObj = NULL; /* Defaults, silence gcc 4 warnings */
int permitPrefix, flags = 0; /* silence gcc 4 warning */
Tcl_GetEnsembleSubcommandList(NULL, token, &subcmdObj);
Tcl_GetEnsembleMappingDict(NULL, token, &mapObj);
|
| ︙ | ︙ | |||
799 800 801 802 803 804 805 |
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
if (subcmdList != NULL) {
| | | 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 |
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
if (subcmdList != NULL) {
Tcl_Size length;
if (TclListObjLengthM(interp, subcmdList, &length) != TCL_OK) {
return TCL_ERROR;
}
if (length < 1) {
subcmdList = NULL;
}
|
| ︙ | ︙ | |||
866 867 868 869 870 871 872 |
Tcl_Interp *interp,
Tcl_Command token,
Tcl_Obj *paramList)
{
Command *cmdPtr = (Command *) token;
EnsembleConfig *ensemblePtr;
Tcl_Obj *oldList;
| | | 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 |
Tcl_Interp *interp,
Tcl_Command token,
Tcl_Obj *paramList)
{
Command *cmdPtr = (Command *) token;
EnsembleConfig *ensemblePtr;
Tcl_Obj *oldList;
Tcl_Size length;
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
951 952 953 954 955 956 957 |
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
if (mapDict != NULL) {
| | | 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 |
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
if (mapDict != NULL) {
Tcl_Size size;
int done;
Tcl_DictSearch search;
Tcl_Obj *valuePtr;
if (Tcl_DictObjSize(interp, mapDict, &size) != TCL_OK) {
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1051 1052 1053 1054 1055 1056 1057 |
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
if (unknownList != NULL) {
| | | 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 |
if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", TCL_INDEX_NONE));
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
return TCL_ERROR;
}
if (unknownList != NULL) {
Tcl_Size length;
if (TclListObjLengthM(interp, unknownList, &length) != TCL_OK) {
return TCL_ERROR;
}
if (length < 1) {
unknownList = NULL;
}
|
| ︙ | ︙ | |||
1535 1536 1537 1538 1539 1540 1541 |
const EnsembleImplMap map[]) /* The subcommands to create */
{
Tcl_Command ensemble;
Tcl_Namespace *ns;
Tcl_DString buf, hiddenBuf;
const char **nameParts = NULL;
const char *cmdName = NULL;
| | | 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 |
const EnsembleImplMap map[]) /* The subcommands to create */
{
Tcl_Command ensemble;
Tcl_Namespace *ns;
Tcl_DString buf, hiddenBuf;
const char **nameParts = NULL;
const char *cmdName = NULL;
Tcl_Size i, nameCount = 0;
int ensembleFlags = 0, hiddenLen;
/*
* Construct the path for the ensemble namespace and create it.
*/
Tcl_DStringInit(&buf);
|
| ︙ | ︙ | |||
1714 1715 1716 1717 1718 1719 1720 |
* subcommand. */
Tcl_HashEntry *hPtr; /* Used for efficient lookup of fully
* specified but not yet cached command
* names. */
int reparseCount = 0; /* Number of reparses. */
Tcl_Obj *errorObj; /* Used for building error messages. */
Tcl_Obj *subObj;
| | | | 1714 1715 1716 1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 |
* subcommand. */
Tcl_HashEntry *hPtr; /* Used for efficient lookup of fully
* specified but not yet cached command
* names. */
int reparseCount = 0; /* Number of reparses. */
Tcl_Obj *errorObj; /* Used for building error messages. */
Tcl_Obj *subObj;
int subIdx;
/*
* Must recheck objc since numParameters might have changed. See test
* namespace-53.9.
*/
restartEnsembleParse:
subIdx = 1 + ensemblePtr->numParameters;
if (objc < subIdx + 1) {
/*
* No subcommand argument. Make error message.
*/
Tcl_DString buf; /* Message being built */
Tcl_DStringInit(&buf);
|
| ︙ | ︙ | |||
1817 1818 1819 1820 1821 1822 1823 | * the export table, scan the sorted array for matches. */ const char *subcmdName; /* Name of the subcommand or unique prefix of * it (a non-unique prefix produces an error). */ char *fullName = NULL; /* Full name of the subcommand. */ | | | | 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 |
* the export table, scan the sorted array for matches.
*/
const char *subcmdName; /* Name of the subcommand or unique prefix of
* it (a non-unique prefix produces an error).
*/
char *fullName = NULL; /* Full name of the subcommand. */
Tcl_Size stringLength, i;
Tcl_Size tableLength = ensemblePtr->subcommandTable.numEntries;
Tcl_Obj *fix;
subcmdName = Tcl_GetStringFromObj(subObj, &stringLength);
for (i=0 ; i<tableLength ; i++) {
int cmp = strncmp(subcmdName,
ensemblePtr->subcommandArrayPtr[i],
stringLength);
|
| ︙ | ︙ | |||
1895 1896 1897 1898 1899 1900 1901 |
* but don't do that because cacheing of the command object should help.
*/
{
Tcl_Obj *copyPtr; /* The list of words to dispatch on.
* Will be freed by the dispatch engine. */
Tcl_Obj **copyObjv;
| | | 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 |
* but don't do that because cacheing of the command object should help.
*/
{
Tcl_Obj *copyPtr; /* The list of words to dispatch on.
* Will be freed by the dispatch engine. */
Tcl_Obj **copyObjv;
Tcl_Size copyObjc, prefixObjc;
TclListObjLengthM(NULL, prefixObj, &prefixObjc);
if (objc == 2) {
copyPtr = TclListObjCopy(NULL, prefixObj);
} else {
copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
|
| ︙ | ︙ | |||
1978 1979 1980 1981 1982 1983 1984 |
}
errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
TclGetString(subObj));
if (ensemblePtr->subcommandTable.numEntries == 1) {
Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], TCL_INDEX_NONE);
} else {
| | | 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 |
}
errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
TclGetString(subObj));
if (ensemblePtr->subcommandTable.numEntries == 1) {
Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], TCL_INDEX_NONE);
} else {
Tcl_Size i;
for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], TCL_INDEX_NONE);
Tcl_AppendToObj(errorObj, ", ", 2);
}
Tcl_AppendPrintfToObj(errorObj, "or %s",
ensemblePtr->subcommandArrayPtr[i]);
|
| ︙ | ︙ | |||
2023 2024 2025 2026 2027 2028 2029 |
*
*----------------------------------------------------------------------
*/
int
TclInitRewriteEnsemble(
Tcl_Interp *interp,
| | | | | 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 |
*
*----------------------------------------------------------------------
*/
int
TclInitRewriteEnsemble(
Tcl_Interp *interp,
Tcl_Size numRemoved,
Tcl_Size numInserted,
Tcl_Obj *const *objv)
{
Interp *iPtr = (Interp *) interp;
int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
if (isRootEnsemble) {
iPtr->ensembleRewrite.sourceObjs = objv;
iPtr->ensembleRewrite.numRemovedObjs = numRemoved;
iPtr->ensembleRewrite.numInsertedObjs = numInserted;
} else {
Tcl_Size numIns = iPtr->ensembleRewrite.numInsertedObjs;
if (numIns < numRemoved) {
iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns;
iPtr->ensembleRewrite.numInsertedObjs = numInserted;
} else {
iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved;
}
|
| ︙ | ︙ | |||
2123 2124 2125 2126 2127 2128 2129 |
size_t badIdx,
Tcl_Obj *bad,
Tcl_Obj *fix)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *const *search;
Tcl_Obj **store;
| | | | 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 |
size_t badIdx,
Tcl_Obj *bad,
Tcl_Obj *fix)
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *const *search;
Tcl_Obj **store;
Tcl_Size idx;
Tcl_Size size;
if (iPtr->ensembleRewrite.sourceObjs == NULL) {
iPtr->ensembleRewrite.sourceObjs = objv;
iPtr->ensembleRewrite.numRemovedObjs = 0;
iPtr->ensembleRewrite.numInsertedObjs = 0;
}
|
| ︙ | ︙ | |||
2291 2292 2293 2294 2295 2296 2297 |
EnsembleUnknownCallback(
Tcl_Interp *interp,
EnsembleConfig *ensemblePtr,
int objc,
Tcl_Obj *const objv[],
Tcl_Obj **prefixObjPtr)
{
| | | | | 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309 2310 2311 2312 2313 2314 2315 2316 2317 2318 |
EnsembleUnknownCallback(
Tcl_Interp *interp,
EnsembleConfig *ensemblePtr,
int objc,
Tcl_Obj *const objv[],
Tcl_Obj **prefixObjPtr)
{
Tcl_Size paramc;
int result;
int i, prefixObjc;
Tcl_Obj **paramv, *unknownCmd, *ensObj;
/*
* Create the "unknown" command callback to determine what to do.
*/
unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
TclNewObj(ensObj);
Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
for (i = 1 ; i < objc ; i++) {
Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]);
}
TclListObjGetElementsM(NULL, unknownCmd, ¶mc, ¶mv);
Tcl_IncrRefCount(unknownCmd);
/*
* Call the "unknown" handler. No attempt to NRE-enable this as deep
|
| ︙ | ︙ | |||
2581 2582 2583 2584 2585 2586 2587 |
static void
BuildEnsembleConfig(
EnsembleConfig *ensemblePtr)
{
Tcl_HashSearch search; /* Used for scanning the commands in
* the namespace for this ensemble. */
| | | | 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 |
static void
BuildEnsembleConfig(
EnsembleConfig *ensemblePtr)
{
Tcl_HashSearch search; /* Used for scanning the commands in
* the namespace for this ensemble. */
Tcl_Size i, j;
int isNew;
Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
Tcl_HashEntry *hPtr;
Tcl_Obj *mapDict = ensemblePtr->subcommandDict;
Tcl_Obj *subList = ensemblePtr->subcmdList;
ClearTable(ensemblePtr);
Tcl_InitHashTable(hash, TCL_STRING_KEYS);
if (subList) {
Tcl_Size subc;
Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj;
const char *name;
/*
* There is a list of exactly what subcommands go in the table.
* Determine the target for each.
*/
|
| ︙ | ︙ | |||
2924 2925 2926 2927 2928 2929 2930 |
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
Tcl_Obj *replaced, *replacement;
Tcl_Command ensemble = (Tcl_Command) cmdPtr;
Command *oldCmdPtr = cmdPtr, *newCmdPtr;
int result, flags = 0, depth = 1, invokeAnyway = 0;
int ourResult = TCL_ERROR;
| | | 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 |
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
Tcl_Obj *replaced, *replacement;
Tcl_Command ensemble = (Tcl_Command) cmdPtr;
Command *oldCmdPtr = cmdPtr, *newCmdPtr;
int result, flags = 0, depth = 1, invokeAnyway = 0;
int ourResult = TCL_ERROR;
Tcl_Size i, len, numBytes;
const char *word;
TclNewObj(replaced);
Tcl_IncrRefCount(replaced);
if ((int)parsePtr->numWords <= depth) {
goto failed;
}
|
| ︙ | ︙ | |||
2994 2995 2996 2997 2998 2999 3000 |
* Check to see if there's also a subcommand list; must check to see if
* the subcommand we are calling is in that list if it exists, since that
* list filters the entries in the map.
*/
(void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj);
if (listObj != NULL) {
| | | 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 |
* Check to see if there's also a subcommand list; must check to see if
* the subcommand we are calling is in that list if it exists, since that
* list filters the entries in the map.
*/
(void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj);
if (listObj != NULL) {
Tcl_Size sclen;
const char *str;
Tcl_Obj *matchObj = NULL;
if (TclListObjGetElementsM(NULL, listObj, &len, &elems) != TCL_OK) {
goto failed;
}
for (i=0 ; i<len ; i++) {
|
| ︙ | ︙ | |||
3251 3252 3253 3254 3255 3256 3257 |
return ourResult;
}
int
TclAttemptCompileProc(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
| | | | | | | | | 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 |
return ourResult;
}
int
TclAttemptCompileProc(
Tcl_Interp *interp,
Tcl_Parse *parsePtr,
Tcl_Size depth,
Command *cmdPtr,
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation;
int result;
Tcl_Size i;
Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
Tcl_Size savedStackDepth = envPtr->currStackDepth;
TCL_HASH_TYPE savedCodeNext = envPtr->codeNext - envPtr->codeStart;
Tcl_Size savedAuxDataArrayNext = envPtr->auxDataArrayNext;
Tcl_Size savedExceptArrayNext = envPtr->exceptArrayNext;
#ifdef TCL_COMPILE_DEBUG
Tcl_Size savedExceptDepth = envPtr->exceptDepth;
#endif
if (cmdPtr->compileProc == NULL) {
return TCL_ERROR;
}
/*
|
| ︙ | ︙ | |||
3394 3395 3396 3397 3398 3399 3400 |
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation;
Tcl_Token *tokPtr;
Tcl_Obj *objPtr, **words;
const char *bytes;
int cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;
| | | 3394 3395 3396 3397 3398 3399 3400 3401 3402 3403 3404 3405 3406 3407 3408 |
CompileEnv *envPtr) /* Holds resulting instructions. */
{
DefineLineInformation;
Tcl_Token *tokPtr;
Tcl_Obj *objPtr, **words;
const char *bytes;
int cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;
Tcl_Size i, numWords, length;
/*
* Push the words of the command. Take care; the command words may be
* scripts that have backslashes in them, and [info frame 0] can see the
* difference. Hence the call to TclContinuationsEnterDerived...
*/
|
| ︙ | ︙ |
Changes to generic/tclEnv.c.
| ︙ | ︙ | |||
263 264 265 266 267 268 269 |
* exist, enlarge the array if necessary to make room. If the name exists,
* free its old entry.
*/
Tcl_MutexLock(&envMutex);
index = TclpFindVariable(name, &length);
| | | 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 |
* exist, enlarge the array if necessary to make room. If the name exists,
* free its old entry.
*/
Tcl_MutexLock(&envMutex);
index = TclpFindVariable(name, &length);
if (TCL_SIZE_ISNEG(index)) {
#ifndef USE_PUTENV
/*
* We need to handle the case where the environment may be changed
* outside our control. ourEnvironSize is only valid if the current
* environment is the one we allocated. [Bug 979640]
*/
|
| ︙ | ︙ | |||
347 348 349 350 351 352 353 |
/*
* Watch out for versions of putenv that copy the string (e.g. VC++). In
* this case we need to free the string immediately. Otherwise update the
* string in the cache.
*/
| | | 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 |
/*
* Watch out for versions of putenv that copy the string (e.g. VC++). In
* this case we need to free the string immediately. Otherwise update the
* string in the cache.
*/
if (!TCL_SIZE_ISNEG(index) && (tenviron[index] == (techar *)p)) {
ReplaceString(oldValue, p);
#ifdef HAVE_PUTENV_THAT_COPIES
} else {
/*
* This putenv() copies instead of taking ownership.
*/
|
| ︙ | ︙ | |||
465 466 467 468 469 470 471 |
index = TclpFindVariable(name, &length);
/*
* First make sure that the environment variable exists to avoid doing
* needless work and to avoid recursion on the unset.
*/
| | | 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 |
index = TclpFindVariable(name, &length);
/*
* First make sure that the environment variable exists to avoid doing
* needless work and to avoid recursion on the unset.
*/
if (TCL_SIZE_ISNEG(index)) {
Tcl_MutexUnlock(&envMutex);
return;
}
/*
* Remember the old value so we can free it if Tcl created the string.
*/
|
| ︙ | ︙ | |||
570 571 572 573 574 575 576 |
{
size_t length, index;
const char *result;
Tcl_MutexLock(&envMutex);
index = TclpFindVariable(name, &length);
result = NULL;
| | | 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 |
{
size_t length, index;
const char *result;
Tcl_MutexLock(&envMutex);
index = TclpFindVariable(name, &length);
result = NULL;
if (!TCL_SIZE_ISNEG(index)) {
Tcl_DString envStr;
result = tenviron2utfdstr(tenviron[index], -1, &envStr);
result += length;
if (*result == '=') {
result++;
Tcl_DStringInit(valuePtr);
|
| ︙ | ︙ |
Changes to generic/tclEvent.c.
| ︙ | ︙ | |||
220 221 222 223 224 225 226 |
* that could lead us here.
*/
Tcl_Preserve(assocPtr);
Tcl_Preserve(interp);
while (assocPtr->firstBgPtr != NULL) {
int code;
| | | 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 |
* that could lead us here.
*/
Tcl_Preserve(assocPtr);
Tcl_Preserve(interp);
while (assocPtr->firstBgPtr != NULL) {
int code;
Tcl_Size prefixObjc;
Tcl_Obj **prefixObjv, **tempObjv;
/*
* Note we copy the handler command prefix each pass through, so we do
* support one handler setting another handler.
*/
|
| ︙ | ︙ | |||
2043 2044 2045 2046 2047 2048 2049 |
*----------------------------------------------------------------------
*/
int
Tcl_CreateThread(
Tcl_ThreadId *idPtr, /* Return, the ID of the thread */
Tcl_ThreadCreateProc *proc, /* Main() function of the thread */
| | | | 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 |
*----------------------------------------------------------------------
*/
int
Tcl_CreateThread(
Tcl_ThreadId *idPtr, /* Return, the ID of the thread */
Tcl_ThreadCreateProc *proc, /* Main() function of the thread */
void *clientData, /* The one argument to Main() */
Tcl_Size stackSize, /* Size of stack for the new thread */
int flags) /* Flags controlling behaviour of the new
* thread. */
{
#if TCL_THREADS
ThreadClientData *cdPtr = (ThreadClientData *)Tcl_Alloc(sizeof(ThreadClientData));
int result;
|
| ︙ | ︙ |
Changes to generic/tclExecute.c.
| ︙ | ︙ | |||
1220 1221 1222 1223 1224 1225 1226 |
eePtr->execStackPtr = esPtr;
}
}
void *
TclStackAlloc(
Tcl_Interp *interp,
| | | | 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 |
eePtr->execStackPtr = esPtr;
}
}
void *
TclStackAlloc(
Tcl_Interp *interp,
Tcl_Size numBytes)
{
Interp *iPtr = (Interp *) interp;
Tcl_Size numWords;
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
return (void *) Tcl_Alloc(numBytes);
}
numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
return StackAllocWords(interp, numWords);
}
|
| ︙ | ︙ | |||
4449 4450 4451 4452 4453 4454 4455 |
methodType = "destructor";
} else {
methodType = "method";
}
TRACE_APPEND(("ERROR: \"%.30s\" not on reachable chain\n",
O2S(valuePtr)));
| | | 4449 4450 4451 4452 4453 4454 4455 4456 4457 4458 4459 4460 4461 4462 4463 |
methodType = "destructor";
} else {
methodType = "method";
}
TRACE_APPEND(("ERROR: \"%.30s\" not on reachable chain\n",
O2S(valuePtr)));
for (i = contextPtr->index ; !TCL_SIZE_ISNEG(i) ; i--) {
miPtr = contextPtr->callPtr->chain + i;
if (miPtr->isFilter
|| miPtr->mPtr->declaringClassPtr != classPtr) {
continue;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s implementation by \"%s\" not reachable from here",
|
| ︙ | ︙ | |||
5342 5343 5344 5345 5346 5347 5348 | NEXT_INST_F(9, 0, 0); } /* Decode index operands. */ toIdx = TclIndexDecode(toIdx, slength - 1); fromIdx = TclIndexDecode(fromIdx, slength - 1); | | | 5342 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 |
NEXT_INST_F(9, 0, 0);
}
/* Decode index operands. */
toIdx = TclIndexDecode(toIdx, slength - 1);
fromIdx = TclIndexDecode(fromIdx, slength - 1);
if (TCL_SIZE_ISNEG(toIdx)) {
TclNewObj(objResultPtr);
} else {
objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
}
TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
|
| ︙ | ︙ | |||
5377 5378 5379 5380 5381 5382 5383 | } CACHE_STACK_INFO(); TclDecrRefCount(OBJ_AT_TOS); (void) POP_OBJECT(); TclDecrRefCount(OBJ_AT_TOS); (void) POP_OBJECT(); | | | | 5377 5378 5379 5380 5381 5382 5383 5384 5385 5386 5387 5388 5389 5390 5391 5392 5393 5394 5395 5396 5397 5398 5399 |
}
CACHE_STACK_INFO();
TclDecrRefCount(OBJ_AT_TOS);
(void) POP_OBJECT();
TclDecrRefCount(OBJ_AT_TOS);
(void) POP_OBJECT();
if (TCL_SIZE_ISNEG(toIdx) ||
(fromIdx + 1 > slength + 1) ||
(toIdx + 1 < fromIdx + 1)) {
TRACE_APPEND(("\"%.30s\"\n", O2S(valuePtr)));
TclDecrRefCount(value3Ptr);
NEXT_INST_F(1, 0, 0);
}
if (TCL_SIZE_ISNEG(fromIdx)) {
fromIdx = TCL_INDEX_START;
}
if (toIdx + 1 > slength + 1) {
toIdx = slength;
}
|
| ︙ | ︙ | |||
7382 7383 7384 7385 7386 7387 7388 |
result = TCL_OK;
pc = (codePtr->codeStart + rangePtr->breakOffset);
TRACE_APPEND(("%s, range at %" TCL_Z_MODIFIER "u, new pc %" TCL_Z_MODIFIER "u\n",
StringForResultCode(result),
rangePtr->codeOffset, rangePtr->breakOffset));
NEXT_INST_F(0, 0, 0);
}
| | | 7382 7383 7384 7385 7386 7387 7388 7389 7390 7391 7392 7393 7394 7395 7396 |
result = TCL_OK;
pc = (codePtr->codeStart + rangePtr->breakOffset);
TRACE_APPEND(("%s, range at %" TCL_Z_MODIFIER "u, new pc %" TCL_Z_MODIFIER "u\n",
StringForResultCode(result),
rangePtr->codeOffset, rangePtr->breakOffset));
NEXT_INST_F(0, 0, 0);
}
if (TCL_SIZE_ISNEG(rangePtr->continueOffset)) {
TRACE_APPEND(("%s, loop w/o continue, checking for catch\n",
StringForResultCode(result)));
goto checkForCatch;
}
result = TCL_OK;
pc = (codePtr->codeStart + rangePtr->continueOffset);
TRACE_APPEND(("%s, range at %" TCL_Z_MODIFIER "u, new pc %" TCL_Z_MODIFIER "u\n",
|
| ︙ | ︙ | |||
9296 9297 9298 9299 9300 9301 9302 |
(pcOffset < (start + rangePtr->numCodeBytes))) {
if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
return rangePtr;
}
if (searchMode == TCL_BREAK) {
return rangePtr;
}
| | | 9296 9297 9298 9299 9300 9301 9302 9303 9304 9305 9306 9307 9308 9309 9310 |
(pcOffset < (start + rangePtr->numCodeBytes))) {
if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
return rangePtr;
}
if (searchMode == TCL_BREAK) {
return rangePtr;
}
if (searchMode == TCL_CONTINUE && !TCL_SIZE_ISNEG(rangePtr->continueOffset)){
return rangePtr;
}
}
}
return NULL;
}
|
| ︙ | ︙ | |||
9730 9731 9732 9733 9734 9735 9736 |
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {
if (statsPtr->srcCount[i] > 0) {
minSizeDecade = i;
break;
}
}
| | | 9730 9731 9732 9733 9734 9735 9736 9737 9738 9739 9740 9741 9742 9743 9744 |
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {
if (statsPtr->srcCount[i] > 0) {
minSizeDecade = i;
break;
}
}
for (i = 31; !TCL_SIZE_ISNEG(i); i--) {
if (statsPtr->srcCount[i] > 0) {
break; /* maxSizeDecade to consume 'i' value
* below... */
}
}
maxSizeDecade = i;
sum = 0;
|
| ︙ | ︙ | |||
9754 9755 9756 9757 9758 9759 9760 |
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {
if (statsPtr->byteCodeCount[i] > 0) {
minSizeDecade = i;
break;
}
}
| | | 9754 9755 9756 9757 9758 9759 9760 9761 9762 9763 9764 9765 9766 9767 9768 |
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {
if (statsPtr->byteCodeCount[i] > 0) {
minSizeDecade = i;
break;
}
}
for (i = 31; !TCL_SIZE_ISNEG(i); i--) {
if (statsPtr->byteCodeCount[i] > 0) {
break; /* maxSizeDecade to consume 'i' value
* below... */
}
}
maxSizeDecade = i;
sum = 0;
|
| ︙ | ︙ | |||
9778 9779 9780 9781 9782 9783 9784 |
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {
if (statsPtr->lifetimeCount[i] > 0) {
minSizeDecade = i;
break;
}
}
| | | 9778 9779 9780 9781 9782 9783 9784 9785 9786 9787 9788 9789 9790 9791 9792 |
minSizeDecade = maxSizeDecade = 0;
for (i = 0; i < 31; i++) {
if (statsPtr->lifetimeCount[i] > 0) {
minSizeDecade = i;
break;
}
}
for (i = 31; !TCL_SIZE_ISNEG(i); i--) {
if (statsPtr->lifetimeCount[i] > 0) {
break; /* maxSizeDecade to consume 'i' value
* below... */
}
}
maxSizeDecade = i;
sum = 0;
|
| ︙ | ︙ |
Changes to generic/tclFileName.c.
| ︙ | ︙ | |||
754 755 756 757 758 759 760 |
*
*---------------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_FSJoinToPath(
Tcl_Obj *pathPtr, /* Valid path or NULL. */
| | | 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 |
*
*---------------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_FSJoinToPath(
Tcl_Obj *pathPtr, /* Valid path or NULL. */
Tcl_Size objc, /* Number of array elements to join */
Tcl_Obj *const objv[]) /* Path elements to join. */
{
if (pathPtr == NULL) {
return TclJoinPath(objc, objv, 0);
}
if (objc == 0) {
return TclJoinPath(1, &pathPtr, 0);
|
| ︙ | ︙ | |||
923 924 925 926 927 928 929 | * Modifies the Tcl_DString. * *---------------------------------------------------------------------- */ char * Tcl_JoinPath( | | | | 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 |
* Modifies the Tcl_DString.
*
*----------------------------------------------------------------------
*/
char *
Tcl_JoinPath(
Tcl_Size argc,
const char *const *argv,
Tcl_DString *resultPtr) /* Pointer to previously initialized DString */
{
Tcl_Size i, len;
Tcl_Obj *listObj;
Tcl_Obj *resultObj;
const char *resultStr;
/*
* Build the list of paths.
*/
|
| ︙ | ︙ |
Changes to generic/tclIO.c.
| ︙ | ︙ | |||
6231 6232 6233 6234 6235 6236 6237 |
{
Tcl_Encoding encoding = statePtr->encoding;
Tcl_EncodingState savedState = statePtr->inputEncodingState;
ChannelBuffer *bufPtr = statePtr->inQueueHead;
int savedIEFlags = statePtr->inputEncodingFlags;
int savedFlags = statePtr->flags;
char *dst, *src = RemovePoint(bufPtr);
| | | 6231 6232 6233 6234 6235 6236 6237 6238 6239 6240 6241 6242 6243 6244 6245 |
{
Tcl_Encoding encoding = statePtr->encoding;
Tcl_EncodingState savedState = statePtr->inputEncodingState;
ChannelBuffer *bufPtr = statePtr->inQueueHead;
int savedIEFlags = statePtr->inputEncodingFlags;
int savedFlags = statePtr->flags;
char *dst, *src = RemovePoint(bufPtr);
TCL_HASH_TYPE numBytes;
int srcLen = BytesLeft(bufPtr);
/*
* One src byte can yield at most one character. So when the number of
* src bytes we plan to read is less than the limit on character count to
* be read, clearly we will remain within that limit, and we can use the
* value of "srcLen" as a tighter limit for sizing receiving buffers.
|
| ︙ | ︙ | |||
6255 6256 6257 6258 6259 6260 6261 |
int factor = *factorPtr;
int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
(void) Tcl_GetStringFromObj(objPtr, &numBytes);
Tcl_AppendToObj(objPtr, NULL, dstLimit);
if (toRead == srcLen) {
| | | 6255 6256 6257 6258 6259 6260 6261 6262 6263 6264 6265 6266 6267 6268 6269 |
int factor = *factorPtr;
int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
(void) Tcl_GetStringFromObj(objPtr, &numBytes);
Tcl_AppendToObj(objPtr, NULL, dstLimit);
if (toRead == srcLen) {
TCL_HASH_TYPE size;
dst = TclGetStringStorage(objPtr, &size) + numBytes;
dstLimit = (size - numBytes) > INT_MAX ? INT_MAX : (size - numBytes);
} else {
dst = TclGetString(objPtr) + numBytes;
}
|
| ︙ | ︙ | |||
9749 9750 9751 9752 9753 9754 9755 |
size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
!GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
} else {
size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)
,0 /* No append */);
}
| | | 9749 9750 9751 9752 9753 9754 9755 9756 9757 9758 9759 9760 9761 9762 9763 |
size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
!GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
} else {
size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)
,0 /* No append */);
}
underflow = (size >= 0) && ((Tcl_Size)size < sizeb); /* Input underflow */
}
if (size < 0) {
readError:
if (interp) {
TclNewObj(errObj);
Tcl_AppendStringsToObj(errObj, "error reading \"",
|
| ︙ | ︙ | |||
9828 9829 9830 9831 9832 9833 9834 | * characters, and both EOL translation and encoding * conversion may have changed this number unpredictably in relation * to 'size' (It can be smaller or larger, in the latter case able to * drive toRead below -1, causing infinite looping). Completely * unsuitable for updating totals and toRead. */ | | | 9828 9829 9830 9831 9832 9833 9834 9835 9836 9837 9838 9839 9840 9841 9842 |
* characters, and both EOL translation and encoding
* conversion may have changed this number unpredictably in relation
* to 'size' (It can be smaller or larger, in the latter case able to
* drive toRead below -1, causing infinite looping). Completely
* unsuitable for updating totals and toRead.
*/
if (TCL_SIZE_ISNEG(sizeb)) {
writeError:
if (interp) {
TclNewObj(errObj);
Tcl_AppendStringsToObj(errObj, "error writing \"",
Tcl_GetChannelName(outChan), "\": ", NULL);
if (msg != NULL) {
Tcl_AppendObjToObj(errObj, msg);
|
| ︙ | ︙ | |||
10060 10061 10062 10063 10064 10065 10066 | /* * Don't read more data if we have what we need. */ while (!bufPtr || /* We got no buffer! OR */ (!IsBufferFull(bufPtr) && /* Our buffer has room AND */ | | | 10060 10061 10062 10063 10064 10065 10066 10067 10068 10069 10070 10071 10072 10073 10074 |
/*
* Don't read more data if we have what we need.
*/
while (!bufPtr || /* We got no buffer! OR */
(!IsBufferFull(bufPtr) && /* Our buffer has room AND */
((Tcl_Size)BytesLeft(bufPtr) < bytesToRead))) {
/* Not enough bytes in it yet
* to fill the dst */
int code;
moreData:
code = GetInput(chanPtr);
bufPtr = statePtr->inQueueHead;
|
| ︙ | ︙ |
Changes to generic/tclIOCmd.c.
| ︙ | ︙ | |||
160 161 162 163 164 165 166 |
"channel \"%s\" wasn't opened for writing",
TclGetString(chanObjPtr)));
return TCL_ERROR;
}
TclChannelPreserve(chan);
result = Tcl_WriteObj(chan, string);
| | | | 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 |
"channel \"%s\" wasn't opened for writing",
TclGetString(chanObjPtr)));
return TCL_ERROR;
}
TclChannelPreserve(chan);
result = Tcl_WriteObj(chan, string);
if (TCL_SIZE_ISNEG(result)) {
goto error;
}
if (newline != 0) {
result = Tcl_WriteChars(chan, "\n", 1);
if (TCL_SIZE_ISNEG(result)) {
goto error;
}
}
TclChannelRelease(chan);
return TCL_OK;
/*
|
| ︙ | ︙ |
Changes to generic/tclIOSock.c.
| ︙ | ︙ | |||
113 114 115 116 117 118 119 |
#if !defined(_WIN32) && !defined(__CYGWIN__)
# define SOCKET int
#endif
int
TclSockMinimumBuffers(
void *sock, /* Socket file descriptor */
| | | | 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 |
#if !defined(_WIN32) && !defined(__CYGWIN__)
# define SOCKET int
#endif
int
TclSockMinimumBuffers(
void *sock, /* Socket file descriptor */
Tcl_Size size1) /* Minimum buffer size */
{
int current;
socklen_t len;
int size = size1;
if ((Tcl_Size)size != size1) {
return TCL_ERROR;
}
len = sizeof(int);
getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_SNDBUF,
(char *) ¤t, &len);
if (current < size) {
len = sizeof(int);
|
| ︙ | ︙ |
Changes to generic/tclIndexObj.c.
| ︙ | ︙ | |||
183 184 185 186 187 188 189 |
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr, /* Object containing the string to lookup. */
const void *tablePtr, /* The first string in the table. The second
* string will be at this address plus the
* offset, the third plus the offset again,
* etc. The last entry must be NULL and there
* must not be duplicate entries. */
| | | | 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 |
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
Tcl_Obj *objPtr, /* Object containing the string to lookup. */
const void *tablePtr, /* The first string in the table. The second
* string will be at this address plus the
* offset, the third plus the offset again,
* etc. The last entry must be NULL and there
* must not be duplicate entries. */
Tcl_Size offset, /* The number of bytes between entries */
const char *msg, /* Identifying word to use in error
* messages. */
int flags, /* 0, TCL_EXACT, TCL_NULL_OK or TCL_INDEX_TEMP_TABLE */
void *indexPtr) /* Place to store resulting index. */
{
Tcl_Size index, idx, numAbbrev;
const char *key, *p1;
const char *p2;
const char *const *entryPtr;
Tcl_Obj *resultPtr;
IndexRep *indexRep;
const Tcl_ObjInternalRep *irPtr;
/* Protect against invalid values, like TCL_INDEX_NONE or 0. */
if (offset + 1 <= sizeof(char *)) {
offset = sizeof(char *);
}
/*
* See if there is a valid cached result from a previous lookup.
*/
if (objPtr && !(flags & TCL_INDEX_TEMP_TABLE)) {
|
| ︙ | ︙ | |||
811 812 813 814 815 816 817 818 819 820 821 822 823 824 |
{
Tcl_Obj *objPtr;
Tcl_Size i, len, elemLen;
char flags;
Interp *iPtr = (Interp *)interp;
const char *elementStr;
TclNewObj(objPtr);
if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) {
iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp));
Tcl_AppendToObj(objPtr, " or \"", TCL_INDEX_NONE);
} else {
Tcl_AppendToObj(objPtr, "wrong # args: should be \"", TCL_INDEX_NONE);
| > > > > > > > > > | 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 |
{
Tcl_Obj *objPtr;
Tcl_Size i, len, elemLen;
char flags;
Interp *iPtr = (Interp *)interp;
const char *elementStr;
if (!interp) {
/* We cannot do anything more, just let the caller return TCL_ERROR */
return;
}
if (TCL_SIZE_ISNEG(objc) || (objc < 1)) {
/* Since we don't have objc[0], just print "wrong # args", nothing more */
TclNewStringObj(objPtr, "wrong # args", 12);
goto numargsend;
}
TclNewObj(objPtr);
if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) {
iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp));
Tcl_AppendToObj(objPtr, " or \"", TCL_INDEX_NONE);
} else {
Tcl_AppendToObj(objPtr, "wrong # args: should be \"", TCL_INDEX_NONE);
|
| ︙ | ︙ | |||
950 951 952 953 954 955 956 957 958 959 960 961 962 963 |
* actual error.
*/
if (message != NULL) {
Tcl_AppendStringsToObj(objPtr, message, NULL);
}
Tcl_AppendStringsToObj(objPtr, "\"", NULL);
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
Tcl_SetObjResult(interp, objPtr);
}
/*
*----------------------------------------------------------------------
*
| > | 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 |
* actual error.
*/
if (message != NULL) {
Tcl_AppendStringsToObj(objPtr, message, NULL);
}
Tcl_AppendStringsToObj(objPtr, "\"", NULL);
numargsend:
Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
Tcl_SetObjResult(interp, objPtr);
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ |
Changes to generic/tclInterp.c.
| ︙ | ︙ | |||
1193 1194 1195 1196 1197 1198 1199 |
int
Tcl_CreateAlias(
Tcl_Interp *childInterp, /* Interpreter for source command. */
const char *childCmd, /* Command to install in child. */
Tcl_Interp *targetInterp, /* Interpreter for target command. */
const char *targetCmd, /* Name of target command. */
| | | 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 |
int
Tcl_CreateAlias(
Tcl_Interp *childInterp, /* Interpreter for source command. */
const char *childCmd, /* Command to install in child. */
Tcl_Interp *targetInterp, /* Interpreter for target command. */
const char *targetCmd, /* Name of target command. */
Tcl_Size argc, /* How many additional arguments? */
const char *const *argv) /* These are the additional args. */
{
Tcl_Obj *childObjPtr, *targetObjPtr;
Tcl_Obj **objv;
size_t i;
int result;
|
| ︙ | ︙ | |||
1248 1249 1250 1251 1252 1253 1254 |
int
Tcl_CreateAliasObj(
Tcl_Interp *childInterp, /* Interpreter for source command. */
const char *childCmd, /* Command to install in child. */
Tcl_Interp *targetInterp, /* Interpreter for target command. */
const char *targetCmd, /* Name of target command. */
| | | 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 |
int
Tcl_CreateAliasObj(
Tcl_Interp *childInterp, /* Interpreter for source command. */
const char *childCmd, /* Command to install in child. */
Tcl_Interp *targetInterp, /* Interpreter for target command. */
const char *targetCmd, /* Name of target command. */
Tcl_Size objc, /* How many additional arguments? */
Tcl_Obj *const objv[]) /* Argument vector. */
{
Tcl_Obj *childObjPtr, *targetObjPtr;
int result;
childObjPtr = Tcl_NewStringObj(childCmd, TCL_INDEX_NONE);
Tcl_IncrRefCount(childObjPtr);
|
| ︙ | ︙ | |||
3981 3982 3983 3984 3985 3986 3987 |
*
*----------------------------------------------------------------------
*/
void
Tcl_LimitSetCommands(
Tcl_Interp *interp,
| | | 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 3995 |
*
*----------------------------------------------------------------------
*/
void
Tcl_LimitSetCommands(
Tcl_Interp *interp,
Tcl_Size commandLimit)
{
Interp *iPtr = (Interp *) interp;
iPtr->limit.cmdCount = commandLimit;
iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS;
}
|
| ︙ | ︙ |
Changes to generic/tclLink.c.
| ︙ | ︙ | |||
242 243 244 245 246 247 248 |
const char *varName, /* Name of a global variable in interp. */
void *addr, /* Address of a C variable to be linked to
* varName. If NULL then the necessary space
* will be allocated and returned as the
* interpreter result. */
int type, /* Type of C variable: TCL_LINK_INT, etc. Also
* may have TCL_LINK_READ_ONLY OR'ed in. */
| | | | 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 |
const char *varName, /* Name of a global variable in interp. */
void *addr, /* Address of a C variable to be linked to
* varName. If NULL then the necessary space
* will be allocated and returned as the
* interpreter result. */
int type, /* Type of C variable: TCL_LINK_INT, etc. Also
* may have TCL_LINK_READ_ONLY OR'ed in. */
Tcl_Size size) /* Size of C variable array, >1 if array */
{
Tcl_Obj *objPtr;
Link *linkPtr;
Namespace *dummy;
const char *name;
int code;
if (TCL_SIZE_ISNEG(size) || size < 1) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"wrong array size given", TCL_INDEX_NONE));
return TCL_ERROR;
}
linkPtr = (Link *)Tcl_Alloc(sizeof(Link));
linkPtr->type = type & ~TCL_LINK_READ_ONLY;
|
| ︙ | ︙ |
Changes to generic/tclListObj.c.
| ︙ | ︙ | |||
1656 1657 1658 1659 1660 1661 1662 |
#undef Tcl_ListObjGetElements
int
Tcl_ListObjGetElements(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
Tcl_Obj *objPtr, /* List object for which an element array is
* to be returned. */
| | | 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 |
#undef Tcl_ListObjGetElements
int
Tcl_ListObjGetElements(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
Tcl_Obj *objPtr, /* List object for which an element array is
* to be returned. */
size_t *objcPtr, /* Where to store the count of objects
* referenced by objv. */
Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of
* pointers to the list's objects. */
{
ListRep listRep;
if (TclHasInternalRep(objPtr,&tclArithSeriesType.objType)) {
|
| ︙ | ︙ | |||
1989 1990 1991 1992 1993 1994 1995 |
*/
#undef Tcl_ListObjLength
int
Tcl_ListObjLength(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
Tcl_Obj *listObj, /* List object whose #elements to return. */
| | | 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 |
*/
#undef Tcl_ListObjLength
int
Tcl_ListObjLength(
Tcl_Interp *interp, /* Used to report errors if not NULL. */
Tcl_Obj *listObj, /* List object whose #elements to return. */
size_t *lenPtr) /* The resulting length is stored here. */
{
ListRep listRep;
size_t (*lengthProc)(Tcl_Obj *obj) = ABSTRACTLIST_PROC(listObj, lengthProc);
if (lengthProc) {
*lenPtr = lengthProc(listObj);
return TCL_OK;
|
| ︙ | ︙ |
Changes to generic/tclLiteral.c.
| ︙ | ︙ | |||
175 176 177 178 179 180 181 |
Tcl_Obj *
TclCreateLiteral(
Interp *iPtr,
const char *bytes, /* The start of the string. Note that this is
* not a NUL-terminated string. */
size_t length, /* Number of bytes in the string. */
| | | 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 |
Tcl_Obj *
TclCreateLiteral(
Interp *iPtr,
const char *bytes, /* The start of the string. Note that this is
* not a NUL-terminated string. */
size_t length, /* Number of bytes in the string. */
TCL_HASH_TYPE hash, /* The string's hash. If the value is
* TCL_INDEX_NONE, it will be computed here. */
int *newPtr,
Namespace *nsPtr,
int flags,
LiteralEntry **globalPtrPtr)
{
LiteralTable *globalTablePtr = &iPtr->literalTable;
|
| ︙ | ︙ | |||
225 226 227 228 229 230 231 |
}
if (globalPtrPtr) {
*globalPtrPtr = globalPtr;
}
if (flags & LITERAL_ON_HEAP) {
Tcl_Free((void *)bytes);
}
| | | 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 |
}
if (globalPtrPtr) {
*globalPtrPtr = globalPtr;
}
if (flags & LITERAL_ON_HEAP) {
Tcl_Free((void *)bytes);
}
if (!TCL_SIZE_ISNEG(globalPtr->refCount)) {
globalPtr->refCount++;
}
return objPtr;
}
}
}
if (!newPtr) {
|
| ︙ | ︙ | |||
347 348 349 350 351 352 353 |
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclFetchLiteral(
CompileEnv *envPtr, /* Points to the CompileEnv from which to
* fetch the registered literal value. */
| | | 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 |
*----------------------------------------------------------------------
*/
Tcl_Obj *
TclFetchLiteral(
CompileEnv *envPtr, /* Points to the CompileEnv from which to
* fetch the registered literal value. */
Tcl_Size index) /* Index of the desired literal, as returned
* by prior call to TclRegisterLiteral() */
{
if (index >= envPtr->literalArrayNext) {
return NULL;
}
return envPtr->literalArrayPtr[index].objPtr;
}
|
| ︙ | ︙ | |||
383 384 385 386 387 388 389 | * is set directly from string, otherwise the string is freed. Typically, * a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated * buffer holding the result of backslash substitutions. * *---------------------------------------------------------------------- */ | | | | | | | 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 |
* is set directly from string, otherwise the string is freed. Typically,
* a caller sets LITERAL_ON_HEAP if "string" is an already heap-allocated
* buffer holding the result of backslash substitutions.
*
*----------------------------------------------------------------------
*/
Tcl_Size
TclRegisterLiteral(
void *ePtr, /* Points to the CompileEnv in whose object
* array an object is found or created. */
const char *bytes, /* Points to string for which to find or
* create an object in CompileEnv's object
* array. */
Tcl_Size length, /* Number of bytes in the string. If
* TCL_INDEX_NONE, the string consists of all bytes
* up to the first null character. */
int flags) /* If LITERAL_ON_HEAP then the caller already
* malloc'd bytes and ownership is passed to
* this function. If LITERAL_CMD_NAME then
* the literal should not be shared accross
* namespaces. */
{
CompileEnv *envPtr = (CompileEnv *)ePtr;
Interp *iPtr = envPtr->iPtr;
LiteralTable *localTablePtr = &envPtr->localLitTable;
LiteralEntry *globalPtr, *localPtr;
Tcl_Obj *objPtr;
size_t hash, localHash, objIndex;
int isNew;
Namespace *nsPtr;
if (TCL_SIZE_ISNEG(length)) {
length = (bytes ? strlen(bytes) : 0);
}
hash = HashString(bytes, length);
/*
* Is the literal already in the CompileEnv's local literal array? If so,
* just return its index.
|
| ︙ | ︙ | |||
603 604 605 606 607 608 609 | * Side effects: * Expands the literal array if necessary. Increments the refcount on the * literal object. * *---------------------------------------------------------------------- */ | | | | 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 |
* Side effects:
* Expands the literal array if necessary. Increments the refcount on the
* literal object.
*
*----------------------------------------------------------------------
*/
Tcl_Size
TclAddLiteralObj(
CompileEnv *envPtr,/* Points to CompileEnv in whose literal array
* the object is to be inserted. */
Tcl_Obj *objPtr, /* The object to insert into the array. */
LiteralEntry **litPtrPtr) /* The location where the pointer to the new
* literal entry should be stored. May be
* NULL. */
{
LiteralEntry *lPtr;
Tcl_Size objIndex;
if (envPtr->literalArrayNext >= envPtr->literalArrayEnd) {
ExpandLocalLiteralArray(envPtr);
}
objIndex = envPtr->literalArrayNext;
envPtr->literalArrayNext++;
|
| ︙ | ︙ | |||
847 848 849 850 851 852 853 |
if (entryPtr->objPtr == objPtr) {
/*
* If the literal is no longer being used by any ByteCode, delete
* the entry then remove the reference corresponding to the global
* literal table entry (decrement the ref count of the object).
*/
| | | 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 |
if (entryPtr->objPtr == objPtr) {
/*
* If the literal is no longer being used by any ByteCode, delete
* the entry then remove the reference corresponding to the global
* literal table entry (decrement the ref count of the object).
*/
if (!TCL_SIZE_ISNEG((entryPtr->refCount)) && (entryPtr->refCount-- <= 1)) {
if (prevPtr == NULL) {
globalTablePtr->buckets[index] = entryPtr->nextPtr;
} else {
prevPtr->nextPtr = entryPtr->nextPtr;
}
Tcl_Free(entryPtr);
globalTablePtr->numEntries--;
|
| ︙ | ︙ | |||
1171 1172 1173 1174 1175 1176 1177 |
char *bytes;
size_t i, length, count = 0;
for (i=0 ; i<localTablePtr->numBuckets ; i++) {
for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
localPtr=localPtr->nextPtr) {
count++;
| | | 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 |
char *bytes;
size_t i, length, count = 0;
for (i=0 ; i<localTablePtr->numBuckets ; i++) {
for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
localPtr=localPtr->nextPtr) {
count++;
if (!TCL_SIZE_ISNEG(localPtr->refCount)) {
bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u",
"TclVerifyLocalLiteralTable",
(length>60? 60 : (int) length), bytes, localPtr->refCount);
}
if (localPtr->objPtr->bytes == NULL) {
Tcl_Panic("%s: literal has NULL string rep",
|
| ︙ | ︙ |
Changes to generic/tclMain.c.
| ︙ | ︙ | |||
276 277 278 279 280 281 282 | * interpreted. * *---------------------------------------------------------------------- */ TCL_NORETURN void Tcl_MainEx( | | | | 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 |
* interpreted.
*
*----------------------------------------------------------------------
*/
TCL_NORETURN void
Tcl_MainEx(
Tcl_Size argc, /* Number of arguments. */
TCHAR **argv, /* Array of argument strings. */
Tcl_AppInitProc *appInitProc,
/* Application-specific initialization
* function to call after most initialization
* but before starting to execute commands. */
Tcl_Interp *interp)
{
Tcl_Size i=0; /* argv[i] index */
Tcl_Obj *path, *resultPtr, *argvPtr, *appName;
const char *encodingName = NULL;
int code, exitCode = 0;
Tcl_MainLoopProc *mainLoopProc;
Tcl_Channel chan;
InteractiveState is;
|
| ︙ | ︙ | |||
450 451 452 453 454 455 456 |
*/
Tcl_LinkVar(interp, "tcl_interactive", &is.tty, TCL_LINK_BOOLEAN);
is.input = Tcl_GetStdChannel(TCL_STDIN);
while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) {
mainLoopProc = TclGetMainLoop();
if (mainLoopProc == NULL) {
| | | | 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 |
*/
Tcl_LinkVar(interp, "tcl_interactive", &is.tty, TCL_LINK_BOOLEAN);
is.input = Tcl_GetStdChannel(TCL_STDIN);
while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) {
mainLoopProc = TclGetMainLoop();
if (mainLoopProc == NULL) {
Tcl_Size length;
if (is.tty) {
Prompt(interp, &is);
if (Tcl_InterpDeleted(interp)) {
break;
}
if (Tcl_LimitExceeded(interp)) {
break;
}
is.input = Tcl_GetStdChannel(TCL_STDIN);
if (is.input == NULL) {
break;
}
}
if (Tcl_IsShared(is.commandPtr)) {
Tcl_DecrRefCount(is.commandPtr);
is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
Tcl_IncrRefCount(is.commandPtr);
}
length = Tcl_GetsObj(is.input, is.commandPtr);
if (TCL_SIZE_ISNEG(length)) {
if (Tcl_InputBlocked(is.input)) {
/*
* This can only happen if stdin has been set to
* non-blocking. In that case cycle back and try again.
* This sets up a tight polling loop (since we have no
* event loop running). If this causes bad CPU hogging, we
* might try toggling the blocking on stdin instead.
|
| ︙ | ︙ | |||
736 737 738 739 740 741 742 |
static void
StdinProc(
void *clientData, /* The state of interactive cmd line */
TCL_UNUSED(int) /*mask*/)
{
int code;
| | | | 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 |
static void
StdinProc(
void *clientData, /* The state of interactive cmd line */
TCL_UNUSED(int) /*mask*/)
{
int code;
Tcl_Size length;
InteractiveState *isPtr = (InteractiveState *)clientData;
Tcl_Channel chan = isPtr->input;
Tcl_Obj *commandPtr = isPtr->commandPtr;
Tcl_Interp *interp = isPtr->interp;
if (Tcl_IsShared(commandPtr)) {
Tcl_DecrRefCount(commandPtr);
commandPtr = Tcl_DuplicateObj(commandPtr);
Tcl_IncrRefCount(commandPtr);
}
length = Tcl_GetsObj(chan, commandPtr);
if (TCL_SIZE_ISNEG(length)) {
if (Tcl_InputBlocked(chan)) {
return;
}
if (isPtr->tty) {
/*
* Would be better to find a way to exit the mainLoop? Or perhaps
* evaluate [exit]? Leaving as is for now due to compatibility
|
| ︙ | ︙ |
Changes to generic/tclNamesp.c.
| ︙ | ︙ | |||
1181 1182 1183 1184 1185 1186 1187 |
TclTeardownNamespace(
Namespace *nsPtr) /* Points to the namespace to be dismantled
* and unlinked from its parent. */
{
Interp *iPtr = (Interp *) nsPtr->interp;
Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
| | | | 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 |
TclTeardownNamespace(
Namespace *nsPtr) /* Points to the namespace to be dismantled
* and unlinked from its parent. */
{
Interp *iPtr = (Interp *) nsPtr->interp;
Tcl_HashEntry *entryPtr;
Tcl_HashSearch search;
Tcl_Size i;
/*
* Start by destroying the namespace's variable table, since variables
* might trigger traces. Variable table should be cleared but not freed!
* TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
*/
TclDeleteNamespaceVars(nsPtr);
TclInitVarHashTable(&nsPtr->varTable, nsPtr);
/*
* Delete all commands in this namespace. Be careful when traversing the
* hash table: when each command is deleted, it removes itself from the
* command table. Because of traces (and the desire to avoid the quadratic
* problems of just using Tcl_FirstHashEntry over and over, [Bug
* f97d4ee020]) we copy to a temporary array and then delete all those
* commands.
*/
while (nsPtr->cmdTable.numEntries > 0) {
Tcl_Size length = nsPtr->cmdTable.numEntries;
Command **cmds = (Command **)TclStackAlloc((Tcl_Interp *) iPtr,
sizeof(Command *) * length);
i = 0;
for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
entryPtr != NULL;
entryPtr = Tcl_NextHashEntry(&search)) {
|
| ︙ | ︙ | |||
1392 1393 1394 1395 1396 1397 1398 |
* list before appending. */
{
#define INIT_EXPORT_PATTERNS 5
Namespace *nsPtr, *exportNsPtr, *dummyPtr;
Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
const char *simplePattern;
char *patternCpy;
| | | 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 |
* list before appending. */
{
#define INIT_EXPORT_PATTERNS 5
Namespace *nsPtr, *exportNsPtr, *dummyPtr;
Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
const char *simplePattern;
char *patternCpy;
Tcl_Size neededElems, len, i;
/*
* If the specified namespace is NULL, use the current namespace.
*/
if (namespacePtr == NULL) {
nsPtr = (Namespace *) currNsPtr;
|
| ︙ | ︙ | |||
1519 1520 1521 1522 1523 1524 1525 |
Tcl_Namespace *namespacePtr,/* Points to the namespace whose export
* pattern list is appended onto objPtr. NULL
* for the current namespace. */
Tcl_Obj *objPtr) /* Points to the Tcl object onto which the
* export pattern list is appended. */
{
Namespace *nsPtr;
| | | 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 |
Tcl_Namespace *namespacePtr,/* Points to the namespace whose export
* pattern list is appended onto objPtr. NULL
* for the current namespace. */
Tcl_Obj *objPtr) /* Points to the Tcl object onto which the
* export pattern list is appended. */
{
Namespace *nsPtr;
Tcl_Size i;
int result;
/*
* If the specified namespace is NULL, use the current namespace.
*/
if (namespacePtr == NULL) {
|
| ︙ | ︙ | |||
1722 1723 1724 1725 1726 1727 1728 |
Namespace *nsPtr,
Tcl_HashEntry *hPtr,
const char *cmdName,
const char *pattern,
Namespace *importNsPtr,
int allowOverwrite)
{
| | | 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 |
Namespace *nsPtr,
Tcl_HashEntry *hPtr,
const char *cmdName,
const char *pattern,
Namespace *importNsPtr,
int allowOverwrite)
{
Tcl_Size i = 0, exported = 0;
Tcl_HashEntry *found;
/*
* The command cmdName in the source namespace matches the pattern. Check
* whether it was exported. If it wasn't, we ignore it.
*/
|
| ︙ | ︙ | |||
2634 2635 2636 2637 2638 2639 2640 |
/*
* Find the namespace(s) that contain the command.
*/
cmdPtr = NULL;
if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2)
&& !(flags & TCL_NAMESPACE_ONLY)) {
| | | 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 |
/*
* Find the namespace(s) that contain the command.
*/
cmdPtr = NULL;
if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2)
&& !(flags & TCL_NAMESPACE_ONLY)) {
Tcl_Size i;
Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr;
(void) TclGetNamespaceForQualName(interp, name, cxtNsPtr,
TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
&simpleName);
if ((realNsPtr != NULL) && (simpleName != NULL)) {
if ((cxtNsPtr == realNsPtr)
|
| ︙ | ︙ | |||
4035 4036 4037 4038 4039 4040 4041 |
NamespacePathCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
| | | 4035 4036 4037 4038 4039 4040 4041 4042 4043 4044 4045 4046 4047 4048 4049 |
NamespacePathCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
Tcl_Size nsObjc, i;
int result = TCL_ERROR;
Tcl_Obj **nsObjv;
Tcl_Namespace **namespaceList = NULL;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "?pathList?");
return TCL_ERROR;
|
| ︙ | ︙ | |||
4119 4120 4121 4122 4123 4124 4125 |
*
*----------------------------------------------------------------------
*/
void
TclSetNsPath(
Namespace *nsPtr, /* Namespace whose path is to be set. */
| | | | 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 |
*
*----------------------------------------------------------------------
*/
void
TclSetNsPath(
Namespace *nsPtr, /* Namespace whose path is to be set. */
Tcl_Size pathLength, /* Length of pathAry. */
Tcl_Namespace *pathAry[]) /* Array of namespaces that are the path. */
{
if (pathLength != 0) {
NamespacePathEntry *tmpPathArray =
(NamespacePathEntry *)Tcl_Alloc(sizeof(NamespacePathEntry) * pathLength);
Tcl_Size i;
for (i=0 ; i<pathLength ; i++) {
tmpPathArray[i].nsPtr = (Namespace *) pathAry[i];
tmpPathArray[i].creatorNsPtr = nsPtr;
tmpPathArray[i].prevPtr = NULL;
tmpPathArray[i].nextPtr =
tmpPathArray[i].nsPtr->commandPathSourceList;
|
| ︙ | ︙ | |||
4176 4177 4178 4179 4180 4181 4182 |
*----------------------------------------------------------------------
*/
static void
UnlinkNsPath(
Namespace *nsPtr)
{
| | | 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 |
*----------------------------------------------------------------------
*/
static void
UnlinkNsPath(
Namespace *nsPtr)
{
Tcl_Size i;
for (i=0 ; i<nsPtr->commandPathLength ; i++) {
NamespacePathEntry *nsPathPtr = &nsPtr->commandPathArray[i];
if (nsPathPtr->prevPtr != NULL) {
nsPathPtr->prevPtr->nextPtr = nsPathPtr->nextPtr;
}
if (nsPathPtr->nextPtr != NULL) {
|
| ︙ | ︙ | |||
4427 4428 4429 4430 4431 4432 4433 |
int
Tcl_SetNamespaceUnknownHandler(
Tcl_Interp *interp, /* Interpreter in which the namespace
* exists. */
Tcl_Namespace *nsPtr, /* Namespace which is being updated. */
Tcl_Obj *handlerPtr) /* The new handler, or NULL to reset. */
{
| | | 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 |
int
Tcl_SetNamespaceUnknownHandler(
Tcl_Interp *interp, /* Interpreter in which the namespace
* exists. */
Tcl_Namespace *nsPtr, /* Namespace which is being updated. */
Tcl_Obj *handlerPtr) /* The new handler, or NULL to reset. */
{
Tcl_Size lstlen = 0;
Namespace *currNsPtr = (Namespace *) nsPtr;
/*
* Ensure that we check for errors *first* before we change anything.
*/
if (handlerPtr != NULL) {
|
| ︙ | ︙ | |||
4923 4924 4925 4926 4927 4928 4929 |
void
TclLogCommandInfo(
Tcl_Interp *interp, /* Interpreter in which to log information. */
const char *script, /* First character in script containing
* command (must be <= command). */
const char *command, /* First character in command that generated
* the error. */
| | | 4923 4924 4925 4926 4927 4928 4929 4930 4931 4932 4933 4934 4935 4936 4937 |
void
TclLogCommandInfo(
Tcl_Interp *interp, /* Interpreter in which to log information. */
const char *script, /* First character in script containing
* command (must be <= command). */
const char *command, /* First character in command that generated
* the error. */
Tcl_Size length, /* Number of bytes in command (TCL_INDEX_NONE
* means use all bytes up to first null byte).
*/
const unsigned char *pc, /* Current pc of bytecode execution context */
Tcl_Obj **tosPtr) /* Current stack of bytecode execution
* context */
{
const char *p;
|
| ︙ | ︙ | |||
4956 4957 4958 4959 4960 4961 4962 |
iPtr->errorLine = 1;
for (p = script; p != command; p++) {
if (*p == '\n') {
iPtr->errorLine++;
}
}
| | | | 4956 4957 4958 4959 4960 4961 4962 4963 4964 4965 4966 4967 4968 4969 4970 4971 4972 4973 |
iPtr->errorLine = 1;
for (p = script; p != command; p++) {
if (*p == '\n') {
iPtr->errorLine++;
}
}
if (TCL_SIZE_ISNEG(length)) {
length = strlen(command);
}
overflow = (length > (Tcl_Size)limit);
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL)
? "while executing" : "invoked from within"),
(overflow ? limit : (int)length), command,
(overflow ? "..." : "")));
varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,
|
| ︙ | ︙ | |||
5009 5010 5011 5012 5013 5014 5015 |
newObj = Tcl_DuplicateObj(iPtr->errorStack);
Tcl_DecrRefCount(iPtr->errorStack);
Tcl_IncrRefCount(newObj);
iPtr->errorStack = newObj;
}
if (iPtr->resetErrorStack) {
| | | 5009 5010 5011 5012 5013 5014 5015 5016 5017 5018 5019 5020 5021 5022 5023 |
newObj = Tcl_DuplicateObj(iPtr->errorStack);
Tcl_DecrRefCount(iPtr->errorStack);
Tcl_IncrRefCount(newObj);
iPtr->errorStack = newObj;
}
if (iPtr->resetErrorStack) {
Tcl_Size len;
iPtr->resetErrorStack = 0;
TclListObjLengthM(interp, iPtr->errorStack, &len);
/*
* Reset while keeping the list internalrep as much as possible.
*/
|
| ︙ | ︙ | |||
5081 5082 5083 5084 5085 5086 5087 |
*----------------------------------------------------------------------
*/
void
TclErrorStackResetIf(
Tcl_Interp *interp,
const char *msg,
| | | | 5081 5082 5083 5084 5085 5086 5087 5088 5089 5090 5091 5092 5093 5094 5095 5096 5097 5098 5099 5100 5101 5102 5103 5104 5105 5106 5107 5108 |
*----------------------------------------------------------------------
*/
void
TclErrorStackResetIf(
Tcl_Interp *interp,
const char *msg,
Tcl_Size length)
{
Interp *iPtr = (Interp *) interp;
if (Tcl_IsShared(iPtr->errorStack)) {
Tcl_Obj *newObj;
newObj = Tcl_DuplicateObj(iPtr->errorStack);
Tcl_DecrRefCount(iPtr->errorStack);
Tcl_IncrRefCount(newObj);
iPtr->errorStack = newObj;
}
if (iPtr->resetErrorStack) {
Tcl_Size len;
iPtr->resetErrorStack = 0;
TclListObjLengthM(interp, iPtr->errorStack, &len);
/*
* Reset while keeping the list internalrep as much as possible.
*/
|
| ︙ | ︙ | |||
5136 5137 5138 5139 5140 5141 5142 |
void
Tcl_LogCommandInfo(
Tcl_Interp *interp, /* Interpreter in which to log information. */
const char *script, /* First character in script containing
* command (must be <= command). */
const char *command, /* First character in command that generated
* the error. */
| | | 5136 5137 5138 5139 5140 5141 5142 5143 5144 5145 5146 5147 5148 5149 5150 |
void
Tcl_LogCommandInfo(
Tcl_Interp *interp, /* Interpreter in which to log information. */
const char *script, /* First character in script containing
* command (must be <= command). */
const char *command, /* First character in command that generated
* the error. */
Tcl_Size length) /* Number of bytes in command (-1 means use
* all bytes up to first null byte). */
{
TclLogCommandInfo(interp, script, command, length, NULL, NULL);
}
/*
|
| ︙ | ︙ |
Changes to generic/tclOO.c.
| ︙ | ︙ | |||
1683 1684 1685 1686 1687 1688 1689 |
}
/*
* Run constructors, except when objc < 0, which is a special flag case
* used for object cloning only.
*/
| | | 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 |
}
/*
* Run constructors, except when objc < 0, which is a special flag case
* used for object cloning only.
*/
if (!TCL_SIZE_ISNEG(objc)) {
CallContext *contextPtr =
TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);
if (contextPtr != NULL) {
int isRoot, result;
Tcl_InterpState state;
|
| ︙ | ︙ | |||
1754 1755 1756 1757 1758 1759 1760 |
}
/*
* Run constructors, except when objc == TCL_INDEX_NONE (a special flag case used for
* object cloning only). If there aren't any constructors, we do nothing.
*/
| | | 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 |
}
/*
* Run constructors, except when objc == TCL_INDEX_NONE (a special flag case used for
* object cloning only). If there aren't any constructors, we do nothing.
*/
if (TCL_SIZE_ISNEG(objc)) {
*objectPtr = (Tcl_Object) oPtr;
return TCL_OK;
}
contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);
if (contextPtr == NULL) {
*objectPtr = (Tcl_Object) oPtr;
return TCL_OK;
|
| ︙ | ︙ | |||
2623 2624 2625 2626 2627 2628 2629 |
* ----------------------------------------------------------------------
*/
int
TclOOObjectCmdCore(
Object *oPtr, /* The object being invoked. */
Tcl_Interp *interp, /* The interpreter containing the object. */
| | | 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 |
* ----------------------------------------------------------------------
*/
int
TclOOObjectCmdCore(
Object *oPtr, /* The object being invoked. */
Tcl_Interp *interp, /* The interpreter containing the object. */
Tcl_Size objc, /* How many arguments are being passed in. */
Tcl_Obj *const *objv, /* The array of arguments. */
int flags, /* Whether this is an invocation through the
* public or the private command interface. */
Class *startCls) /* Where to start in the call chain, or NULL
* if we are to start at the front with
* filters and the object's methods (which is
* the normal case). */
|
| ︙ | ︙ |
Changes to generic/tclOOBasic.c.
| ︙ | ︙ | |||
984 985 986 987 988 989 990 |
methodType = "constructor";
} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
methodType = "destructor";
} else {
methodType = "method";
}
| | | 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 |
methodType = "constructor";
} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
methodType = "destructor";
} else {
methodType = "method";
}
for (i=contextPtr->index ; !TCL_SIZE_ISNEG(i) ; i--) {
struct MInvoke *miPtr = contextPtr->callPtr->chain + i;
if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s implementation by \"%s\" not reachable from here",
methodType, TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
|
| ︙ | ︙ |
Changes to generic/tclOOMethod.c.
| ︙ | ︙ | |||
494 495 496 497 498 499 500 |
pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
pmPtr->flags = flags & USE_DECLARER_NS;
pmPtr->refCount = 1;
method = TclOOMakeProcMethod(interp, clsPtr, flags, nameObj, procName,
argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
| | | 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 |
pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
pmPtr->flags = flags & USE_DECLARER_NS;
pmPtr->refCount = 1;
method = TclOOMakeProcMethod(interp, clsPtr, flags, nameObj, procName,
argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
if (TCL_SIZE_ISNEG(argsLen)) {
Tcl_DecrRefCount(argsObj);
}
if (method == NULL) {
Tcl_Free(pmPtr);
} else if (pmPtrPtr != NULL) {
*pmPtrPtr = pmPtr;
}
|
| ︙ | ︙ | |||
1184 1185 1186 1187 1188 1189 1190 |
Tcl_Free(infoPtr);
}
static int
ProcedureMethodCompiledVarResolver(
TCL_UNUSED(Tcl_Interp *),
const char *varName,
| | | 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 |
Tcl_Free(infoPtr);
}
static int
ProcedureMethodCompiledVarResolver(
TCL_UNUSED(Tcl_Interp *),
const char *varName,
Tcl_Size length,
TCL_UNUSED(Tcl_Namespace *),
Tcl_ResolvedVarInfo **rPtrPtr)
{
OOResVarInfo *infoPtr;
Tcl_Obj *variableObj = Tcl_NewStringObj(varName, length);
/*
|
| ︙ | ︙ |
Changes to generic/tclObj.c.
| ︙ | ︙ | |||
1508 1509 1510 1511 1512 1513 1514 |
*----------------------------------------------------------------------
*/
int
TclObjBeingDeleted(
Tcl_Obj *objPtr)
{
| | | 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 |
*----------------------------------------------------------------------
*/
int
TclObjBeingDeleted(
Tcl_Obj *objPtr)
{
return (TCL_SIZE_ISNEG(objPtr->length));
}
/*
*----------------------------------------------------------------------
*
* Tcl_DuplicateObj --
*
|
| ︙ | ︙ | |||
1628 1629 1630 1631 1632 1633 1634 |
* updateStringProc must be written in such a way that
* (objPtr->bytes) never becomes NULL.
*/
Tcl_Panic("UpdateStringProc should not be invoked for type %s",
objPtr->typePtr->name);
}
objPtr->typePtr->updateStringProc(objPtr);
| | | 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 |
* updateStringProc must be written in such a way that
* (objPtr->bytes) never becomes NULL.
*/
Tcl_Panic("UpdateStringProc should not be invoked for type %s",
objPtr->typePtr->name);
}
objPtr->typePtr->updateStringProc(objPtr);
if (objPtr->bytes == NULL || TCL_SIZE_ISNEG(objPtr->length)
|| objPtr->bytes[objPtr->length] != '\0') {
Tcl_Panic("UpdateStringProc for type '%s' "
"failed to create a valid string rep",
objPtr->typePtr->name);
}
}
return objPtr->bytes;
|
| ︙ | ︙ | |||
1688 1689 1690 1691 1692 1693 1694 |
* updateStringProc must be written in such a way that
* (objPtr->bytes) never becomes NULL.
*/
Tcl_Panic("UpdateStringProc should not be invoked for type %s",
objPtr->typePtr->name);
}
objPtr->typePtr->updateStringProc(objPtr);
| | | 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 |
* updateStringProc must be written in such a way that
* (objPtr->bytes) never becomes NULL.
*/
Tcl_Panic("UpdateStringProc should not be invoked for type %s",
objPtr->typePtr->name);
}
objPtr->typePtr->updateStringProc(objPtr);
if (objPtr->bytes == NULL || TCL_SIZE_ISNEG(objPtr->length)
|| objPtr->bytes[objPtr->length] != '\0') {
Tcl_Panic("UpdateStringProc for type '%s' "
"failed to create a valid string rep",
objPtr->typePtr->name);
}
}
if (lengthPtr != NULL) {
|
| ︙ | ︙ | |||
1794 1795 1796 1797 1798 1799 1800 |
*----------------------------------------------------------------------
*/
char *
Tcl_InitStringRep(
Tcl_Obj *objPtr, /* Object whose string rep is to be set */
const char *bytes,
| | | 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 |
*----------------------------------------------------------------------
*/
char *
Tcl_InitStringRep(
Tcl_Obj *objPtr, /* Object whose string rep is to be set */
const char *bytes,
TCL_HASH_TYPE numBytes)
{
assert(objPtr->bytes == NULL || bytes == NULL);
if (objPtr->bytes == NULL) {
/* Start with no string rep */
if (numBytes == 0) {
TclInitStringRep(objPtr, NULL, 0);
|
| ︙ | ︙ | |||
4115 4116 4117 4118 4119 4120 4121 |
TCL_HASH_TYPE
TclHashObjKey(
TCL_UNUSED(Tcl_HashTable *),
void *keyPtr) /* Key from which to compute hash value. */
{
Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
| | | 4115 4116 4117 4118 4119 4120 4121 4122 4123 4124 4125 4126 4127 4128 4129 |
TCL_HASH_TYPE
TclHashObjKey(
TCL_UNUSED(Tcl_HashTable *),
void *keyPtr) /* Key from which to compute hash value. */
{
Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
Tcl_Size length;
const char *string = Tcl_GetStringFromObj(objPtr, &length);
TCL_HASH_TYPE result = 0;
/*
* I tried a zillion different hash functions and asked many other people
* for advice. Many people had their own favorite functions, all
* different, but no-one had much idea why they were good ones. I chose
|
| ︙ | ︙ |
Changes to generic/tclOptimize.c.
| ︙ | ︙ | |||
130 131 132 133 134 135 136 |
if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
targetInstPtr = envPtr->codeStart + rangePtr->catchOffset;
DefineTargetAddress(tablePtr, targetInstPtr);
} else {
targetInstPtr = envPtr->codeStart + rangePtr->breakOffset;
DefineTargetAddress(tablePtr, targetInstPtr);
| | | 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 |
if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
targetInstPtr = envPtr->codeStart + rangePtr->catchOffset;
DefineTargetAddress(tablePtr, targetInstPtr);
} else {
targetInstPtr = envPtr->codeStart + rangePtr->breakOffset;
DefineTargetAddress(tablePtr, targetInstPtr);
if (!TCL_SIZE_ISNEG(rangePtr->continueOffset)) {
targetInstPtr = envPtr->codeStart + rangePtr->continueOffset;
DefineTargetAddress(tablePtr, targetInstPtr);
}
}
}
}
|
| ︙ | ︙ |
Changes to generic/tclParse.c.
| ︙ | ︙ | |||
194 195 196 197 198 199 200 |
int
Tcl_ParseCommand(
Tcl_Interp *interp, /* Interpreter to use for error reporting; if
* NULL, then no error message is provided. */
const char *start, /* First character of string containing one or
* more Tcl commands. */
| | | 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 |
int
Tcl_ParseCommand(
Tcl_Interp *interp, /* Interpreter to use for error reporting; if
* NULL, then no error message is provided. */
const char *start, /* First character of string containing one or
* more Tcl commands. */
Tcl_Size numBytes, /* Total number of bytes in string. If TCL_INDEX_NONE,
* the script consists of all bytes up to the
* first null character. */
int nested, /* Non-zero means this is a nested command:
* close bracket should be considered a
* command terminator. If zero, then close
* bracket has no special meaning. */
Tcl_Parse *parsePtr)
|
| ︙ | ︙ | |||
217 218 219 220 221 222 223 |
int wordIndex; /* Index of word token for current word. */
int terminators; /* CHAR_TYPE bits that indicate the end of a
* command. */
const char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to
* point to char after terminating one. */
size_t scanned;
| | | 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 |
int wordIndex; /* Index of word token for current word. */
int terminators; /* CHAR_TYPE bits that indicate the end of a
* command. */
const char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to
* point to char after terminating one. */
size_t scanned;
if (TCL_SIZE_ISNEG(numBytes) && start) {
numBytes = strlen(start);
}
TclParseInit(interp, start, numBytes, parsePtr);
if ((start == NULL) && (numBytes != 0)) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"can't parse a NULL pointer", TCL_INDEX_NONE));
|
| ︙ | ︙ | |||
1331 1332 1333 1334 1335 1336 1337 |
int
Tcl_ParseVarName(
Tcl_Interp *interp, /* Interpreter to use for error reporting; if
* NULL, then no error message is provided. */
const char *start, /* Start of variable substitution string.
* First character must be "$". */
| | | | 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 |
int
Tcl_ParseVarName(
Tcl_Interp *interp, /* Interpreter to use for error reporting; if
* NULL, then no error message is provided. */
const char *start, /* Start of variable substitution string.
* First character must be "$". */
Tcl_Size numBytes, /* Total number of bytes in string. If TCL_INDEX_NONE,
* the string consists of all bytes up to the
* first null character. */
Tcl_Parse *parsePtr, /* Structure to fill in with information about
* the variable name. */
int append) /* Non-zero means append tokens to existing
* information in parsePtr; zero means ignore
* existing tokens in parsePtr and
* reinitialize it. */
{
Tcl_Token *tokenPtr;
const char *src;
int varIndex;
unsigned array;
if (TCL_SIZE_ISNEG(numBytes) && start) {
numBytes = strlen(start);
}
if (!append) {
TclParseInit(interp, start, numBytes, parsePtr);
}
if ((numBytes == 0) || (start == NULL)) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
1629 1630 1631 1632 1633 1634 1635 |
int
Tcl_ParseBraces(
Tcl_Interp *interp, /* Interpreter to use for error reporting; if
* NULL, then no error message is provided. */
const char *start, /* Start of string enclosed in braces. The
* first character must be {'. */
| | | | | 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 |
int
Tcl_ParseBraces(
Tcl_Interp *interp, /* Interpreter to use for error reporting; if
* NULL, then no error message is provided. */
const char *start, /* Start of string enclosed in braces. The
* first character must be {'. */
Tcl_Size numBytes, /* Total number of bytes in string. If TCL_INDEX_NONE,
* the string consists of all bytes up to the
* first null character. */
Tcl_Parse *parsePtr,
/* Structure to fill in with information about
* the string. */
int append, /* Non-zero means append tokens to existing
* information in parsePtr; zero means ignore
* existing tokens in parsePtr and
* reinitialize it. */
const char **termPtr) /* If non-NULL, points to word in which to
* store a pointer to the character just after
* the terminating '}' if the parse was
* successful. */
{
Tcl_Token *tokenPtr;
const char *src;
int startIndex, level;
Tcl_Size length;
if (TCL_SIZE_ISNEG(numBytes) && start) {
numBytes = strlen(start);
}
if (!append) {
TclParseInit(interp, start, numBytes, parsePtr);
}
if ((numBytes == 0) || (start == NULL)) {
return TCL_ERROR;
|
| ︙ | ︙ | |||
1831 1832 1833 1834 1835 1836 1837 |
int
Tcl_ParseQuotedString(
Tcl_Interp *interp, /* Interpreter to use for error reporting; if
* NULL, then no error message is provided. */
const char *start, /* Start of the quoted string. The first
* character must be '"'. */
| | | | 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 |
int
Tcl_ParseQuotedString(
Tcl_Interp *interp, /* Interpreter to use for error reporting; if
* NULL, then no error message is provided. */
const char *start, /* Start of the quoted string. The first
* character must be '"'. */
Tcl_Size numBytes, /* Total number of bytes in string. If TCL_INDEX_NONE,
* the string consists of all bytes up to the
* first null character. */
Tcl_Parse *parsePtr,
/* Structure to fill in with information about
* the string. */
int append, /* Non-zero means append tokens to existing
* information in parsePtr; zero means ignore
* existing tokens in parsePtr and
* reinitialize it. */
const char **termPtr) /* If non-NULL, points to word in which to
* store a pointer to the character just after
* the quoted string's terminating close-quote
* if the parse succeeds. */
{
if (TCL_SIZE_ISNEG(numBytes) && start) {
numBytes = strlen(start);
}
if (!append) {
TclParseInit(interp, start, numBytes, parsePtr);
}
if ((numBytes == 0) || (start == NULL)) {
return TCL_ERROR;
|
| ︙ | ︙ |
Changes to generic/tclPathObj.c.
| ︙ | ︙ | |||
620 621 622 623 624 625 626 |
Tcl_IncrRefCount(fsPathPtr->normPathPtr);
return fsPathPtr->normPathPtr;
}
case TCL_PATH_EXTENSION:
return GetExtension(fsPathPtr->normPathPtr);
case TCL_PATH_ROOT: {
const char *fileName, *extension;
| | | 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 |
Tcl_IncrRefCount(fsPathPtr->normPathPtr);
return fsPathPtr->normPathPtr;
}
case TCL_PATH_EXTENSION:
return GetExtension(fsPathPtr->normPathPtr);
case TCL_PATH_ROOT: {
const char *fileName, *extension;
Tcl_Size length;
fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr,
&length);
extension = TclGetExtension(fileName);
if (extension == NULL) {
/*
* There is no extension so the root is the same as the
|
| ︙ | ︙ | |||
791 792 793 794 795 796 797 |
*---------------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_FSJoinPath(
Tcl_Obj *listObj, /* Path elements to join, may have a zero
* reference count. */
| | | | | | | 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 |
*---------------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_FSJoinPath(
Tcl_Obj *listObj, /* Path elements to join, may have a zero
* reference count. */
Tcl_Size elements) /* Number of elements to use (TCL_INDEX_NONE = all) */
{
Tcl_Obj *res;
Tcl_Size objc;
Tcl_Obj **objv;
if (TclListObjLengthM(NULL, listObj, &objc) != TCL_OK) {
return NULL;
}
elements = (!TCL_SIZE_ISNEG(elements) && (elements <= objc)) ? elements : objc;
TclListObjGetElementsM(NULL, listObj, &objc, &objv);
res = TclJoinPath(elements, objv, 0);
return res;
}
Tcl_Obj *
TclJoinPath(
Tcl_Size elements, /* Number of elements to use */
Tcl_Obj * const objv[], /* Path elements to join */
int forceRelative) /* If non-zero, assume all more paths are
* relative (e. g. simple normalization) */
{
Tcl_Obj *res = NULL;
Tcl_Size i;
const Tcl_Filesystem *fsPtr = NULL;
if (elements == 0) {
TclNewObj(res);
return res;
}
|
| ︙ | ︙ |
Changes to generic/tclPipe.c.
| ︙ | ︙ | |||
175 176 177 178 179 180 181 | * None. * *---------------------------------------------------------------------- */ void Tcl_DetachPids( | | | | 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 |
* None.
*
*----------------------------------------------------------------------
*/
void
Tcl_DetachPids(
Tcl_Size numPids, /* Number of pids to detach: gives size of
* array pointed to by pidPtr. */
Tcl_Pid *pidPtr) /* Array of pids to detach. */
{
Detached *detPtr;
Tcl_Size i;
Tcl_MutexLock(&pipeMutex);
for (i = 0; i < numPids; i++) {
detPtr = (Detached *)Tcl_Alloc(sizeof(Detached));
detPtr->pid = pidPtr[i];
detPtr->nextPtr = detList;
detList = detPtr;
|
| ︙ | ︙ | |||
265 266 267 268 269 270 271 |
*
*----------------------------------------------------------------------
*/
int
TclCleanupChildren(
Tcl_Interp *interp, /* Used for error messages. */
| | | | 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 |
*
*----------------------------------------------------------------------
*/
int
TclCleanupChildren(
Tcl_Interp *interp, /* Used for error messages. */
Tcl_Size numPids, /* Number of entries in pidPtr array. */
Tcl_Pid *pidPtr, /* Array of process ids of children. */
Tcl_Channel errorChan) /* Channel for file containing stderr output
* from pipeline. NULL means there isn't any
* stderr output. */
{
int result = TCL_OK;
int code, abnormalExit, anyErrorInfo;
TclProcessWaitStatus waitStatus;
Tcl_Size i;
Tcl_Obj *msg, *error;
abnormalExit = 0;
for (i = 0; i < numPids; i++) {
waitStatus = TclProcessWait(pidPtr[i], 0, &code, &msg, &error);
if (waitStatus == TCL_PROCESS_ERROR) {
result = TCL_ERROR;
|
| ︙ | ︙ | |||
391 392 393 394 395 396 397 | * * Side effects: * Processes and pipes are created. * *---------------------------------------------------------------------- */ | | | | 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 |
*
* Side effects:
* Processes and pipes are created.
*
*----------------------------------------------------------------------
*/
Tcl_Size
TclCreatePipeline(
Tcl_Interp *interp, /* Interpreter to use for error reporting. */
Tcl_Size argc, /* Number of entries in argv. */
const char **argv, /* Array of strings describing commands in
* pipeline plus I/O redirection with <, <<,
* >, etc. Argv[argc] must be NULL. */
Tcl_Pid **pidArrayPtr, /* Word at *pidArrayPtr gets filled in with
* address of array of pids for processes in
* pipeline (first pid is first process in
* pipeline). */
|
| ︙ | ︙ | |||
1017 1018 1019 1020 1021 1022 1023 |
*----------------------------------------------------------------------
*/
Tcl_Channel
Tcl_OpenCommandChannel(
Tcl_Interp *interp, /* Interpreter for error reporting. Can NOT be
* NULL. */
| | | | 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 |
*----------------------------------------------------------------------
*/
Tcl_Channel
Tcl_OpenCommandChannel(
Tcl_Interp *interp, /* Interpreter for error reporting. Can NOT be
* NULL. */
Tcl_Size argc, /* How many arguments. */
const char **argv, /* Array of arguments for command pipe. */
int flags) /* Or'ed combination of TCL_STDIN, TCL_STDOUT,
* TCL_STDERR, and TCL_ENFORCE_MODE. */
{
TclFile *inPipePtr, *outPipePtr, *errFilePtr;
TclFile inPipe, outPipe, errFile;
size_t numPids;
Tcl_Pid *pidPtr = NULL;
Tcl_Channel channel;
inPipe = outPipe = errFile = NULL;
inPipePtr = (flags & TCL_STDIN) ? &inPipe : NULL;
outPipePtr = (flags & TCL_STDOUT) ? &outPipe : NULL;
errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL;
numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr,
outPipePtr, errFilePtr);
if (TCL_SIZE_ISNEG(numPids)) {
goto error;
}
/*
* Verify that the pipes that were created satisfy the readable/writable
* constraints.
*/
|
| ︙ | ︙ |
Changes to generic/tclPkg.c.
| ︙ | ︙ | |||
422 423 424 425 426 427 428 |
}
int
Tcl_PkgRequireProc(
Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
const char *name, /* Name of desired package. */
| | | 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 |
}
int
Tcl_PkgRequireProc(
Tcl_Interp *interp, /* Interpreter in which package is now
* available. */
const char *name, /* Name of desired package. */
Tcl_Size reqc, /* Requirements constraining the desired
* version. */
Tcl_Obj *const reqv[], /* 0 means to use the latest version
* available. */
void *clientDataPtr)
{
RequireProcArgs args;
|
| ︙ | ︙ | |||
1156 1157 1158 1159 1160 1161 1162 |
Tcl_Free(availPtr);
}
Tcl_Free(pkgPtr);
}
break;
}
case PKG_IFNEEDED: {
| | | 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 |
Tcl_Free(availPtr);
}
Tcl_Free(pkgPtr);
}
break;
}
case PKG_IFNEEDED: {
Tcl_Size length;
int res;
char *argv3i, *avi;
if ((objc != 4) && (objc != 5)) {
Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
1395 1396 1397 1398 1399 1400 1401 |
Tcl_NRAddCallback(interp,
PkgRequireCore, (void *) argv2, INT2PTR(newobjc),
newObjvPtr, NULL);
return TCL_OK;
}
break;
case PKG_UNKNOWN: {
| | | 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 |
Tcl_NRAddCallback(interp,
PkgRequireCore, (void *) argv2, INT2PTR(newobjc),
newObjvPtr, NULL);
return TCL_OK;
}
break;
case PKG_UNKNOWN: {
Tcl_Size length;
if (objc == 2) {
if (iPtr->packageUnknown != NULL) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj(iPtr->packageUnknown, TCL_INDEX_NONE));
}
} else if (objc == 3) {
|
| ︙ | ︙ | |||
2068 2069 2070 2071 2072 2073 2074 |
int reqc, /* Requirements constraining the desired
* version. */
Tcl_Obj *const reqv[]) /* 0 means to use the latest version
* available. */
{
Tcl_Obj *result = Tcl_GetObjResult(interp);
int i;
| | | 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 |
int reqc, /* Requirements constraining the desired
* version. */
Tcl_Obj *const reqv[]) /* 0 means to use the latest version
* available. */
{
Tcl_Obj *result = Tcl_GetObjResult(interp);
int i;
Tcl_Size length;
for (i = 0; i < reqc; i++) {
const char *v = Tcl_GetStringFromObj(reqv[i], &length);
if ((length & 0x1) && (v[length/2] == '-')
&& (strncmp(v, v+((length+1)/2), length/2) == 0)) {
Tcl_AppendPrintfToObj(result, " exactly %s", v+((length+1)/2));
|
| ︙ | ︙ |
Changes to generic/tclRegexp.c.
| ︙ | ︙ | |||
249 250 251 252 253 254 255 |
*---------------------------------------------------------------------------
*/
void
Tcl_RegExpRange(
Tcl_RegExp re, /* Compiled regular expression that has been
* passed to Tcl_RegExpExec. */
| | | | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 |
*---------------------------------------------------------------------------
*/
void
Tcl_RegExpRange(
Tcl_RegExp re, /* Compiled regular expression that has been
* passed to Tcl_RegExpExec. */
Tcl_Size index, /* 0 means give the range of the entire match,
* > 0 means give the range of a matching
* subrange. */
const char **startPtr, /* Store address of first character in
* (sub-)range here. */
const char **endPtr) /* Store address of character just after last
* in (sub-)range here. */
{
TclRegexp *regexpPtr = (TclRegexp *) re;
const char *string;
if (index > regexpPtr->re.re_nsub) {
*startPtr = *endPtr = NULL;
} else if (TCL_SIZE_ISNEG(regexpPtr->matches[index].rm_so)) {
*startPtr = *endPtr = NULL;
} else {
if (regexpPtr->objPtr) {
string = TclGetString(regexpPtr->objPtr);
} else {
string = regexpPtr->string;
}
|
| ︙ | ︙ | |||
359 360 361 362 363 364 365 |
*---------------------------------------------------------------------------
*/
void
TclRegExpRangeUniChar(
Tcl_RegExp re, /* Compiled regular expression that has been
* passed to Tcl_RegExpExec. */
| | | | | | 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 |
*---------------------------------------------------------------------------
*/
void
TclRegExpRangeUniChar(
Tcl_RegExp re, /* Compiled regular expression that has been
* passed to Tcl_RegExpExec. */
Tcl_Size index, /* 0 means give the range of the entire match,
* > 0 means give the range of a matching
* subrange, TCL_INDEX_NONE means the range of the
* rm_extend field. */
Tcl_Size *startPtr, /* Store address of first character in
* (sub-)range here. */
Tcl_Size *endPtr) /* Store address of character just after last
* in (sub-)range here. */
{
TclRegexp *regexpPtr = (TclRegexp *) re;
if ((regexpPtr->flags®_EXPECT) && TCL_SIZE_ISNEG(index)) {
*startPtr = regexpPtr->details.rm_extend.rm_so;
*endPtr = regexpPtr->details.rm_extend.rm_eo;
} else if (index + 1 > regexpPtr->re.re_nsub + 1) {
*startPtr = TCL_INDEX_NONE;
*endPtr = TCL_INDEX_NONE;
} else {
*startPtr = regexpPtr->matches[index].rm_so;
|
| ︙ | ︙ | |||
439 440 441 442 443 444 445 |
int
Tcl_RegExpExecObj(
Tcl_Interp *interp, /* Interpreter to use for error reporting. */
Tcl_RegExp re, /* Compiled regular expression; must have been
* returned by previous call to
* Tcl_GetRegExpFromObj. */
Tcl_Obj *textObj, /* Text against which to match re. */
| | | | | | 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 |
int
Tcl_RegExpExecObj(
Tcl_Interp *interp, /* Interpreter to use for error reporting. */
Tcl_RegExp re, /* Compiled regular expression; must have been
* returned by previous call to
* Tcl_GetRegExpFromObj. */
Tcl_Obj *textObj, /* Text against which to match re. */
Tcl_Size offset, /* Character index that marks where matching
* should begin. */
Tcl_Size nmatches, /* How many subexpression matches (counting
* the whole match as subexpression 0) are of
* interest. TCL_INDEX_NONE means all of them. */
int flags) /* Regular expression execution flags. */
{
TclRegexp *regexpPtr = (TclRegexp *) re;
Tcl_UniChar *udata;
Tcl_Size length;
int reflags = regexpPtr->flags;
#define TCL_REG_GLOBOK_FLAGS \
(TCL_REG_ADVANCED | TCL_REG_NOSUB | TCL_REG_NOCASE)
/*
* Take advantage of the equivalent glob pattern, if one exists.
* This is possible based only on the right mix of incoming flags (0)
|
| ︙ | ︙ |
Changes to generic/tclResult.c.
| ︙ | ︙ | |||
353 354 355 356 357 358 359 |
const char *element) /* String to convert to list element and add
* to result. */
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *elementPtr = Tcl_NewStringObj(element, TCL_INDEX_NONE);
Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
const char *bytes;
| | | 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 |
const char *element) /* String to convert to list element and add
* to result. */
{
Interp *iPtr = (Interp *) interp;
Tcl_Obj *elementPtr = Tcl_NewStringObj(element, TCL_INDEX_NONE);
Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
const char *bytes;
Tcl_Size length;
if (Tcl_IsShared(iPtr->objResultPtr)) {
Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr));
}
bytes = Tcl_GetStringFromObj(iPtr->objResultPtr, &length);
if (TclNeedSpace(bytes, bytes + length)) {
Tcl_AppendToObj(iPtr->objResultPtr, " ", 1);
|
| ︙ | ︙ | |||
717 718 719 720 721 722 723 |
if (iPtr->errorInfo) {
Tcl_DecrRefCount(iPtr->errorInfo);
iPtr->errorInfo = NULL;
}
Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO],
&valuePtr);
if (valuePtr != NULL) {
| | | 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 |
if (iPtr->errorInfo) {
Tcl_DecrRefCount(iPtr->errorInfo);
iPtr->errorInfo = NULL;
}
Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO],
&valuePtr);
if (valuePtr != NULL) {
Tcl_Size length;
(void) Tcl_GetStringFromObj(valuePtr, &length);
if (length) {
iPtr->errorInfo = valuePtr;
Tcl_IncrRefCount(iPtr->errorInfo);
iPtr->flags |= ERR_ALREADY_LOGGED;
}
|
| ︙ | ︙ | |||
906 907 908 909 910 911 912 |
/*
* Check for bogus -errorcode value.
*/
Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORCODE], &valuePtr);
if (valuePtr != NULL) {
| | | 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 |
/*
* Check for bogus -errorcode value.
*/
Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORCODE], &valuePtr);
if (valuePtr != NULL) {
Tcl_Size length;
if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length )) {
/*
* Value is not a list, which is illegal for -errorcode.
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
| ︙ | ︙ | |||
928 929 930 931 932 933 934 |
/*
* Check for bogus -errorstack value.
*/
Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORSTACK], &valuePtr);
if (valuePtr != NULL) {
| | | 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 |
/*
* Check for bogus -errorstack value.
*/
Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORSTACK], &valuePtr);
if (valuePtr != NULL) {
Tcl_Size length;
if (TCL_ERROR == TclListObjLengthM(NULL, valuePtr, &length)) {
/*
* Value is not a list, which is illegal for -errorstack.
*/
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
|
| ︙ | ︙ |
Changes to generic/tclStringObj.c.
| ︙ | ︙ | |||
253 254 255 256 257 258 259 |
#ifdef TCL_MEM_DEBUG
#undef Tcl_NewStringObj
Tcl_Obj *
Tcl_NewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
| | | | | | 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 |
#ifdef TCL_MEM_DEBUG
#undef Tcl_NewStringObj
Tcl_Obj *
Tcl_NewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
Tcl_Size length) /* The number of bytes to copy from "bytes"
* when initializing the new object. If
* TCL_INDEX_NONE, use bytes up to the first NUL
* byte. */
{
return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_NewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
Tcl_Size length) /* The number of bytes to copy from "bytes"
* when initializing the new object. If TCL_INDEX_NONE,
* use bytes up to the first NUL byte. */
{
Tcl_Obj *objPtr;
if (TCL_SIZE_ISNEG(length)) {
length = (bytes? strlen(bytes) : 0);
}
TclNewStringObj(objPtr, bytes, length);
return objPtr;
}
#endif /* TCL_MEM_DEBUG */
|
| ︙ | ︙ | |||
313 314 315 316 317 318 319 |
*/
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
| | | | | 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 |
*/
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
Tcl_Size length, /* The number of bytes to copy from "bytes"
* when initializing the new object. If -1,
* use bytes up to the first NUL byte. */
const char *file, /* The name of the source file calling this
* function; used for debugging. */
int line) /* Line number in the source file; used for
* debugging. */
{
Tcl_Obj *objPtr;
if (TCL_SIZE_ISNEG(length)) {
length = (bytes? strlen(bytes) : 0);
}
TclDbNewObj(objPtr, file, line);
TclInitStringRep(objPtr, bytes, length);
return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewStringObj(
const char *bytes, /* Points to the first of the length bytes
* used to initialize the new object. */
Tcl_Size length, /* The number of bytes to copy from "bytes"
* when initializing the new object. If -1,
* use bytes up to the first NUL byte. */
TCL_UNUSED(const char *) /*file*/,
TCL_UNUSED(int) /*line*/)
{
return Tcl_NewStringObj(bytes, length);
}
|
| ︙ | ︙ | |||
368 369 370 371 372 373 374 |
*---------------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_NewUnicodeObj(
const Tcl_UniChar *unicode, /* The unicode string used to initialize the
* new object. */
| | | 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 |
*---------------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_NewUnicodeObj(
const Tcl_UniChar *unicode, /* The unicode string used to initialize the
* new object. */
Tcl_Size numChars) /* Number of characters in the unicode
* string. */
{
Tcl_Obj *objPtr;
TclNewObj(objPtr);
SetUnicodeObj(objPtr, unicode, numChars);
return objPtr;
|
| ︙ | ︙ | |||
395 396 397 398 399 400 401 | * Side effects: * Frees old internal rep. Allocates memory for new "String" internal * rep. * *---------------------------------------------------------------------- */ | | | | 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 |
* Side effects:
* Frees old internal rep. Allocates memory for new "String" internal
* rep.
*
*----------------------------------------------------------------------
*/
Tcl_Size
Tcl_GetCharLength(
Tcl_Obj *objPtr) /* The String object to get the num chars
* of. */
{
String *stringPtr;
Tcl_Size numChars = 0;
/*
* Quick, no-shimmer return for short string reps.
*/
if ((objPtr->bytes) && (objPtr->length < 2)) {
/* 0 bytes -> 0 chars; 1 byte -> 1 char */
|
| ︙ | ︙ | |||
440 441 442 443 444 445 446 |
stringPtr = GET_STRING(objPtr);
numChars = stringPtr->numChars;
/*
* If numChars is unknown, compute it.
*/
| | | | | 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 |
stringPtr = GET_STRING(objPtr);
numChars = stringPtr->numChars;
/*
* If numChars is unknown, compute it.
*/
if (TCL_SIZE_ISNEG(numChars)) {
TclNumUtfCharsM(numChars, objPtr->bytes, objPtr->length);
stringPtr->numChars = numChars;
}
return numChars;
}
Tcl_Size
TclGetCharLength(
Tcl_Obj *objPtr) /* The String object to get the num chars
* of. */
{
Tcl_Size numChars = 0;
/*
* Quick, no-shimmer return for short string reps.
*/
if ((objPtr->bytes) && (objPtr->length < 2)) {
/* 0 bytes -> 0 chars; 1 byte -> 1 char */
|
| ︙ | ︙ | |||
505 506 507 508 509 510 511 |
*
*----------------------------------------------------------------------
*/
int
TclCheckEmptyString(
Tcl_Obj *objPtr)
{
| | | 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 |
*
*----------------------------------------------------------------------
*/
int
TclCheckEmptyString(
Tcl_Obj *objPtr)
{
Tcl_Size length = TCL_INDEX_NONE;
if (objPtr->bytes == &tclEmptyString) {
return TCL_EMPTYSTRING_YES;
}
if (TclListObjIsCanonical(objPtr)) {
TclListObjLengthM(NULL, objPtr, &length);
|
| ︙ | ︙ | |||
549 550 551 552 553 554 555 |
*----------------------------------------------------------------------
*/
int
Tcl_GetUniChar(
Tcl_Obj *objPtr, /* The object to get the Unicode charater
* from. */
| | | | | 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 |
*----------------------------------------------------------------------
*/
int
Tcl_GetUniChar(
Tcl_Obj *objPtr, /* The object to get the Unicode charater
* from. */
Tcl_Size index) /* Get the index'th Unicode character. */
{
String *stringPtr;
int ch;
/*
* Optimize the case where we're really dealing with a bytearray object
* we don't need to convert to a string to perform the indexing operation.
*/
if (TclIsPureByteArray(objPtr)) {
Tcl_Size length = 0;
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
if (index >= length) {
return -1;
}
return bytes[index];
}
/*
* OK, need to work with the object as a string.
*/
SetStringFromAny(NULL, objPtr);
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
/*
* If numChars is unknown, compute it.
*/
if (TCL_SIZE_ISNEG(stringPtr->numChars)) {
TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
return (unsigned char) objPtr->bytes[index];
}
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
|
| ︙ | ︙ | |||
618 619 620 621 622 623 624 |
return ch;
}
int
TclGetUniChar(
Tcl_Obj *objPtr, /* The object to get the Unicode charater
* from. */
| | | | | 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 |
return ch;
}
int
TclGetUniChar(
Tcl_Obj *objPtr, /* The object to get the Unicode charater
* from. */
Tcl_Size index) /* Get the index'th Unicode character. */
{
int ch = 0;
/*
* Optimize the case where we're really dealing with a bytearray object
* we don't need to convert to a string to perform the indexing operation.
*/
if (TclIsPureByteArray(objPtr)) {
Tcl_Size length = 0;
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
if (index >= length) {
return -1;
}
return bytes[index];
}
Tcl_Size numChars = TclNumUtfChars(objPtr->bytes, objPtr->length);
if (index >= numChars) {
return -1;
}
const char *begin = TclUtfAtIndex(objPtr->bytes, index);
#undef Tcl_UtfToUniChar
Tcl_UtfToUniChar(begin, &ch);
|
| ︙ | ︙ | |||
689 690 691 692 693 694 695 |
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (lengthPtr != NULL) {
if (stringPtr->numChars > INT_MAX) {
Tcl_Panic("Tcl_GetUnicodeFromObj with 'int' lengthPtr"
| | | 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 |
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
if (lengthPtr != NULL) {
if (stringPtr->numChars > INT_MAX) {
Tcl_Panic("Tcl_GetUnicodeFromObj with 'int' lengthPtr"
"cannot handle such long strings. Please use 'Tcl_Size'");
}
*lengthPtr = (int)stringPtr->numChars;
}
return stringPtr->unicode;
}
Tcl_UniChar *
|
| ︙ | ︙ | |||
743 744 745 746 747 748 749 |
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_GetRange(
Tcl_Obj *objPtr, /* The Tcl object to find the range of. */
| | | | | | 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 |
*
*----------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_GetRange(
Tcl_Obj *objPtr, /* The Tcl object to find the range of. */
Tcl_Size first, /* First index of the range. */
Tcl_Size last) /* Last index of the range. */
{
Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */
String *stringPtr;
Tcl_Size length = 0;
if (TCL_SIZE_ISNEG(first)) {
first = TCL_INDEX_START;
}
/*
* Optimize the case where we're really dealing with a bytearray object
* we don't need to convert to a string to perform the substring operation.
*/
|
| ︙ | ︙ | |||
784 785 786 787 788 789 790 |
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
/*
* If numChars is unknown, compute it.
*/
| | | 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 |
stringPtr = GET_STRING(objPtr);
if (stringPtr->hasUnicode == 0) {
/*
* If numChars is unknown, compute it.
*/
if (TCL_SIZE_ISNEG(stringPtr->numChars)) {
TclNumUtfCharsM(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
if (last >= stringPtr->numChars) {
last = stringPtr->numChars - 1;
}
if (last + 1 < first + 1) {
|
| ︙ | ︙ | |||
834 835 836 837 838 839 840 |
#endif
return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
}
Tcl_Obj *
TclGetRange(
Tcl_Obj *objPtr, /* The Tcl object to find the range of. */
| | | | | | 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 |
#endif
return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
}
Tcl_Obj *
TclGetRange(
Tcl_Obj *objPtr, /* The Tcl object to find the range of. */
Tcl_Size first, /* First index of the range. */
Tcl_Size last) /* Last index of the range. */
{
Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */
Tcl_Size length = 0;
if (TCL_SIZE_ISNEG(first)) {
first = TCL_INDEX_START;
}
/*
* Optimize the case where we're really dealing with a bytearray object
* we don't need to convert to a string to perform the substring operation.
*/
|
| ︙ | ︙ | |||
862 863 864 865 866 867 868 |
if (last + 1 < first + 1) {
TclNewObj(newObjPtr);
return newObjPtr;
}
return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
}
| | | 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 |
if (last + 1 < first + 1) {
TclNewObj(newObjPtr);
return newObjPtr;
}
return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
}
Tcl_Size numChars = TclNumUtfChars(objPtr->bytes, objPtr->length);
if (last >= numChars) {
last = numChars - 1;
}
if (last + 1 < first + 1) {
TclNewObj(newObjPtr);
return newObjPtr;
|
| ︙ | ︙ | |||
902 903 904 905 906 907 908 |
*/
void
Tcl_SetStringObj(
Tcl_Obj *objPtr, /* Object whose internal rep to init. */
const char *bytes, /* Points to the first of the length bytes
* used to initialize the object. */
| | | | | 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 |
*/
void
Tcl_SetStringObj(
Tcl_Obj *objPtr, /* Object whose internal rep to init. */
const char *bytes, /* Points to the first of the length bytes
* used to initialize the object. */
Tcl_Size length) /* The number of bytes to copy from "bytes"
* when initializing the object. If TCL_INDEX_NONE,
* use bytes up to the first NUL byte.*/
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetStringObj");
}
/*
* Set the type to NULL and free any internal rep for the old type.
*/
TclFreeInternalRep(objPtr);
/*
* Free any old string rep, then set the string rep to a copy of the
* length bytes starting at "bytes".
*/
TclInvalidateStringRep(objPtr);
if (TCL_SIZE_ISNEG(length)) {
length = (bytes? strlen(bytes) : 0);
}
TclInitStringRep(objPtr, bytes, length);
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
955 956 957 958 959 960 961 |
*----------------------------------------------------------------------
*/
void
Tcl_SetObjLength(
Tcl_Obj *objPtr, /* Pointer to object. This object must not
* currently be shared. */
| | | 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 |
*----------------------------------------------------------------------
*/
void
Tcl_SetObjLength(
Tcl_Obj *objPtr, /* Pointer to object. This object must not
* currently be shared. */
Tcl_Size length) /* Number of bytes desired for string
* representation of object, not including
* terminating null byte. */
{
String *stringPtr;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetObjLength");
|
| ︙ | ︙ | |||
1046 1047 1048 1049 1050 1051 1052 |
*----------------------------------------------------------------------
*/
int
Tcl_AttemptSetObjLength(
Tcl_Obj *objPtr, /* Pointer to object. This object must not
* currently be shared. */
| | | 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 |
*----------------------------------------------------------------------
*/
int
Tcl_AttemptSetObjLength(
Tcl_Obj *objPtr, /* Pointer to object. This object must not
* currently be shared. */
Tcl_Size length) /* Number of bytes desired for string
* representation of object, not including
* terminating null byte. */
{
String *stringPtr;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength");
|
| ︙ | ︙ | |||
1145 1146 1147 1148 1149 1150 1151 |
*/
void
Tcl_SetUnicodeObj(
Tcl_Obj *objPtr, /* The object to set the string of. */
const Tcl_UniChar *unicode, /* The unicode string used to initialize the
* object. */
| | | | | | | 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 |
*/
void
Tcl_SetUnicodeObj(
Tcl_Obj *objPtr, /* The object to set the string of. */
const Tcl_UniChar *unicode, /* The unicode string used to initialize the
* object. */
Tcl_Size numChars) /* Number of characters in the unicode
* string. */
{
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
}
TclFreeInternalRep(objPtr);
SetUnicodeObj(objPtr, unicode, numChars);
}
static size_t
UnicodeLength(
const Tcl_UniChar *unicode)
{
Tcl_Size numChars = 0;
if (unicode) {
while (!TCL_SIZE_ISNEG(numChars) && (unicode[numChars] != 0)) {
numChars++;
}
}
return numChars;
}
static void
SetUnicodeObj(
Tcl_Obj *objPtr, /* The object to set the string of. */
const Tcl_UniChar *unicode, /* The unicode string used to initialize the
* object. */
size_t numChars) /* Number of characters in the unicode
* string. */
{
String *stringPtr;
if (TCL_SIZE_ISNEG(numChars)) {
numChars = UnicodeLength(unicode);
}
/*
* Allocate enough space for the String structure + Unicode string.
*/
stringPtr = stringAlloc(numChars);
|
| ︙ | ︙ | |||
1224 1225 1226 1227 1228 1229 1230 |
*/
void
Tcl_AppendLimitedToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* Points to the bytes to append to the
* object. */
| | | | | | 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 |
*/
void
Tcl_AppendLimitedToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* Points to the bytes to append to the
* object. */
Tcl_Size length, /* The number of bytes available to be
* appended from "bytes". If TCL_INDEX_NONE, then
* all bytes up to a NUL byte are available. */
Tcl_Size limit, /* The maximum number of bytes to append to
* the object. */
const char *ellipsis) /* Ellipsis marker string, appended to the
* object to indicate not all available bytes
* at "bytes" were appended. */
{
String *stringPtr;
size_t toCopy = 0;
size_t eLen = 0;
if (TCL_SIZE_ISNEG(length)) {
length = (bytes ? strlen(bytes) : 0);
}
if (length == 0) {
return;
}
if (limit <= 0) {
return;
|
| ︙ | ︙ | |||
1320 1321 1322 1323 1324 1325 1326 |
*/
void
Tcl_AppendToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* Points to the bytes to append to the
* object. */
| | | 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 |
*/
void
Tcl_AppendToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const char *bytes, /* Points to the bytes to append to the
* object. */
Tcl_Size length) /* The number of bytes to append from "bytes".
* If TCL_INDEX_NONE, then append all bytes up to NUL
* byte. */
{
Tcl_AppendLimitedToObj(objPtr, bytes, length, TCL_INDEX_NONE, NULL);
}
/*
|
| ︙ | ︙ | |||
1349 1350 1351 1352 1353 1354 1355 |
*/
void
Tcl_AppendUnicodeToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* The unicode string to append to the
* object. */
| | | 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 |
*/
void
Tcl_AppendUnicodeToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* The unicode string to append to the
* object. */
Tcl_Size length) /* Number of chars in "unicode". */
{
String *stringPtr;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj");
}
|
| ︙ | ︙ | |||
1403 1404 1405 1406 1407 1408 1409 |
void
Tcl_AppendObjToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
Tcl_Obj *appendObjPtr) /* Object to append. */
{
String *stringPtr;
| | | 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 |
void
Tcl_AppendObjToObj(
Tcl_Obj *objPtr, /* Points to the object to append to. */
Tcl_Obj *appendObjPtr) /* Object to append. */
{
String *stringPtr;
Tcl_Size length = 0, numChars;
size_t appendNumChars = TCL_INDEX_NONE;
const char *bytes;
/*
* Special case: second object is standard-empty is fast case. We know
* that appending nothing to anything leaves that starting anything...
*/
|
| ︙ | ︙ | |||
1444 1445 1446 1447 1448 1449 1450 | * Write!). For the sake of extensions that go off into that realm, * though, here's a more complex approach that can handle all the * cases. * * First, get the lengths. */ | | | 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 | * Write!). For the sake of extensions that go off into that realm, * though, here's a more complex approach that can handle all the * cases. * * First, get the lengths. */ Tcl_Size lengthSrc = 0; (void) Tcl_GetByteArrayFromObj(objPtr, &length); (void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc); /* * Grow buffer enough for the append. */ |
| ︙ | ︙ | |||
1516 1517 1518 1519 1520 1521 1522 |
* in both objects before appending, then set the combined number of
* characters in the final (appended-to) object.
*/
bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
numChars = stringPtr->numChars;
| | | | 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 |
* in both objects before appending, then set the combined number of
* characters in the final (appended-to) object.
*/
bytes = Tcl_GetStringFromObj(appendObjPtr, &length);
numChars = stringPtr->numChars;
if (!TCL_SIZE_ISNEG(numChars) && TclHasInternalRep(appendObjPtr, &tclStringType)) {
String *appendStringPtr = GET_STRING(appendObjPtr);
appendNumChars = appendStringPtr->numChars;
}
AppendUtfToUtfRep(objPtr, bytes, length);
if (!TCL_SIZE_ISNEG(numChars) && !TCL_SIZE_ISNEG(appendNumChars)) {
stringPtr->numChars = numChars + appendNumChars;
}
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
1555 1556 1557 1558 1559 1560 1561 |
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* String to append. */
size_t appendNumChars) /* Number of chars of "unicode" to append. */
{
String *stringPtr;
size_t numChars;
| | | 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 |
Tcl_Obj *objPtr, /* Points to the object to append to. */
const Tcl_UniChar *unicode, /* String to append. */
size_t appendNumChars) /* Number of chars of "unicode" to append. */
{
String *stringPtr;
size_t numChars;
if (TCL_SIZE_ISNEG(appendNumChars)) {
appendNumChars = UnicodeLength(unicode);
}
if (appendNumChars == 0) {
return;
}
SetStringFromAny(NULL, objPtr);
|
| ︙ | ︙ | |||
1596 1597 1598 1599 1600 1601 1602 | GrowUnicodeBuffer(objPtr, numChars); stringPtr = GET_STRING(objPtr); /* * Relocate unicode if needed; see above. */ | | | 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 |
GrowUnicodeBuffer(objPtr, numChars);
stringPtr = GET_STRING(objPtr);
/*
* Relocate unicode if needed; see above.
*/
if (!TCL_SIZE_ISNEG(index)) {
unicode = stringPtr->unicode + index;
}
}
/*
* Copy the new string onto the end of the old string, then add the
* trailing null.
|
| ︙ | ︙ | |||
1644 1645 1646 1647 1648 1649 1650 |
const Tcl_UniChar *unicode, /* String to convert to UTF. */
size_t numChars) /* Number of chars of "unicode" to convert. */
{
String *stringPtr = GET_STRING(objPtr);
numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);
| | | 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 |
const Tcl_UniChar *unicode, /* String to convert to UTF. */
size_t numChars) /* Number of chars of "unicode" to convert. */
{
String *stringPtr = GET_STRING(objPtr);
numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);
if (!TCL_SIZE_ISNEG(stringPtr->numChars)) {
stringPtr->numChars += numChars;
}
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
1753 1754 1755 1756 1757 1758 1759 | GrowStringBuffer(objPtr, newLength, 0); /* * Relocate bytes if needed; see above. */ | | | 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 |
GrowStringBuffer(objPtr, newLength, 0);
/*
* Relocate bytes if needed; see above.
*/
if (!TCL_SIZE_ISNEG(offset)) {
bytes = objPtr->bytes + offset;
}
}
/*
* Invalidate the unicode data.
*/
|
| ︙ | ︙ | |||
1838 1839 1840 1841 1842 1843 1844 |
*/
int
Tcl_AppendFormatToObj(
Tcl_Interp *interp,
Tcl_Obj *appendObj,
const char *format,
| | | | 1838 1839 1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 |
*/
int
Tcl_AppendFormatToObj(
Tcl_Interp *interp,
Tcl_Obj *appendObj,
const char *format,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
const char *span = format, *msg, *errCode;
int gotXpg = 0, gotSequential = 0;
Tcl_Size objIndex = 0, originalLength, limit, numBytes = 0;
Tcl_UniChar ch = 0;
static const char *mixedXPG =
"cannot mix \"%\" and \"%n$\" conversion specifiers";
static const char *const badIndex[2] = {
"not enough arguments for all format specifiers",
"\"%n$\" argument index out of range"
};
|
| ︙ | ︙ | |||
2243 2244 2245 2246 2247 2248 2249 |
segmentLimit -= 2;
break;
}
}
switch (ch) {
case 'd': {
| | | 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 |
segmentLimit -= 2;
break;
}
}
switch (ch) {
case 'd': {
Tcl_Size length;
Tcl_Obj *pure;
const char *bytes;
if (useShort) {
TclNewIntObj(pure, s);
#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
|
| ︙ | ︙ | |||
2316 2317 2318 2319 2320 2321 2322 |
case 'p':
case 'x':
case 'X':
case 'b': {
Tcl_WideUInt bits = 0;
Tcl_WideInt numDigits = 0;
int numBits = 4, base = 16, index = 0, shift = 0;
| | | 2316 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 |
case 'p':
case 'x':
case 'X':
case 'b': {
Tcl_WideUInt bits = 0;
Tcl_WideInt numDigits = 0;
int numBits = 4, base = 16, index = 0, shift = 0;
Tcl_Size length;
Tcl_Obj *pure;
char *bytes;
if (ch == 'u') {
base = 10;
} else if (ch == 'o') {
base = 8;
|
| ︙ | ︙ | |||
2610 2611 2612 2613 2614 2615 2616 |
*---------------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_Format(
Tcl_Interp *interp,
const char *format,
| | | 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 |
*---------------------------------------------------------------------------
*/
Tcl_Obj *
Tcl_Format(
Tcl_Interp *interp,
const char *format,
Tcl_Size objc,
Tcl_Obj *const objv[])
{
int result;
Tcl_Obj *objPtr;
TclNewObj(objPtr);
result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
|
| ︙ | ︙ | |||
2891 2892 2893 2894 2895 2896 2897 |
*
*---------------------------------------------------------------------------
*/
char *
TclGetStringStorage(
Tcl_Obj *objPtr,
| | | 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 |
*
*---------------------------------------------------------------------------
*/
char *
TclGetStringStorage(
Tcl_Obj *objPtr,
Tcl_Size *sizePtr)
{
String *stringPtr;
if (!TclHasInternalRep(objPtr, &tclStringType) || objPtr->bytes == NULL) {
return Tcl_GetStringFromObj(objPtr, sizePtr);
}
|
| ︙ | ︙ | |||
2930 2931 2932 2933 2934 2935 2936 |
Tcl_Interp *interp,
Tcl_Obj *objPtr,
size_t count,
int flags)
{
Tcl_Obj *objResultPtr;
int inPlace = flags & TCL_STRING_IN_PLACE;
| | | 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 |
Tcl_Interp *interp,
Tcl_Obj *objPtr,
size_t count,
int flags)
{
Tcl_Obj *objResultPtr;
int inPlace = flags & TCL_STRING_IN_PLACE;
Tcl_Size length = 0, unichar = 0, done = 1;
int binary = TclIsPureByteArray(objPtr);
size_t maxCount;
/* assert (count >= 2) */
/*
* Analyze to determine what representation result should be.
|
| ︙ | ︙ | |||
3086 3087 3088 3089 3090 3091 3092 |
Tcl_Interp *interp,
int objc,
Tcl_Obj * const objv[],
int flags)
{
Tcl_Obj *objResultPtr, * const *ov;
int oc, binary = 1;
| | | 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 |
Tcl_Interp *interp,
int objc,
Tcl_Obj * const objv[],
int flags)
{
Tcl_Obj *objResultPtr, * const *ov;
int oc, binary = 1;
Tcl_Size length = 0;
int allowUniChar = 1, requestUniChar = 0, forceUniChar = 0;
int first = objc - 1; /* Index of first value possibly not empty */
int last = 0; /* Index of last value possibly not empty */
int inPlace = flags & TCL_STRING_IN_PLACE;
/* assert ( objc >= 0 ) */
|
| ︙ | ︙ | |||
3470 3471 3472 3473 3474 3475 3476 |
int checkEq, /* comparison is only for equality */
int nocase, /* comparison is not case sensitive */
size_t reqlength) /* requested length in characters;
* TCL_INDEX_NONE to compare whole strings */
{
const char *s1, *s2;
int empty, match;
| | | 3470 3471 3472 3473 3474 3475 3476 3477 3478 3479 3480 3481 3482 3483 3484 |
int checkEq, /* comparison is only for equality */
int nocase, /* comparison is not case sensitive */
size_t reqlength) /* requested length in characters;
* TCL_INDEX_NONE to compare whole strings */
{
const char *s1, *s2;
int empty, match;
Tcl_Size length, s1len = 0, s2len = 0;
memCmpFn_t memCmpFn;
if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
/*
* Always match at 0 chars of if it is the same obj.
*/
match = 0;
|
| ︙ | ︙ | |||
3530 3531 3532 3533 3534 3535 3536 |
#else
checkEq
#endif
) {
memCmpFn = memcmp;
s1len *= sizeof(Tcl_UniChar);
s2len *= sizeof(Tcl_UniChar);
| | | 3530 3531 3532 3533 3534 3535 3536 3537 3538 3539 3540 3541 3542 3543 3544 |
#else
checkEq
#endif
) {
memCmpFn = memcmp;
s1len *= sizeof(Tcl_UniChar);
s2len *= sizeof(Tcl_UniChar);
if (!TCL_SIZE_ISNEG(reqlength)) {
reqlength *= sizeof(Tcl_UniChar);
}
} else {
memCmpFn = (memCmpFn_t) TclUniCharNcmp;
}
}
}
|
| ︙ | ︙ | |||
3574 3575 3576 3577 3578 3579 3580 |
match = 0;
goto matchdone;
}
} else {
s1 = Tcl_GetStringFromObj(value1Ptr, &s1len);
s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
}
| | | | | | 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 3589 3590 3591 3592 3593 3594 3595 3596 3597 3598 3599 3600 3601 3602 3603 3604 3605 3606 3607 3608 3609 3610 3611 3612 3613 3614 3615 3616 3617 3618 3619 3620 3621 3622 3623 3624 3625 3626 3627 3628 3629 3630 3631 3632 |
match = 0;
goto matchdone;
}
} else {
s1 = Tcl_GetStringFromObj(value1Ptr, &s1len);
s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
}
if (!nocase && checkEq && TCL_SIZE_ISNEG(reqlength)) {
/*
* When we have equal-length we can check only for
* (in)equality. We can use memcmp in all (n)eq cases because
* we don't need to worry about lexical LE/BE variance.
*/
memCmpFn = memcmp;
} else {
/*
* As a catch-all we will work with UTF-8. We cannot use
* memcmp() as that is unsafe with any string containing NUL
* (\xC0\x80 in Tcl's utf rep). We can use the more efficient
* TclpUtfNcmp2 if we are case-sensitive and no specific
* length was requested.
*/
if (TCL_SIZE_ISNEG(reqlength) && !nocase) {
memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
} else {
s1len = Tcl_NumUtfChars(s1, s1len);
s2len = Tcl_NumUtfChars(s2, s2len);
memCmpFn = (memCmpFn_t)
(nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
}
}
}
/* At this point s1len, s2len, and reqlength should by now have been
* adjusted so that they are all in the units expected by the selected
* comparison function.
*/
length = (s1len < s2len) ? s1len : s2len;
if (TCL_SIZE_ISNEG(reqlength)) {
/*
* The requested length is negative, so ignore it by setting it
* to length + 1 to correct the match var.
*/
reqlength = length + 1;
} else if (reqlength > 0 && reqlength < length) {
length = reqlength;
}
if (checkEq && TCL_SIZE_ISNEG(reqlength) && (s1len != s2len)) {
match = 1; /* This will be reversed below. */
} else {
/*
* The comparison function should compare up to the minimum byte
* length only.
*/
|
| ︙ | ︙ | |||
3666 3667 3668 3669 3670 3671 3672 |
size_t start)
{
size_t lh = 0, ln = Tcl_GetCharLength(needle);
size_t value = TCL_INDEX_NONE;
Tcl_UniChar *checkStr, *endStr, *uh, *un;
Tcl_Obj *obj;
| | | 3666 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 |
size_t start)
{
size_t lh = 0, ln = Tcl_GetCharLength(needle);
size_t value = TCL_INDEX_NONE;
Tcl_UniChar *checkStr, *endStr, *uh, *un;
Tcl_Obj *obj;
if (TCL_SIZE_ISNEG(start)) {
start = 0;
}
if (ln == 0) {
/* We don't find empty substrings. Bizarre!
* Whenever this routine is turned into a proper substring
* finder, change to `return start` after limits imposed. */
goto firstEnd;
|
| ︙ | ︙ | |||
3977 3978 3979 3980 3981 3982 3983 |
if (!inPlace || Tcl_IsShared(objPtr)) {
TclNewObj(objPtr);
Tcl_SetObjLength(objPtr, numBytes);
}
to = objPtr->bytes;
| | | 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 |
if (!inPlace || Tcl_IsShared(objPtr)) {
TclNewObj(objPtr);
Tcl_SetObjLength(objPtr, numBytes);
}
to = objPtr->bytes;
if (TCL_SIZE_ISNEG(numChars) || (numChars < numBytes)) {
/*
* Either numChars == -1 and we don't know how many chars are
* represented by objPtr->bytes and we need Pass 1 just in case,
* or numChars >= 0 and we know we have fewer chars than bytes, so
* we know there's a multibyte character needing Pass 1.
*
* Pass 1. Reverse the bytes of each multi-byte character.
|
| ︙ | ︙ | |||
4198 4199 4200 4201 4202 4203 4204 |
String *stringPtr = GET_STRING(objPtr);
size_t needed, numOrigChars = 0;
Tcl_UniChar *dst, unichar = 0;
if (stringPtr->hasUnicode) {
numOrigChars = stringPtr->numChars;
}
| | | 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 |
String *stringPtr = GET_STRING(objPtr);
size_t needed, numOrigChars = 0;
Tcl_UniChar *dst, unichar = 0;
if (stringPtr->hasUnicode) {
numOrigChars = stringPtr->numChars;
}
if (TCL_SIZE_ISNEG(numAppendChars)) {
TclNumUtfCharsM(numAppendChars, bytes, numBytes);
}
needed = numOrigChars + numAppendChars;
if (needed > stringPtr->maxChars) {
GrowUnicodeBuffer(objPtr, needed);
stringPtr = GET_STRING(objPtr);
|
| ︙ | ︙ | |||
4254 4255 4256 4257 4258 4259 4260 |
* an internal rep of type "String". */
Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
* currently have an internal rep.*/
{
String *srcStringPtr = GET_STRING(srcPtr);
String *copyStringPtr = NULL;
| | | 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 |
* an internal rep of type "String". */
Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
* currently have an internal rep.*/
{
String *srcStringPtr = GET_STRING(srcPtr);
String *copyStringPtr = NULL;
if (TCL_SIZE_ISNEG(srcStringPtr->numChars)) {
/*
* The String struct in the source value holds zero useful data. Don't
* bother copying it. Don't even bother allocating space in which to
* copy it. Just let the copy be untyped.
*/
return;
|
| ︙ | ︙ | |||
4404 4405 4406 4407 4408 4409 4410 |
* Pre-condition: this is the "string" Tcl_ObjType.
*/
size_t i, origLength, size = 0;
char *dst;
String *stringPtr = GET_STRING(objPtr);
| | | 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 |
* Pre-condition: this is the "string" Tcl_ObjType.
*/
size_t i, origLength, size = 0;
char *dst;
String *stringPtr = GET_STRING(objPtr);
if (TCL_SIZE_ISNEG(numChars)) {
numChars = UnicodeLength(unicode);
}
if (numChars == 0) {
return 0;
}
|
| ︙ | ︙ |
Changes to generic/tclTest.c.
| ︙ | ︙ | |||
12 13 14 15 16 17 18 19 20 21 22 23 24 25 | * Copyright © 2003 Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" #ifdef TCL_WITH_EXTERNAL_TOMMATH # include "tommath.h" #else | > | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | * Copyright © 2003 Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #undef STATIC_BUILD #undef BUILD_tcl #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" #ifdef TCL_WITH_EXTERNAL_TOMMATH # include "tommath.h" #else |
| ︙ | ︙ | |||
2230 2231 2232 2233 2234 2235 2236 |
TestencodingObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Encoding encoding;
| | | 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 |
TestencodingObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Encoding encoding;
Tcl_Size length;
const char *string;
TclEncoding *encodingPtr;
static const char *const optionStrings[] = {
"create", "delete", "nullength", "Tcl_ExternalToUtf", "Tcl_UtfToExternal", NULL
};
enum options {
ENC_CREATE, ENC_DELETE, ENC_NULLENGTH, ENC_EXTTOUTF, ENC_UTFTOEXT
|
| ︙ | ︙ | |||
4536 4537 4538 4539 4540 4541 4542 |
Tcl_Obj *newPtr, *varPtr, *valuePtr;
varPtr = objv[i];
ii = ((cflags®_EXPECT) && i == objc-1) ? TCL_INDEX_NONE : (Tcl_Size)i;
if (indices) {
Tcl_Obj *objs[2];
| | | | | | 4537 4538 4539 4540 4541 4542 4543 4544 4545 4546 4547 4548 4549 4550 4551 4552 4553 4554 4555 4556 4557 4558 4559 4560 4561 4562 4563 4564 4565 4566 4567 4568 4569 4570 4571 |
Tcl_Obj *newPtr, *varPtr, *valuePtr;
varPtr = objv[i];
ii = ((cflags®_EXPECT) && i == objc-1) ? TCL_INDEX_NONE : (Tcl_Size)i;
if (indices) {
Tcl_Obj *objs[2];
if (TCL_SIZE_ISNEG(ii)) {
TclRegExpRangeUniChar(regExpr, ii, &start, &end);
} else if (ii > info.nsubs) {
start = TCL_INDEX_NONE;
end = TCL_INDEX_NONE;
} else {
start = info.matches[ii].start;
end = info.matches[ii].end;
}
/*
* Adjust index so it refers to the last character in the match
* instead of the first character after the match.
*/
if (!TCL_SIZE_ISNEG(end)) {
end--;
}
objs[0] = Tcl_NewWideIntObj((Tcl_WideInt)start);
objs[1] = Tcl_NewWideIntObj((Tcl_WideInt)end);
newPtr = Tcl_NewListObj(2, objs);
} else {
if (ii == TCL_INDEX_NONE) {
TclRegExpRangeUniChar(regExpr, ii, &start, &end);
newPtr = Tcl_GetRange(objPtr, start, end);
} else if (ii > info.nsubs || info.matches[ii].end + 1 <= 1) {
|
| ︙ | ︙ | |||
5665 5666 5667 5668 5669 5670 5671 |
static int
TestbytestringObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
| | | 5666 5667 5668 5669 5670 5671 5672 5673 5674 5675 5676 5677 5678 5679 5680 |
static int
TestbytestringObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
Tcl_Size n = 0;
const char *p;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "bytearray");
return TCL_ERROR;
}
|
| ︙ | ︙ | |||
7832 7833 7834 7835 7836 7837 7838 |
if (refDepth == NULL) {
refDepth = &depth;
}
depth = (refDepth - &depth);
levels[0] = Tcl_NewWideIntObj(depth);
| | | | | 7833 7834 7835 7836 7837 7838 7839 7840 7841 7842 7843 7844 7845 7846 7847 7848 7849 |
if (refDepth == NULL) {
refDepth = &depth;
}
depth = (refDepth - &depth);
levels[0] = Tcl_NewWideIntObj(depth);
levels[1] = Tcl_NewWideIntObj((Tcl_WideInt)iPtr->numLevels);
levels[2] = Tcl_NewWideIntObj((Tcl_WideInt)iPtr->cmdFramePtr->level);
levels[3] = Tcl_NewWideIntObj((Tcl_WideInt)iPtr->varFramePtr->level);
levels[4] = Tcl_NewWideIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr
- iPtr->execEnvPtr->execStackPtr->stackWords);
while (cbPtr) {
i++;
cbPtr = cbPtr->nextPtr;
}
|
| ︙ | ︙ |
Changes to generic/tclTestObj.c.
| ︙ | ︙ | |||
13 14 15 16 17 18 19 20 21 22 23 24 25 26 | * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" #ifdef TCL_WITH_EXTERNAL_TOMMATH # include "tommath.h" #else # include "tclTomMath.h" #endif #include "tclStringRep.h" | > | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #undef BUILD_tcl #include "tclInt.h" #ifdef TCL_WITH_EXTERNAL_TOMMATH # include "tommath.h" #else # include "tclTomMath.h" #endif #include "tclStringRep.h" |
| ︙ | ︙ | |||
588 589 590 591 592 593 594 |
Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
indexRep = (struct IndexRep *)objv[1]->internalRep.twoPtrValue.ptr1;
indexRep->index = index2;
result = Tcl_GetIndexFromObj(NULL, objv[1],
tablePtr, "token", 0, &index);
if (result == TCL_OK) {
| | | 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 |
Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
indexRep = (struct IndexRep *)objv[1]->internalRep.twoPtrValue.ptr1;
indexRep->index = index2;
result = Tcl_GetIndexFromObj(NULL, objv[1],
tablePtr, "token", 0, &index);
if (result == TCL_OK) {
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)index);
}
return result;
}
if (objc < 5) {
Tcl_AppendToObj(Tcl_GetObjResult(interp), "wrong # args", TCL_INDEX_NONE);
return TCL_ERROR;
|
| ︙ | ︙ | |||
616 617 618 619 620 621 622 |
argv[objc-4] = NULL;
result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
argv, "token", TCL_INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
&index);
Tcl_Free((void *)argv);
if (result == TCL_OK) {
| | | 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 |
argv[objc-4] = NULL;
result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
argv, "token", TCL_INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
&index);
Tcl_Free((void *)argv);
if (result == TCL_OK) {
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)index);
}
return result;
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
960 961 962 963 964 965 966 |
return TCL_ERROR;
}
if (Tcl_ListObjLength(interp, varPtr[varIndex], &len) != TCL_OK) {
return TCL_ERROR;
}
for (i = 0; i < len; ++i) {
Tcl_Obj *objP;
| | | 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 |
return TCL_ERROR;
}
if (Tcl_ListObjLength(interp, varPtr[varIndex], &len) != TCL_OK) {
return TCL_ERROR;
}
for (i = 0; i < len; ++i) {
Tcl_Obj *objP;
if (Tcl_ListObjIndex(interp, varPtr[varIndex], (Tcl_Size)i, &objP)
!= TCL_OK) {
return TCL_ERROR;
}
if (objP->refCount <= 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"Tcl_ListObjIndex returned object with ref count <= 0",
TCL_INDEX_NONE));
|
| ︙ | ︙ | |||
1195 1196 1197 1198 1199 1200 1201 |
Tcl_InvalidateStringRep(varPtr[varIndex]);
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
case TESTOBJ_REFCOUNT:
if (objc != 3) {
goto wrongNumArgs;
}
| | | 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 |
Tcl_InvalidateStringRep(varPtr[varIndex]);
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
case TESTOBJ_REFCOUNT:
if (objc != 3) {
goto wrongNumArgs;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)varPtr[varIndex]->refCount);
break;
case TESTOBJ_TYPE:
if (objc != 3) {
goto wrongNumArgs;
}
if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", TCL_INDEX_NONE);
|
| ︙ | ︙ | |||
1362 1363 1364 1365 1366 1367 1368 |
Tcl_ConvertToType(NULL, varPtr[varIndex],
Tcl_GetObjType("string"));
strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
length = strPtr->allocated;
} else {
length = TCL_INDEX_NONE;
}
| | | 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 |
Tcl_ConvertToType(NULL, varPtr[varIndex],
Tcl_GetObjType("string"));
strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
length = strPtr->allocated;
} else {
length = TCL_INDEX_NONE;
}
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)length);
break;
case 6: /* set */
if (objc != 4) {
goto wrongNumArgs;
}
/*
|
| ︙ | ︙ | |||
1416 1417 1418 1419 1420 1421 1422 |
Tcl_ConvertToType(NULL, varPtr[varIndex],
Tcl_GetObjType("string"));
strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
length = strPtr->maxChars;
} else {
length = TCL_INDEX_NONE;
}
| | | 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 |
Tcl_ConvertToType(NULL, varPtr[varIndex],
Tcl_GetObjType("string"));
strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
length = strPtr->maxChars;
} else {
length = TCL_INDEX_NONE;
}
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (Tcl_WideInt)length);
break;
case 10: { /* range */
Tcl_Size first, last;
if (objc != 5) {
goto wrongNumArgs;
}
if ((Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK)
|
| ︙ | ︙ |
Changes to generic/tclThread.c.
| ︙ | ︙ | |||
57 58 59 60 61 62 63 |
*
*----------------------------------------------------------------------
*/
void *
Tcl_GetThreadData(
Tcl_ThreadDataKey *keyPtr, /* Identifier for the data chunk */
| | | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 |
*
*----------------------------------------------------------------------
*/
void *
Tcl_GetThreadData(
Tcl_ThreadDataKey *keyPtr, /* Identifier for the data chunk */
Tcl_Size size) /* Size of storage block */
{
void *result;
#if TCL_THREADS
/*
* Initialize the key for this thread.
*/
|
| ︙ | ︙ |
Changes to generic/tclThreadAlloc.c.
| ︙ | ︙ | |||
53 54 55 56 57 58 59 |
struct {
unsigned char magic1; /* First magic number. */
unsigned char bucket; /* Bucket block allocated from. */
unsigned char unused; /* Padding. */
unsigned char magic2; /* Second magic number. */
} s;
} u;
| | | 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 |
struct {
unsigned char magic1; /* First magic number. */
unsigned char bucket; /* Bucket block allocated from. */
unsigned char unused; /* Padding. */
unsigned char magic2; /* Second magic number. */
} s;
} u;
TCL_HASH_TYPE reqSize; /* Requested allocation size. */
} b;
unsigned char padding[TCL_ALLOCALIGN];
} Block;
#define nextBlock b.u.next
#define sourceBucket b.u.s.bucket
#define magicNum1 b.u.s.magic1
#define magicNum2 b.u.s.magic2
|
| ︙ | ︙ | |||
296 297 298 299 300 301 302 | * May allocate more blocks for a bucket. * *---------------------------------------------------------------------- */ void * TclpAlloc( | | | 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 |
* May allocate more blocks for a bucket.
*
*----------------------------------------------------------------------
*/
void *
TclpAlloc(
TCL_HASH_TYPE reqSize)
{
Cache *cachePtr;
Block *blockPtr;
int bucket;
size_t size;
GETCACHE(cachePtr);
|
| ︙ | ︙ | |||
420 421 422 423 424 425 426 |
*
*----------------------------------------------------------------------
*/
void *
TclpRealloc(
void *ptr,
| | | 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 |
*
*----------------------------------------------------------------------
*/
void *
TclpRealloc(
void *ptr,
TCL_HASH_TYPE reqSize)
{
Cache *cachePtr;
Block *blockPtr;
void *newPtr;
size_t size, min;
int bucket;
|
| ︙ | ︙ |
Changes to generic/tclThreadTest.c.
| ︙ | ︙ | |||
12 13 14 15 16 17 18 19 20 21 22 23 24 25 | * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" #if TCL_THREADS /* * Each thread has an single instance of the following structure. There is one * instance of this structure per thread even if that thread contains multiple * interpreters. The interpreter identified by this structure is the main | > | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #undef BUILD_tcl #include "tclInt.h" #if TCL_THREADS /* * Each thread has an single instance of the following structure. There is one * instance of this structure per thread even if that thread contains multiple * interpreters. The interpreter identified by this structure is the main |
| ︙ | ︙ |
Changes to generic/tclUtf.c.
| ︙ | ︙ | |||
201 202 203 204 205 206 207 | * Side effects: * None. * *--------------------------------------------------------------------------- */ #undef Tcl_UniCharToUtf | | | 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 |
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
#undef Tcl_UniCharToUtf
Tcl_Size
Tcl_UniCharToUtf(
int ch, /* The Tcl_UniChar to be stored in the
* buffer. Can be or'ed with flag TCL_COMBINE
*/
char *buf) /* Buffer in which the UTF-8 representation of
* ch is stored. Must be large enough to hold the UTF-8
* character (at most 4 bytes).
|
| ︙ | ︙ | |||
314 315 316 317 318 319 320 |
*---------------------------------------------------------------------------
*/
#undef Tcl_UniCharToUtfDString
char *
Tcl_UniCharToUtfDString(
const int *uniStr, /* Unicode string to convert to UTF-8. */
| | | | 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 |
*---------------------------------------------------------------------------
*/
#undef Tcl_UniCharToUtfDString
char *
Tcl_UniCharToUtfDString(
const int *uniStr, /* Unicode string to convert to UTF-8. */
Tcl_Size uniLength, /* Length of Unicode string. */
Tcl_DString *dsPtr) /* UTF-8 representation of string is appended
* to this previously initialized DString. */
{
const int *w, *wEnd;
char *p, *string;
size_t oldLength;
/*
* UTF-8 string length in bytes will be <= Unicode string length * 4.
*/
if (uniStr == NULL) {
return NULL;
}
if (TCL_SIZE_ISNEG(uniLength)) {
uniLength = 0;
w = uniStr;
while (*w != '\0') {
uniLength++;
w++;
}
}
|
| ︙ | ︙ | |||
355 356 357 358 359 360 361 |
return string;
}
char *
Tcl_Char16ToUtfDString(
const unsigned short *uniStr,/* Utf-16 string to convert to UTF-8. */
| | | | | 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 |
return string;
}
char *
Tcl_Char16ToUtfDString(
const unsigned short *uniStr,/* Utf-16 string to convert to UTF-8. */
Tcl_Size uniLength, /* Length of Utf-16 string. */
Tcl_DString *dsPtr) /* UTF-8 representation of string is appended
* to this previously initialized DString. */
{
const unsigned short *w, *wEnd;
char *p, *string;
Tcl_Size oldLength;
int len = 1;
/*
* UTF-8 string length in bytes will be <= Utf16 string length * 3.
*/
if (uniStr == NULL) {
return NULL;
}
if (TCL_SIZE_ISNEG(uniLength)) {
uniLength = 0;
w = uniStr;
while (*w != '\0') {
uniLength++;
w++;
}
|
| ︙ | ︙ | |||
449 450 451 452 453 454 455 |
0x20AC, 0x81, 0x201A, 0x0192, 0x201E, 0x2026, 0x2020, 0x2021,
0x02C6, 0x2030, 0x0160, 0x2039, 0x0152, 0x8D, 0x017D, 0x8F,
0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014,
0x2DC, 0x2122, 0x0161, 0x203A, 0x0153, 0x9D, 0x017E, 0x0178
};
#undef Tcl_UtfToUniChar
| | | 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 |
0x20AC, 0x81, 0x201A, 0x0192, 0x201E, 0x2026, 0x2020, 0x2021,
0x02C6, 0x2030, 0x0160, 0x2039, 0x0152, 0x8D, 0x017D, 0x8F,
0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014,
0x2DC, 0x2122, 0x0161, 0x203A, 0x0153, 0x9D, 0x017E, 0x0178
};
#undef Tcl_UtfToUniChar
Tcl_Size
Tcl_UtfToUniChar(
const char *src, /* The UTF-8 string. */
int *chPtr)/* Filled with the Unicode character represented by
* the UTF-8 string. */
{
int byte;
|
| ︙ | ︙ | |||
532 533 534 535 536 537 538 |
*/
}
*chPtr = byte;
return 1;
}
| | | 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 |
*/
}
*chPtr = byte;
return 1;
}
Tcl_Size
Tcl_UtfToChar16(
const char *src, /* The UTF-8 string. */
unsigned short *chPtr)/* Filled with the Tcl_UniChar represented by
* the UTF-8 string. This could be a surrogate too. */
{
unsigned short byte;
|
| ︙ | ︙ | |||
653 654 655 656 657 658 659 |
*---------------------------------------------------------------------------
*/
#undef Tcl_UtfToUniCharDString
int *
Tcl_UtfToUniCharDString(
const char *src, /* UTF-8 string to convert to Unicode. */
| | | | | 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 |
*---------------------------------------------------------------------------
*/
#undef Tcl_UtfToUniCharDString
int *
Tcl_UtfToUniCharDString(
const char *src, /* UTF-8 string to convert to Unicode. */
Tcl_Size length, /* Length of UTF-8 string in bytes, or -1 for
* strlen(). */
Tcl_DString *dsPtr) /* Unicode representation of string is
* appended to this previously initialized
* DString. */
{
int ch = 0, *w, *wString;
const char *p;
Tcl_Size oldLength;
/* Pointer to the end of string. Never read endPtr[0] */
const char *endPtr = src + length;
/* Pointer to last byte where optimization still can be used */
const char *optPtr = endPtr - TCL_UTF_MAX;
if (src == NULL) {
return NULL;
}
if (TCL_SIZE_ISNEG(length)) {
length = strlen(src);
}
/*
* Unicode string length in Tcl_UniChars will be <= UTF-8 string length in
* bytes.
*/
|
| ︙ | ︙ | |||
710 711 712 713 714 715 716 |
return wString;
}
unsigned short *
Tcl_UtfToChar16DString(
const char *src, /* UTF-8 string to convert to Unicode. */
| | | | | 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 |
return wString;
}
unsigned short *
Tcl_UtfToChar16DString(
const char *src, /* UTF-8 string to convert to Unicode. */
Tcl_Size length, /* Length of UTF-8 string in bytes, or -1 for
* strlen(). */
Tcl_DString *dsPtr) /* Unicode representation of string is
* appended to this previously initialized
* DString. */
{
unsigned short ch = 0, *w, *wString;
const char *p;
Tcl_Size oldLength;
/* Pointer to the end of string. Never read endPtr[0] */
const char *endPtr = src + length;
/* Pointer to last byte where optimization still can be used */
const char *optPtr = endPtr - TCL_UTF_MAX;
if (src == NULL) {
return NULL;
}
if (TCL_SIZE_ISNEG(length)) {
length = strlen(src);
}
/*
* Unicode string length in WCHARs will be <= UTF-8 string length in
* bytes.
*/
|
| ︙ | ︙ | |||
788 789 790 791 792 793 794 |
*---------------------------------------------------------------------------
*/
int
Tcl_UtfCharComplete(
const char *src, /* String to check if first few bytes contain
* a complete UTF-8 character. */
| | | 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 |
*---------------------------------------------------------------------------
*/
int
Tcl_UtfCharComplete(
const char *src, /* String to check if first few bytes contain
* a complete UTF-8 character. */
Tcl_Size length) /* Length of above string in bytes. */
{
return length >= complete[UCHAR(*src)];
}
/*
*---------------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
811 812 813 814 815 816 817 | * * Side effects: * None. * *--------------------------------------------------------------------------- */ | | | | | | 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 |
*
* Side effects:
* None.
*
*---------------------------------------------------------------------------
*/
Tcl_Size
Tcl_NumUtfChars(
const char *src, /* The UTF-8 string to measure. */
Tcl_Size length) /* The length of the string in bytes, or
* TCL_INDEX_NONE for strlen(src). */
{
Tcl_UniChar ch = 0;
Tcl_Size i = 0;
if (TCL_SIZE_ISNEG(length)) {
/* string is NUL-terminated, so TclUtfToUniChar calls are safe. */
while (*src != '\0') {
src += TclUtfToUniChar(src, &ch);
i++;
}
} else {
/* Will return value between 0 and length. No overflow checks. */
|
| ︙ | ︙ | |||
863 864 865 866 867 868 869 |
}
i++;
}
}
return i;
}
| | | | | | 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 |
}
i++;
}
}
return i;
}
Tcl_Size
TclNumUtfChars(
const char *src, /* The UTF-8 string to measure. */
Tcl_Size length) /* The length of the string in bytes, or
* TCL_INDEX_NONE for strlen(src). */
{
unsigned short ch = 0;
Tcl_Size i = 0;
if (TCL_SIZE_ISNEG(length)) {
/* string is NUL-terminated, so TclUtfToUniChar calls are safe. */
while (*src != '\0') {
src += Tcl_UtfToChar16(src, &ch);
i++;
}
} else {
/* Will return value between 0 and length. No overflow checks. */
|
| ︙ | ︙ | |||
1190 1191 1192 1193 1194 1195 1196 |
*
*---------------------------------------------------------------------------
*/
int
Tcl_UniCharAtIndex(
const char *src, /* The UTF-8 string to dereference. */
| | | | 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 |
*
*---------------------------------------------------------------------------
*/
int
Tcl_UniCharAtIndex(
const char *src, /* The UTF-8 string to dereference. */
Tcl_Size index) /* The position of the desired character. */
{
Tcl_UniChar ch = 0;
int i = 0;
if (TCL_SIZE_ISNEG(index)) {
return -1;
}
while (index--) {
i = TclUtfToUniChar(src, &ch);
src += i;
}
#if TCL_UTF_MAX < 4
|
| ︙ | ︙ | |||
1234 1235 1236 1237 1238 1239 1240 |
*
*---------------------------------------------------------------------------
*/
const char *
Tcl_UtfAtIndex(
const char *src, /* The UTF-8 string. */
| | | | | | | 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 |
*
*---------------------------------------------------------------------------
*/
const char *
Tcl_UtfAtIndex(
const char *src, /* The UTF-8 string. */
Tcl_Size index) /* The position of the desired character. */
{
int ch = 0;
if (!TCL_SIZE_ISNEG(index)) {
while (index--) {
/* Make use of the #undef Tcl_UtfToUniChar above, which already handles UCS4. */
src += Tcl_UtfToUniChar(src, &ch);
}
}
return src;
}
const char *
TclUtfAtIndex(
const char *src, /* The UTF-8 string. */
Tcl_Size index) /* The position of the desired character. */
{
unsigned short ch = 0;
Tcl_Size len = 0;
if (!TCL_SIZE_ISNEG(index)) {
while (index--) {
src += (len = Tcl_UtfToChar16(src, &ch));
}
if ((ch >= 0xD800) && (len < 3)) {
/* Index points at character following high Surrogate */
src += Tcl_UtfToChar16(src, &ch);
}
|
| ︙ | ︙ | |||
1293 1294 1295 1296 1297 1298 1299 | * that represent the Unicode character is at least as large as the * source buffer from which the backslashed sequence was extracted, no * buffer overruns should occur. * *--------------------------------------------------------------------------- */ | | | 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 |
* that represent the Unicode character is at least as large as the
* source buffer from which the backslashed sequence was extracted, no
* buffer overruns should occur.
*
*---------------------------------------------------------------------------
*/
Tcl_Size
Tcl_UtfBackslash(
const char *src, /* Points to the backslash character of a
* backslash sequence. */
int *readPtr, /* Fill in with number of characters read from
* src, unless NULL. */
char *dst) /* Filled with the bytes represented by the
* backslash sequence. */
|
| ︙ | ︙ | |||
1337 1338 1339 1340 1341 1342 1343 | * * Side effects: * Writes a terminating null after the last converted character. * *---------------------------------------------------------------------- */ | | | | 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 |
*
* Side effects:
* Writes a terminating null after the last converted character.
*
*----------------------------------------------------------------------
*/
Tcl_Size
Tcl_UtfToUpper(
char *str) /* String to convert in place. */
{
int ch, upChar;
char *src, *dst;
Tcl_Size len;
/*
* Iterate over the string until we hit the terminating null.
*/
src = dst = str;
while (*src) {
|
| ︙ | ︙ | |||
1390 1391 1392 1393 1394 1395 1396 | * * Side effects: * Writes a terminating null after the last converted character. * *---------------------------------------------------------------------- */ | | | | 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 |
*
* Side effects:
* Writes a terminating null after the last converted character.
*
*----------------------------------------------------------------------
*/
Tcl_Size
Tcl_UtfToLower(
char *str) /* String to convert in place. */
{
int ch, lowChar;
char *src, *dst;
Tcl_Size len;
/*
* Iterate over the string until we hit the terminating null.
*/
src = dst = str;
while (*src) {
|
| ︙ | ︙ | |||
1444 1445 1446 1447 1448 1449 1450 | * * Side effects: * Writes a terminating null after the last converted character. * *---------------------------------------------------------------------- */ | | | | 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 |
*
* Side effects:
* Writes a terminating null after the last converted character.
*
*----------------------------------------------------------------------
*/
Tcl_Size
Tcl_UtfToTitle(
char *str) /* String to convert in place. */
{
int ch, titleChar, lowChar;
char *src, *dst;
Tcl_Size len;
/*
* Capitalize the first character and then lowercase the rest of the
* characters until we get to a null.
*/
src = dst = str;
|
| ︙ | ︙ | |||
1866 1867 1868 1869 1870 1871 1872 | * * Side effects: * None. * *---------------------------------------------------------------------- */ | | | | 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 |
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_Size
Tcl_Char16Len(
const unsigned short *uniStr) /* Unicode string to find length of. */
{
Tcl_Size len = 0;
while (*uniStr != '\0') {
len++;
uniStr++;
}
return len;
}
|
| ︙ | ︙ | |||
1897 1898 1899 1900 1901 1902 1903 | * Side effects: * None. * *---------------------------------------------------------------------- */ #undef Tcl_UniCharLen | | | | 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 |
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
#undef Tcl_UniCharLen
Tcl_Size
Tcl_UniCharLen(
const int *uniStr) /* Unicode string to find length of. */
{
Tcl_Size len = 0;
while (*uniStr != '\0') {
len++;
uniStr++;
}
return len;
}
|
| ︙ | ︙ | |||
2559 2560 2561 2562 2563 2564 2565 |
*
*----------------------------------------------------------------------
*/
int
TclUniCharMatch(
const Tcl_UniChar *string, /* Unicode String. */
| | | | 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 |
*
*----------------------------------------------------------------------
*/
int
TclUniCharMatch(
const Tcl_UniChar *string, /* Unicode String. */
Tcl_Size strLen, /* Length of String */
const Tcl_UniChar *pattern, /* Pattern, which may contain special
* characters. */
Tcl_Size ptnLen, /* Length of Pattern */
int nocase) /* 0 for case sensitive, 1 for insensitive */
{
const Tcl_UniChar *stringEnd, *patternEnd;
Tcl_UniChar p;
stringEnd = string + strLen;
patternEnd = pattern + ptnLen;
|
| ︙ | ︙ |
Changes to generic/tclUtil.c.
| ︙ | ︙ | |||
398 399 400 401 402 403 404 |
TclMaxListLength(
const char *bytes,
Tcl_Size numBytes,
const char **endPtr)
{
Tcl_Size count = 0;
| | | | | | | 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 |
TclMaxListLength(
const char *bytes,
Tcl_Size numBytes,
const char **endPtr)
{
Tcl_Size count = 0;
if ((numBytes == 0) || (TCL_SIZE_ISNEG(numBytes) && (*bytes == '\0'))) {
/* Empty string case - quick exit */
goto done;
}
/*
* No list element before leading white space.
*/
count += 1 - TclIsSpaceProcM(*bytes);
/*
* Count white space runs as potential element separators.
*/
while (numBytes) {
if (TCL_SIZE_ISNEG(numBytes) && (*bytes == '\0')) {
break;
}
if (TclIsSpaceProcM(*bytes)) {
/*
* Space run started; bump count.
*/
count++;
do {
bytes++;
numBytes -= !TCL_SIZE_ISNEG(numBytes);
} while (numBytes && TclIsSpaceProcM(*bytes));
if ((numBytes == 0) || (TCL_SIZE_ISNEG(numBytes) && (*bytes == '\0'))) {
break;
}
/*
* (*bytes) is non-space; return to counting state.
*/
}
bytes++;
numBytes -= !TCL_SIZE_ISNEG(numBytes);
}
/*
* No list element following trailing white space.
*/
count -= TclIsSpaceProcM(bytes[-1]);
|
| ︙ | ︙ | |||
1033 1034 1035 1036 1037 1038 1039 |
int forbidNone = 0; /* Do not permit CONVERT_NONE mode. Something
* needs protection or escape. */
int requireEscape = 0; /* Force use of CONVERT_ESCAPE mode. For some
* reason bare or brace-quoted form fails. */
int extra = 0; /* Count of number of extra bytes needed for
* formatted element, assuming we use escape
* sequences in formatting. */
| | | | 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 |
int forbidNone = 0; /* Do not permit CONVERT_NONE mode. Something
* needs protection or escape. */
int requireEscape = 0; /* Force use of CONVERT_ESCAPE mode. For some
* reason bare or brace-quoted form fails. */
int extra = 0; /* Count of number of extra bytes needed for
* formatted element, assuming we use escape
* sequences in formatting. */
Tcl_Size bytesNeeded; /* Buffer length computed to complete the
* element formatting in the selected mode. */
#if COMPAT
int preferEscape = 0; /* Use preferences to track whether to use */
int preferBrace = 0; /* CONVERT_MASK mode. */
int braceCount = 0; /* Count of all braces '{' '}' seen. */
#endif /* COMPAT */
if ((p == NULL) || (length == 0) || ((*p == '\0') && TCL_SIZE_ISNEG(length))) {
/*
* Empty string element must be brace quoted.
*/
*flagPtr = CONVERT_BRACE;
return 2;
}
|
| ︙ | ︙ | |||
1123 1124 1125 1126 1127 1128 1129 | extra++; /* Escape sequences all one byte longer. */ #if COMPAT preferBrace = 1; #endif /* COMPAT */ break; case '\\': /* TYPE_SUBS */ extra++; /* Escape '\' => '\\' */ | | | 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 |
extra++; /* Escape sequences all one byte longer. */
#if COMPAT
preferBrace = 1;
#endif /* COMPAT */
break;
case '\\': /* TYPE_SUBS */
extra++; /* Escape '\' => '\\' */
if ((length == 1) || (TCL_SIZE_ISNEG(length) && (p[1] == '\0'))) {
/*
* Final backslash. Cannot format with brace quoting.
*/
requireEscape = 1;
break;
}
|
| ︙ | ︙ | |||
1154 1155 1156 1157 1158 1159 1160 | } forbidNone = 1; #if COMPAT preferBrace = 1; #endif /* COMPAT */ break; case '\0': /* TYPE_SUBS */ | | | 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 |
}
forbidNone = 1;
#if COMPAT
preferBrace = 1;
#endif /* COMPAT */
break;
case '\0': /* TYPE_SUBS */
if (TCL_SIZE_ISNEG(length)) {
goto endOfString;
}
/* TODO: Panic on improper encoding? */
break;
default:
if (TclIsSpaceProcM(*p)) {
forbidNone = 1;
|
| ︙ | ︙ | |||
1403 1404 1405 1406 1407 1408 1409 |
conversion = CONVERT_ESCAPE;
}
/*
* No matter what the caller demands, empty string must be braced!
*/
| | | 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 |
conversion = CONVERT_ESCAPE;
}
/*
* No matter what the caller demands, empty string must be braced!
*/
if ((src == NULL) || (length == 0) || (*src == '\0' && TCL_SIZE_ISNEG(length))) {
p[0] = '{';
p[1] = '}';
return 2;
}
/*
* Escape leading hash as needed and requested.
|
| ︙ | ︙ | |||
1430 1431 1432 1433 1434 1435 1436 |
}
/*
* No escape or quoting needed. Copy the literal string value.
*/
if (conversion == CONVERT_NONE) {
| | | | 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 |
}
/*
* No escape or quoting needed. Copy the literal string value.
*/
if (conversion == CONVERT_NONE) {
if (TCL_SIZE_ISNEG(length)) {
/* TODO: INT_MAX overflow? */
while (*src) {
*p++ = *src++;
}
return p - dst;
} else {
memcpy(dst, src, length);
return length;
}
}
/*
* Formatted string is original string enclosed in braces.
*/
if (conversion == CONVERT_BRACE) {
*p = '{';
p++;
if (TCL_SIZE_ISNEG(length)) {
/* TODO: INT_MAX overflow? */
while (*src) {
*p++ = *src++;
}
} else {
memcpy(p, src, length);
p += length;
|
| ︙ | ︙ | |||
1522 1523 1524 1525 1526 1527 1528 | case '\v': *p = '\\'; p++; *p = 'v'; p++; continue; case '\0': | | | 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 |
case '\v':
*p = '\\';
p++;
*p = 'v';
p++;
continue;
case '\0':
if (TCL_SIZE_ISNEG(length)) {
return (Tcl_Size)(p - dst);
}
/*
* If we reach this point, there's an embedded NULL in the string
* range being processed, which should not happen when the
* encoding rules for Tcl strings are properly followed. If the
|
| ︙ | ︙ | |||
2580 2581 2582 2583 2584 2585 2586 |
* TCL_INDEX_NONE then this must be null-terminated. */
Tcl_Size length) /* Number of bytes from "bytes" to append. If
* TCL_INDEX_NONE, then append all of bytes, up to null
* at end. */
{
Tcl_Size newSize;
| | | 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 |
* TCL_INDEX_NONE then this must be null-terminated. */
Tcl_Size length) /* Number of bytes from "bytes" to append. If
* TCL_INDEX_NONE, then append all of bytes, up to null
* at end. */
{
Tcl_Size newSize;
if (TCL_SIZE_ISNEG(length)) {
length = strlen(bytes);
}
newSize = length + dsPtr->length;
/*
* Allocate a larger buffer for the string if the current one isn't large
* enough. Allocate extra space in the new buffer so that there will be
|
| ︙ | ︙ | |||
2609 2610 2611 2612 2613 2614 2615 |
if (bytes >= dsPtr->string
&& bytes <= dsPtr->string + dsPtr->length) {
index = bytes - dsPtr->string;
}
dsPtr->string = (char *)Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);
| | | 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 |
if (bytes >= dsPtr->string
&& bytes <= dsPtr->string + dsPtr->length) {
index = bytes - dsPtr->string;
}
dsPtr->string = (char *)Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);
if (!TCL_SIZE_ISNEG(index)) {
bytes = dsPtr->string + index;
}
}
}
/*
* Copy the new string into the buffer at the end of the old one.
|
| ︙ | ︙ |
Changes to generic/tclVar.c.
| ︙ | ︙ | |||
607 608 609 610 611 612 613 |
size_t localIndex;
Tcl_Obj *namePtr, *arrayPtr, *elem;
*arrayPtrPtr = NULL;
restart:
LocalGetInternalRep(part1Ptr, localIndex, namePtr);
| | | 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 |
size_t localIndex;
Tcl_Obj *namePtr, *arrayPtr, *elem;
*arrayPtrPtr = NULL;
restart:
LocalGetInternalRep(part1Ptr, localIndex, namePtr);
if (!TCL_SIZE_ISNEG(localIndex)) {
if (HasLocalVars(varFramePtr)
&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
&& (localIndex < varFramePtr->numCompiledLocals)) {
/*
* Use the cached index if the names coincide.
*/
|
| ︙ | ︙ |
Changes to generic/tclZipfs.c.
| ︙ | ︙ | |||
1378 1379 1380 1381 1382 1383 1384 |
} else {
/*
* Not an OS file, but rather something in a Tcl VFS. Must copy into
* memory.
*/
zf->length = Tcl_Seek(zf->chan, 0, SEEK_END);
| | | 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 |
} else {
/*
* Not an OS file, but rather something in a Tcl VFS. Must copy into
* memory.
*/
zf->length = Tcl_Seek(zf->chan, 0, SEEK_END);
if (TCL_SIZE_ISNEG(zf->length)) {
ZIPFS_POSIX_ERROR(interp, "seek error");
goto error;
}
if ((zf->length - ZIP_CENTRAL_END_LEN)
> (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) {
ZIPFS_ERROR(interp, "illegal file size");
ZIPFS_ERROR_CODE(interp, "FILE_SIZE");
|
| ︙ | ︙ | |||
1477 1478 1479 1480 1481 1482 1483 |
int fd = PTR2INT(handle);
/*
* Determine the file size.
*/
zf->length = lseek(fd, 0, SEEK_END);
| | | 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 |
int fd = PTR2INT(handle);
/*
* Determine the file size.
*/
zf->length = lseek(fd, 0, SEEK_END);
if (TCL_SIZE_ISNEG(zf->length) || zf->length < ZIP_CENTRAL_END_LEN) {
ZIPFS_POSIX_ERROR(interp, "invalid file size");
return TCL_ERROR;
}
lseek(fd, 0, SEEK_SET);
zf->data = (unsigned char *)
mmap(0, zf->length, PROT_READ, MAP_FILE | MAP_PRIVATE, fd, 0);
|
| ︙ | ︙ | |||
2574 2575 2576 2577 2578 2579 2580 |
* Compute the CRC.
*/
crc = 0;
nbyte = nbytecompr = 0;
while (1) {
len = Tcl_Read(in, buf, bufsize);
| | | 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 |
* Compute the CRC.
*/
crc = 0;
nbyte = nbytecompr = 0;
while (1) {
len = Tcl_Read(in, buf, bufsize);
if (TCL_SIZE_ISNEG(len)) {
Tcl_DStringFree(&zpathDs);
if (nbyte == 0 && errno == EISDIR) {
Tcl_Close(interp, in);
return TCL_OK;
}
readErrorWithChannelOpen:
Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s",
|
| ︙ | ︙ | |||
2704 2705 2706 2707 2708 2709 2710 |
Tcl_Close(interp, in);
Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
do {
len = Tcl_Read(in, buf, bufsize);
| | | 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 |
Tcl_Close(interp, in);
Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
do {
len = Tcl_Read(in, buf, bufsize);
if (TCL_SIZE_ISNEG(len)) {
deflateEnd(&stream);
goto readErrorWithChannelOpen;
}
stream.avail_in = len;
stream.next_in = (unsigned char *) buf;
flush = Tcl_Eof(in) ? Z_FINISH : Z_NO_FLUSH;
do {
|
| ︙ | ︙ | |||
2768 2769 2770 2771 2772 2773 2774 |
Tcl_Close(interp, in);
Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
nbytecompr = (passwd ? 12 : 0);
while (1) {
len = Tcl_Read(in, buf, bufsize);
| | | 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 |
Tcl_Close(interp, in);
Tcl_DStringFree(&zpathDs);
return TCL_ERROR;
}
nbytecompr = (passwd ? 12 : 0);
while (1) {
len = Tcl_Read(in, buf, bufsize);
if (TCL_SIZE_ISNEG(len)) {
goto readErrorWithChannelOpen;
} else if (len == 0) {
break;
}
if (passwd) {
size_t i;
int tmp;
|
| ︙ | ︙ | |||
3294 3295 3296 3297 3298 3299 3300 |
}
/*
* Get the length of the file (and exclude non-files).
*/
i = Tcl_Seek(in, 0, SEEK_END);
| | | 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 |
}
/*
* Get the length of the file (and exclude non-files).
*/
i = Tcl_Seek(in, 0, SEEK_END);
if (TCL_SIZE_ISNEG(i)) {
errMsg = "seek error";
goto copyError;
}
Tcl_Seek(in, 0, SEEK_SET);
/*
* Copy the whole file, 8 blocks at a time (reasonably efficient). Note
|
| ︙ | ︙ |
Changes to generic/tclZlib.c.
| ︙ | ︙ | |||
1355 1356 1357 1358 1359 1360 1361 |
*----------------------------------------------------------------------
*/
int
Tcl_ZlibStreamGet(
Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */
Tcl_Obj *data, /* A place to append the data. */
| | | | | | 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 |
*----------------------------------------------------------------------
*/
int
Tcl_ZlibStreamGet(
Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */
Tcl_Obj *data, /* A place to append the data. */
Tcl_Size count) /* Number of bytes to grab as a maximum, you
* may get less! */
{
ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
int e;
Tcl_Size listLen, i, itemLen = 0, dataPos = 0;
Tcl_Obj *itemObj;
unsigned char *dataPtr, *itemPtr;
Tcl_Size existing = 0;
/*
* Getting beyond the of stream, just return empty string.
*/
if (zshPtr->streamEnd) {
return TCL_OK;
}
if (NULL == Tcl_GetBytesFromObj(zshPtr->interp, data, &existing)) {
return TCL_ERROR;
}
if (zshPtr->mode == TCL_ZLIB_STREAM_INFLATE) {
if (TCL_SIZE_ISNEG(count)) {
/*
* The only safe thing to do is restict to 65k. We might cause a
* panic for out of memory if we just kept growing the buffer.
*/
count = MAX_BUFFER_SIZE;
}
|
| ︙ | ︙ | |||
1535 1536 1537 1538 1539 1540 1541 |
Tcl_DecrRefCount(zshPtr->currentInput);
zshPtr->currentInput = 0;
}
inflateEnd(&zshPtr->stream);
}
} else {
TclListObjLengthM(NULL, zshPtr->outData, &listLen);
| | | 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 |
Tcl_DecrRefCount(zshPtr->currentInput);
zshPtr->currentInput = 0;
}
inflateEnd(&zshPtr->stream);
}
} else {
TclListObjLengthM(NULL, zshPtr->outData, &listLen);
if (TCL_SIZE_ISNEG(count)) {
count = 0;
for (i=0; i<listLen; i++) {
Tcl_ListObjIndex(NULL, zshPtr->outData, i, &itemObj);
(void) Tcl_GetByteArrayFromObj(itemObj, &itemLen);
if (i == 0) {
count += itemLen - zshPtr->outPos;
} else {
|
| ︙ | ︙ | |||
1763 1764 1765 1766 1767 1768 1769 |
*/
int
Tcl_ZlibInflate(
Tcl_Interp *interp,
int format,
Tcl_Obj *data,
| | | 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 |
*/
int
Tcl_ZlibInflate(
Tcl_Interp *interp,
int format,
Tcl_Obj *data,
Tcl_Size bufferSize,
Tcl_Obj *gzipHeaderDictObj)
{
int wbits = 0, e = 0;
size_t inLen = 0, newBufferSize;
Byte *inData = NULL, *outData = NULL, *newOutData = NULL;
z_stream stream;
gz_header header, *headerPtr = NULL;
|
| ︙ | ︙ | |||
1952 1953 1954 1955 1956 1957 1958 |
*----------------------------------------------------------------------
*/
unsigned int
Tcl_ZlibCRC32(
unsigned int crc,
const unsigned char *buf,
| | | | 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 |
*----------------------------------------------------------------------
*/
unsigned int
Tcl_ZlibCRC32(
unsigned int crc,
const unsigned char *buf,
Tcl_Size len)
{
/* Nothing much to do, just wrap the crc32(). */
return crc32(crc, (Bytef *) buf, len);
}
unsigned int
Tcl_ZlibAdler32(
unsigned int adler,
const unsigned char *buf,
Tcl_Size len)
{
return adler32(adler, (Bytef *) buf, len);
}
/*
*----------------------------------------------------------------------
*
|
| ︙ | ︙ | |||
4077 4078 4079 4080 4081 4082 4083 |
return TCL_OK;
}
int
Tcl_ZlibStreamGet(
Tcl_ZlibStream zshandle,
Tcl_Obj *data,
| | | 4077 4078 4079 4080 4081 4082 4083 4084 4085 4086 4087 4088 4089 4090 4091 |
return TCL_OK;
}
int
Tcl_ZlibStreamGet(
Tcl_ZlibStream zshandle,
Tcl_Obj *data,
Tcl_Size count)
{
return TCL_OK;
}
int
Tcl_ZlibDeflate(
Tcl_Interp *interp,
|
| ︙ | ︙ |
Changes to tests/stringObj.test.
| ︙ | ︙ | |||
20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint testobj [llength [info commands testobj]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testdstring [llength [info commands testdstring]]
testConstraint utf32 [expr {[string length \U010000] == 1}]
test stringObj-1.1 {string type registration} testobj {
set t [testobj types]
set first [string first "string" $t]
set result [expr {$first >= 0}]
} 1
| > | 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 |
::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint testobj [llength [info commands testobj]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testdstring [llength [info commands testdstring]]
testConstraint utf32 [expr {[string length \U010000] == 1}]
testConstraint pointerIs32bit [expr {$tcl_platform(pointerSize) == 4}]
test stringObj-1.1 {string type registration} testobj {
set t [testobj types]
set first [string first "string" $t]
set result [expr {$first >= 0}]
} 1
|
| ︙ | ︙ | |||
500 501 502 503 504 505 506 |
teststringobj set 1 abcde
teststringobj range 1 2 0
} {}
test stringObj-16.7 {Tcl_GetRange: first = UINT_MAX-1} testobj {
teststringobj set 1 abcde
teststringobj range 1 0xFFFFFFFE 3
} {}
| | | | | 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 |
teststringobj set 1 abcde
teststringobj range 1 2 0
} {}
test stringObj-16.7 {Tcl_GetRange: first = UINT_MAX-1} testobj {
teststringobj set 1 abcde
teststringobj range 1 0xFFFFFFFE 3
} {}
test stringObj-16.8 {Tcl_GetRange: first = -2} {testobj pointerIs32bit} {
teststringobj set 1 abcde
teststringobj range 1 -2 3
} {}
test stringObj-16.9 {Tcl_GetRange: last = UINT_MAX-1} testobj {
teststringobj set 1 abcde
teststringobj range 1 1 0xFFFFFFFE
} bcde
test stringObj-16.10 {Tcl_GetRange: last = SIZE_MAX-1} testobj {
teststringobj set 1 abcde
teststringobj range 1 1 -2
} bcde
test stringObj-16.11 {Tcl_GetRange: first = last = UINT_MAX-1} testobj {
teststringobj set 1 abcde
teststringobj range 1 0xFFFFFFFE 0xFFFFFFFE
} {}
test stringObj-16.12 {Tcl_GetRange: first = last = SIZE_MAX-1} {testobj pointerIs32bit} {
teststringobj set 1 abcde
teststringobj range 1 -2 -2
} {}
if {[testConstraint testobj]} {
testobj freeallvars
}
# cleanup
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# End:
|
Changes to unix/tclUnixChan.c.
| ︙ | ︙ | |||
592 593 594 595 596 597 598 |
Tcl_Interp *interp, /* For error reporting - can be NULL. */
const char *optionName, /* Which option to set? */
const char *value) /* New value for option. */
{
TtyState *fsPtr = (TtyState *)instanceData;
size_t len, vlen;
TtyAttrs tty;
| | | 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 |
Tcl_Interp *interp, /* For error reporting - can be NULL. */
const char *optionName, /* Which option to set? */
const char *value) /* New value for option. */
{
TtyState *fsPtr = (TtyState *)instanceData;
size_t len, vlen;
TtyAttrs tty;
Tcl_Size argc;
const char **argv;
struct termios iostate;
len = strlen(optionName);
vlen = strlen(value);
/*
|
| ︙ | ︙ | |||
728 729 730 731 732 733 734 |
/*
* Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
*/
if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
#if defined(TIOCMGET) && defined(TIOCMSET)
int control, flag;
| | | 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 |
/*
* Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
*/
if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
#if defined(TIOCMGET) && defined(TIOCMSET)
int control, flag;
Tcl_Size i;
if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
}
if ((argc % 2) == 1) {
if (interp) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
|
| ︙ | ︙ |
Changes to unix/tclUnixInit.c.
| ︙ | ︙ | |||
451 452 453 454 455 456 457 |
*
*-------------------------------------------------------------------------
*/
void
TclpInitLibraryPath(
char **valuePtr,
| | | 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 |
*
*-------------------------------------------------------------------------
*/
void
TclpInitLibraryPath(
char **valuePtr,
Tcl_Size *lengthPtr,
Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE 32
Tcl_Obj *pathPtr, *objPtr;
const char *str;
Tcl_DString buffer;
|
| ︙ | ︙ | |||
474 475 476 477 478 479 480 |
str = getenv("TCL_LIBRARY"); /* INTL: Native. */
Tcl_ExternalToUtfDStringEx(NULL, NULL, str, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &buffer, NULL);
str = Tcl_DStringValue(&buffer);
if ((str != NULL) && (str[0] != '\0')) {
Tcl_DString ds;
| | | 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 |
str = getenv("TCL_LIBRARY"); /* INTL: Native. */
Tcl_ExternalToUtfDStringEx(NULL, NULL, str, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &buffer, NULL);
str = Tcl_DStringValue(&buffer);
if ((str != NULL) && (str[0] != '\0')) {
Tcl_DString ds;
Tcl_Size pathc;
const char **pathv;
char installLib[LIBRARY_SIZE];
Tcl_DStringInit(&ds);
/*
* Initialize the substrings used when locating an executable. The
|
| ︙ | ︙ | |||
1008 1009 1010 1011 1012 1013 1014 | * * Side effects: * None. * *---------------------------------------------------------------------- */ | | | | | 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 |
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_Size
TclpFindVariable(
const char *name, /* Name of desired environment variable
* (native). */
Tcl_Size *lengthPtr) /* Used to return length of name (for
* successful searches) or number of non-NULL
* entries in environ (for unsuccessful
* searches). */
{
Tcl_Size i, result = TCL_INDEX_NONE;
const char *env, *p1, *p2;
Tcl_DString envString;
Tcl_DStringInit(&envString);
for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
p1 = Tcl_ExternalToUtfDString(NULL, env, TCL_INDEX_NONE, &envString);
p2 = name;
|
| ︙ | ︙ |
Changes to unix/tclUnixSock.c.
| ︙ | ︙ | |||
212 213 214 215 216 217 218 |
*
* ----------------------------------------------------------------------
*/
static void
InitializeHostName(
char **valuePtr,
| | | 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 |
*
* ----------------------------------------------------------------------
*/
static void
InitializeHostName(
char **valuePtr,
TCL_HASH_TYPE *lengthPtr,
Tcl_Encoding *encodingPtr)
{
const char *native = NULL;
#ifndef NO_UNAME
struct utsname u;
struct hostent *hp;
|
| ︙ | ︙ |
Changes to unix/tclUnixTest.c.
| ︙ | ︙ | |||
9 10 11 12 13 14 15 16 17 18 19 20 21 22 | * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" /* * The headers are needed for the testalarm command that verifies the use of * SA_RESTART in signal handlers. */ | > | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #undef BUILD_tcl #include "tclInt.h" /* * The headers are needed for the testalarm command that verifies the use of * SA_RESTART in signal handlers. */ |
| ︙ | ︙ |
Changes to unix/tclUnixThrd.c.
| ︙ | ︙ | |||
210 211 212 213 214 215 216 |
*/
int
TclpThreadCreate(
Tcl_ThreadId *idPtr, /* Return, the ID of the thread */
Tcl_ThreadCreateProc *proc, /* Main() function of the thread */
void *clientData, /* The one argument to Main() */
| | | 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 |
*/
int
TclpThreadCreate(
Tcl_ThreadId *idPtr, /* Return, the ID of the thread */
Tcl_ThreadCreateProc *proc, /* Main() function of the thread */
void *clientData, /* The one argument to Main() */
Tcl_Size stackSize, /* Size of stack for the new thread */
int flags) /* Flags controlling behaviour of the new
* thread. */
{
#if TCL_THREADS
pthread_attr_t attr;
pthread_t theThread;
int result;
|
| ︙ | ︙ |
Changes to unix/tclXtTest.c.
| ︙ | ︙ | |||
8 9 10 11 12 13 14 15 16 17 18 19 20 21 | * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include <X11/Intrinsic.h> #include "tcl.h" static Tcl_ObjCmdProc TesteventloopCmd; /* * Functions defined in tclXtNotify.c for use by users of the Xt Notifier: | > | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #undef BUILD_tcl #include <X11/Intrinsic.h> #include "tcl.h" static Tcl_ObjCmdProc TesteventloopCmd; /* * Functions defined in tclXtNotify.c for use by users of the Xt Notifier: |
| ︙ | ︙ |
Changes to win/Makefile.in.
| ︙ | ︙ | |||
252 253 254 255 256 257 258 |
zutil.$(HOST_OBJEXT) \
minizip.$(HOST_OBJEXT)
ZIP_INSTALL_OBJS = @ZIP_INSTALL_OBJS@
CC_SWITCHES = -I"${BUILD_DIR}" -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \
-I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
| | | | 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 |
zutil.$(HOST_OBJEXT) \
minizip.$(HOST_OBJEXT)
ZIP_INSTALL_OBJS = @ZIP_INSTALL_OBJS@
CC_SWITCHES = -I"${BUILD_DIR}" -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \
-I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 -DTCL_UNSIGNED_SIZE \
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS}
CC_OBJNAME = @CC_OBJNAME@
CC_EXENAME = @CC_EXENAME@
STUB_CC_SWITCHES = -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \
-I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 -DTCL_UNSIGNED_SIZE \
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS}
TCLTEST_OBJS = \
tclTest.$(OBJEXT) \
tclTestObj.$(OBJEXT) \
tclTestProcBodyObj.$(OBJEXT) \
tclThreadTest.$(OBJEXT) \
|
| ︙ | ︙ |
Changes to win/tclWinInit.c.
| ︙ | ︙ | |||
120 121 122 123 124 125 126 |
*
*-------------------------------------------------------------------------
*/
void
TclpInitLibraryPath(
char **valuePtr,
| | | | 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 |
*
*-------------------------------------------------------------------------
*/
void
TclpInitLibraryPath(
char **valuePtr,
TCL_HASH_TYPE *lengthPtr,
Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE 64
Tcl_Obj *pathPtr;
char installLib[LIBRARY_SIZE];
const char *bytes;
TCL_HASH_TYPE length;
TclNewObj(pathPtr);
/*
* Initialize the substring used when locating the script library. The
* installLib variable computes the script library path relative to the
* installed DLL.
|
| ︙ | ︙ | |||
280 281 282 283 284 285 286 |
*
*---------------------------------------------------------------------------
*/
static void
InitializeDefaultLibraryDir(
char **valuePtr,
| | | 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 |
*
*---------------------------------------------------------------------------
*/
static void
InitializeDefaultLibraryDir(
char **valuePtr,
TCL_HASH_TYPE *lengthPtr,
Tcl_Encoding *encodingPtr)
{
HMODULE hModule = (HMODULE)TclWinGetTclInstance();
WCHAR wName[MAX_PATH + LIBRARY_SIZE];
char name[(MAX_PATH + LIBRARY_SIZE) * 3];
char *end, *p;
|
| ︙ | ︙ | |||
328 329 330 331 332 333 334 |
*
*---------------------------------------------------------------------------
*/
static void
InitializeSourceLibraryDir(
char **valuePtr,
| | | 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 |
*
*---------------------------------------------------------------------------
*/
static void
InitializeSourceLibraryDir(
char **valuePtr,
TCL_HASH_TYPE *lengthPtr,
Tcl_Encoding *encodingPtr)
{
HMODULE hModule = (HMODULE)TclWinGetTclInstance();
WCHAR wName[MAX_PATH + LIBRARY_SIZE];
char name[(MAX_PATH + LIBRARY_SIZE) * 3];
char *end, *p;
|
| ︙ | ︙ | |||
565 566 567 568 569 570 571 | * *---------------------------------------------------------------------- */ # define tenviron2utfdstr(string, len, dsPtr) \ (char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr)) | | | | | 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 |
*
*----------------------------------------------------------------------
*/
# define tenviron2utfdstr(string, len, dsPtr) \
(char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr))
Tcl_Size
TclpFindVariable(
const char *name, /* Name of desired environment variable
* (UTF-8). */
Tcl_Size *lengthPtr) /* Used to return length of name (for
* successful searches) or number of non-NULL
* entries in environ (for unsuccessful
* searches). */
{
Tcl_Size i, length, result = TCL_INDEX_NONE;
const WCHAR *env;
const char *p1, *p2;
char *envUpper, *nameUpper;
Tcl_DString envString;
/*
* Convert the name to all upper case for the case insensitive comparison.
|
| ︙ | ︙ |
Changes to win/tclWinSerial.c.
| ︙ | ︙ | |||
781 782 783 784 785 786 787 |
* 4. Wait for completion
* 5. Adjust the output queue counter
*/
ResetEvent(osPtr->hEvent);
EnterCriticalSection(&infoPtr->csWrite);
| | | 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 |
* 4. Wait for completion
* 5. Adjust the output queue counter
*/
ResetEvent(osPtr->hEvent);
EnterCriticalSection(&infoPtr->csWrite);
infoPtr->writeQueue -= (int)bufSize;
/*
* Set Offset to ZERO, otherwise NT4.0 may report an error
*/
osPtr->Offset = osPtr->OffsetHigh = 0;
result = WriteFile(infoPtr->handle, buf, bufSize, lpWritten, osPtr);
|
| ︙ | ︙ | |||
825 826 827 828 829 830 831 |
} else {
/*
* WriteFile completed immediately.
*/
}
EnterCriticalSection(&infoPtr->csWrite);
| | | 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 |
} else {
/*
* WriteFile completed immediately.
*/
}
EnterCriticalSection(&infoPtr->csWrite);
infoPtr->writeQueue += (int)(*lpWritten - bufSize);
LeaveCriticalSection(&infoPtr->csWrite);
return TRUE;
}
/*
*----------------------------------------------------------------------
|
| ︙ | ︙ | |||
892 893 894 895 896 897 898 |
/*
* NON_BLOCKING mode: Avoid blocking by reading more bytes than
* available in input buffer.
*/
if (cStat.cbInQue > 0) {
if ((DWORD) bufSize > cStat.cbInQue) {
| | | | 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 |
/*
* NON_BLOCKING mode: Avoid blocking by reading more bytes than
* available in input buffer.
*/
if (cStat.cbInQue > 0) {
if ((DWORD) bufSize > cStat.cbInQue) {
bufSize = (int)cStat.cbInQue;
}
} else {
errno = *errorCode = EWOULDBLOCK;
return -1;
}
} else {
/*
* BLOCKING mode: Tcl trys to read a full buffer of 4 kBytes here.
*/
if (cStat.cbInQue > 0) {
if ((DWORD) bufSize > cStat.cbInQue) {
bufSize = (int)cStat.cbInQue;
}
} else {
bufSize = 1;
}
}
}
|
| ︙ | ︙ | |||
928 929 930 931 932 933 934 |
if (SerialBlockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
&infoPtr->osRead) == FALSE) {
Tcl_WinConvertError(GetLastError());
*errorCode = errno;
return -1;
}
| | | 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 |
if (SerialBlockingRead(infoPtr, (LPVOID) buf, (DWORD) bufSize, &bytesRead,
&infoPtr->osRead) == FALSE) {
Tcl_WinConvertError(GetLastError());
*errorCode = errno;
return -1;
}
return (int)bytesRead;
commError:
infoPtr->lastError = infoPtr->error;
/* save last error code */
infoPtr->error = 0; /* reset error code */
*errorCode = EIO; /* to return read-error only once */
return -1;
|
| ︙ | ︙ | |||
1034 1035 1036 1037 1038 1039 1040 |
* Reallocate the buffer to be large enough to hold the data.
*/
if (infoPtr->writeBuf) {
Tcl_Free(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
| | | | 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 |
* Reallocate the buffer to be large enough to hold the data.
*/
if (infoPtr->writeBuf) {
Tcl_Free(infoPtr->writeBuf);
}
infoPtr->writeBufLen = toWrite;
infoPtr->writeBuf = (char *)Tcl_Alloc((unsigned)toWrite);
}
memcpy(infoPtr->writeBuf, buf, (unsigned)toWrite);
infoPtr->toWrite = toWrite;
ResetEvent(infoPtr->evWritable);
TclPipeThreadSignal(&infoPtr->writeTI);
bytesWritten = (DWORD) toWrite;
} else {
/*
|
| ︙ | ︙ | |||
1293 1294 1295 1296 1297 1298 1299 |
if (!TclPipeThreadWaitForSignal(&pipeTI)) {
/* exit */
break;
}
infoPtr = (SerialInfo *) pipeTI->clientData;
buf = infoPtr->writeBuf;
| | | 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 |
if (!TclPipeThreadWaitForSignal(&pipeTI)) {
/* exit */
break;
}
infoPtr = (SerialInfo *) pipeTI->clientData;
buf = infoPtr->writeBuf;
toWrite = (DWORD)infoPtr->toWrite;
myWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL);
/*
* Loop until all of the bytes are written or an error occurs.
*/
|
| ︙ | ︙ | |||
1620 1621 1622 1623 1624 1625 1626 |
{
SerialInfo *infoPtr;
DCB dcb;
BOOL result, flag;
size_t len, vlen;
Tcl_DString ds;
const WCHAR *native;
| | | 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 |
{
SerialInfo *infoPtr;
DCB dcb;
BOOL result, flag;
size_t len, vlen;
Tcl_DString ds;
const WCHAR *native;
Tcl_Size argc;
const char **argv;
infoPtr = (SerialInfo *) instanceData;
/*
* Parse options. This would be far easier if we had Tcl_Objs to work with
* as that would let us use Tcl_GetIndexFromObj()...
|
| ︙ | ︙ | |||
1790 1791 1792 1793 1794 1795 1796 |
* hex/octal value rather than the printable form.
*/
dcb.XonChar = argv[0][0];
dcb.XoffChar = argv[1][0];
if (argv[0][0] & 0x80 || argv[1][0] & 0x80) {
Tcl_UniChar character = 0;
| | | 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 |
* hex/octal value rather than the printable form.
*/
dcb.XonChar = argv[0][0];
dcb.XoffChar = argv[1][0];
if (argv[0][0] & 0x80 || argv[1][0] & 0x80) {
Tcl_UniChar character = 0;
Tcl_Size charLen;
charLen = Tcl_UtfToUniChar(argv[0], &character);
if ((character > 0xFF) || argv[0][charLen]) {
goto badXchar;
}
dcb.XonChar = (char) character;
charLen = Tcl_UtfToUniChar(argv[1], &character);
|
| ︙ | ︙ | |||
1816 1817 1818 1819 1820 1821 1822 |
}
/*
* Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
*/
if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
| | | 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 |
}
/*
* Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
*/
if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
Tcl_Size i;
int res = TCL_OK;
if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
}
if ((argc % 2) == 1) {
if (interp != NULL) {
|
| ︙ | ︙ | |||
1908 1909 1910 1911 1912 1913 1914 |
int inSize = -1, outSize = -1;
if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
}
if (argc == 1) {
inSize = atoi(argv[0]);
| | | | | | 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 |
int inSize = -1, outSize = -1;
if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
}
if (argc == 1) {
inSize = atoi(argv[0]);
outSize = (int)infoPtr->sysBufWrite;
} else if (argc == 2) {
inSize = atoi(argv[0]);
outSize = atoi(argv[1]);
}
Tcl_Free((void *)argv);
if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad value \"%s\" for -sysbuffer: should be "
"a list of one or two integers > 0", value));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);
}
return TCL_ERROR;
}
if (!SetupComm(infoPtr->handle, (DWORD)inSize, (DWORD)outSize)) {
if (interp != NULL) {
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't setup comm buffers: %s",
Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
infoPtr->sysBufRead = (DWORD)inSize;
infoPtr->sysBufWrite = (DWORD)outSize;
/*
* Adjust the handshake limits. Yes, the XonXoff limits seem to
* influence even hardware handshake.
*/
if (!GetCommState(infoPtr->handle, &dcb)) {
|
| ︙ | ︙ | |||
1975 1976 1977 1978 1979 1980 1981 |
if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) {
int msec;
COMMTIMEOUTS tout = {0,0,0,0,0};
if (Tcl_GetInt(interp, value, &msec) != TCL_OK) {
return TCL_ERROR;
}
| | | 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 |
if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) {
int msec;
COMMTIMEOUTS tout = {0,0,0,0,0};
if (Tcl_GetInt(interp, value, &msec) != TCL_OK) {
return TCL_ERROR;
}
tout.ReadTotalTimeoutConstant = (DWORD)msec;
if (!SetCommTimeouts(infoPtr->handle, &tout)) {
if (interp != NULL) {
Tcl_WinConvertError(GetLastError());
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't set comm timeouts: %s",
Tcl_PosixError(interp)));
}
|
| ︙ | ︙ | |||
2216 2217 2218 2219 2220 2221 2222 | */ EnterCriticalSection(&infoPtr->csWrite); ClearCommError(infoPtr->handle, &error, &cStat); count = (int) cStat.cbOutQue + infoPtr->writeQueue; LeaveCriticalSection(&infoPtr->csWrite); | | | 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 |
*/
EnterCriticalSection(&infoPtr->csWrite);
ClearCommError(infoPtr->handle, &error, &cStat);
count = (int) cStat.cbOutQue + infoPtr->writeQueue;
LeaveCriticalSection(&infoPtr->csWrite);
snprintf(buf, sizeof(buf), "%ld", (DWORD)inBuffered + cStat.cbInQue);
Tcl_DStringAppendElement(dsPtr, buf);
snprintf(buf, sizeof(buf), "%d", outBuffered + count);
Tcl_DStringAppendElement(dsPtr, buf);
}
/*
* get option -ttystatus
|
| ︙ | ︙ |
Changes to win/tclWinSock.c.
| ︙ | ︙ | |||
753 754 755 756 757 758 759 |
char *buf, /* Where to store data read. */
int bufSize, /* How much space is available in the
* buffer? */
int *errorCodePtr) /* Where to store error code. */
{
TcpState *statePtr = (TcpState *)instanceData;
int bytesRead;
| | | 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 |
char *buf, /* Where to store data read. */
int bufSize, /* How much space is available in the
* buffer? */
int *errorCodePtr) /* Where to store error code. */
{
TcpState *statePtr = (TcpState *)instanceData;
int bytesRead;
int error;
ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
*errorCodePtr = 0;
/*
* First check to see if EOF was already detected, to prevent calling the
* socket stack after the first time EOF is detected.
|
| ︙ | ︙ | |||
1258 1259 1260 1261 1262 1263 1264 |
} else {
/*
* Report an eventual last error of the socket system.
*/
int optlen;
int ret;
| | | 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 |
} else {
/*
* Report an eventual last error of the socket system.
*/
int optlen;
int ret;
int err;
/*
* Populate the err variable with a POSIX error
*/
optlen = sizeof(int);
ret = getsockopt(sock, SOL_SOCKET, SO_ERROR,
|
| ︙ | ︙ | |||
1602 1603 1604 1605 1606 1607 1608 |
*/
static int
TcpConnect(
Tcl_Interp *interp, /* For error reporting; can be NULL. */
TcpState *statePtr)
{
| | | 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 |
*/
static int
TcpConnect(
Tcl_Interp *interp, /* For error reporting; can be NULL. */
TcpState *statePtr)
{
int error;
int async_connect = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
/* We are started with async connect and the
* connect notification was not yet
* received. */
int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING);
/* We were called by the event procedure and
* continue our loop. */
|
| ︙ | ︙ | |||
3029 3030 3031 3032 3033 3034 3035 |
/*
* This releases waiters on thread exit in TclpFinalizeSockets()
*/
SetEvent(tsdPtr->readyEvent);
| | | 3029 3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 |
/*
* This releases waiters on thread exit in TclpFinalizeSockets()
*/
SetEvent(tsdPtr->readyEvent);
return (DWORD)msg.wParam;
}
/*
*----------------------------------------------------------------------
*
* SocketProc --
|
| ︙ | ︙ |
Changes to win/tclWinTest.c.
| ︙ | ︙ | |||
8 9 10 11 12 13 14 15 16 17 18 19 20 21 | * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" #ifdef TCL_WITH_EXTERNAL_TOMMATH # include "tommath.h" #else # include "tclTomMath.h" #endif | > | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #undef BUILD_tcl #include "tclInt.h" #ifdef TCL_WITH_EXTERNAL_TOMMATH # include "tommath.h" #else # include "tclTomMath.h" #endif |
| ︙ | ︙ |
Changes to win/tclWinThrd.c.
| ︙ | ︙ | |||
200 201 202 203 204 205 206 |
*/
int
TclpThreadCreate(
Tcl_ThreadId *idPtr, /* Return, the ID of the thread. */
Tcl_ThreadCreateProc *proc, /* Main() function of the thread. */
void *clientData, /* The one argument to Main(). */
| | > > > | | 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 |
*/
int
TclpThreadCreate(
Tcl_ThreadId *idPtr, /* Return, the ID of the thread. */
Tcl_ThreadCreateProc *proc, /* Main() function of the thread. */
void *clientData, /* The one argument to Main(). */
Tcl_Size stackSize, /* Size of stack for the new thread. */
int flags) /* Flags controlling behaviour of the new
* thread. */
{
WinThread *winThreadPtr; /* Per-thread startup info */
HANDLE tHandle;
if (stackSize > INT_MAX) {
return TCL_ERROR;
}
winThreadPtr = (WinThread *)Tcl_Alloc(sizeof(WinThread));
winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc;
winThreadPtr->lpParameter = clientData;
winThreadPtr->fpControl = _controlfp(0, 0);
EnterCriticalSection(&joinLock);
*idPtr = 0; /* must initialize as Tcl_Thread is a pointer and
* on WIN64 sizeof void* != sizeof unsigned
*/
#if defined(_MSC_VER) || defined(__MSVCRT__)
tHandle = (HANDLE) _beginthreadex(NULL, stackSize,
(Tcl_ThreadCreateProc*) TclWinThreadStart, winThreadPtr,
0, (unsigned *)idPtr);
#else
tHandle = CreateThread(NULL, (DWORD) stackSize,
TclWinThreadStart, winThreadPtr, 0, (LPDWORD)idPtr);
#endif
|
| ︙ | ︙ |