From 643fbd40d93f1432a5465323319edaa756f309f8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 10 Mar 2022 14:03:08 +0000 Subject: Enhance internal "struct CoroutineData" such that it can handle more than 2^31 levels/arguments --- generic/tclBasic.c | 27 +++++++++++++-------------- generic/tclInt.h | 4 ++-- generic/tclZipfs.c | 18 ++++++------------ 3 files changed, 21 insertions(+), 28 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 2d86e9c..dbb20a5 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -220,8 +220,8 @@ MODULE_SCOPE const TclStubs tclStubs; #define CORO_ACTIVATE_YIELD PTR2INT(NULL) #define CORO_ACTIVATE_YIELDM PTR2INT(NULL)+1 -#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1) -#define COROUTINE_ARGUMENTS_ARBITRARY (-2) +#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL ((size_t)-1) +#define COROUTINE_ARGUMENTS_ARBITRARY ((size_t)-2) /* * The following structure define the commands in the Tcl core. @@ -8956,9 +8956,8 @@ TclNRCoroutineActivateCallback( TCL_UNUSED(int) /*result*/) { CoroutineData *corPtr = (CoroutineData *)data[0]; - int type = PTR2INT(data[1]); - int numLevels, unused; - int *stackLevel = &unused; + int unused, type = PTR2INT(data[1]); + size_t numLevels; if (!corPtr->stackLevel) { /* @@ -8975,7 +8974,7 @@ TclNRCoroutineActivateCallback( * the interp's environment to make it suitable to run this coroutine. */ - corPtr->stackLevel = stackLevel; + corPtr->stackLevel = &unused; numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = iPtr->numLevels; @@ -8989,7 +8988,7 @@ TclNRCoroutineActivateCallback( * Coroutine is active: yield */ - if (corPtr->stackLevel != stackLevel) { + if (corPtr->stackLevel != &unused) { NRE_callback *runPtr; iPtr->execEnvPtr = corPtr->callerEEPtr; @@ -9217,8 +9216,8 @@ TclNRCoroProbeObjCmd( { CoroutineData *corPtr; ExecEnv *savedEEPtr = iPtr->execEnvPtr; - int numLevels, unused; - int *stackLevel = &unused; + size_t numLevels; + int unused; /* * Usage more or less like tailcall: @@ -9268,7 +9267,7 @@ TclNRCoroProbeObjCmd( * the interp's environment to make it suitable to run this coroutine. */ - corPtr->stackLevel = stackLevel; + corPtr->stackLevel = &unused; numLevels = corPtr->auxNumLevels; corPtr->auxNumLevels = iPtr->numLevels; @@ -9313,7 +9312,7 @@ InjectHandler( { CoroutineData *corPtr = (CoroutineData *)data[0]; Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; - int nargs = PTR2INT(data[2]); + size_t nargs = PTR2INT(data[2]); void *isProbe = data[3]; int objc; Tcl_Obj **objv; @@ -9334,7 +9333,7 @@ InjectHandler( * I don't think this is reachable... */ - Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewIntObj(nargs)); + Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewWideIntObj((Tcl_WideInt)(nargs + 1U) - 1)); } Tcl_ListObjAppendElement(NULL, listPtr, Tcl_GetObjResult(interp)); } @@ -9359,7 +9358,7 @@ InjectHandlerPostCall( { CoroutineData *corPtr = (CoroutineData *)data[0]; Tcl_Obj *listPtr = (Tcl_Obj *)data[1]; - int nargs = PTR2INT(data[2]); + size_t nargs = PTR2INT(data[2]); void *isProbe = data[3]; int numLevels; @@ -9479,7 +9478,7 @@ TclNRInterpCoroutine( } break; default: - if (corPtr->nargs != objc-1) { + if (corPtr->nargs + 1 != (size_t)objc) { Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong coro nargs; how did we get here? " "not implemented!", -1)); diff --git a/generic/tclInt.h b/generic/tclInt.h index 8678a57..bdf7990 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1473,11 +1473,11 @@ typedef struct CoroutineData { CorContext running; Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ void *stackLevel; - int auxNumLevels; /* While the coroutine is running the + size_t auxNumLevels; /* While the coroutine is running the * numLevels of the create/resume command is * stored here; for suspended coroutines it * holds the nesting numLevels at yield. */ - int nargs; /* Number of args required for resuming this + size_t nargs; /* Number of args required for resuming this * coroutine; COROUTINE_ARGUMENTS_SINGLE_OPTIONAL means "0 or 1" * (default), COROUTINE_ARGUMENTS_ARBITRARY means "any" */ Tcl_Obj *yieldPtr; /* The command to yield to. Stored here in diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index b63cce7..906eff4 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -428,12 +428,6 @@ static Tcl_ChannelType ZipChannelType = { }; /* - * Miscellaneous constants. - */ - -#define ERROR_LENGTH ((size_t) -1) - -/* *------------------------------------------------------------------------- * * ZipReadInt, ZipReadShort, ZipWriteInt, ZipWriteShort -- @@ -1387,7 +1381,7 @@ ZipFSOpenArchive( */ zf->length = Tcl_Seek(zf->chan, 0, SEEK_END); - if (zf->length == ERROR_LENGTH) { + if (zf->length == TCL_INDEX_NONE) { ZIPFS_POSIX_ERROR(interp, "seek error"); goto error; } @@ -1486,7 +1480,7 @@ ZipMapArchive( */ zf->length = lseek(fd, 0, SEEK_END); - if (zf->length == ERROR_LENGTH || zf->length < ZIP_CENTRAL_END_LEN) { + if (zf->length == TCL_INDEX_NONE || zf->length < ZIP_CENTRAL_END_LEN) { ZIPFS_POSIX_ERROR(interp, "invalid file size"); return TCL_ERROR; } @@ -2582,7 +2576,7 @@ ZipAddFile( nbyte = nbytecompr = 0; while (1) { len = Tcl_Read(in, buf, bufsize); - if (len == ERROR_LENGTH) { + if (len == TCL_INDEX_NONE) { Tcl_DStringFree(&zpathDs); if (nbyte == 0 && errno == EISDIR) { Tcl_Close(interp, in); @@ -2712,7 +2706,7 @@ ZipAddFile( do { len = Tcl_Read(in, buf, bufsize); - if (len == ERROR_LENGTH) { + if (len == TCL_INDEX_NONE) { deflateEnd(&stream); goto readErrorWithChannelOpen; } @@ -2776,7 +2770,7 @@ ZipAddFile( nbytecompr = (passwd ? 12 : 0); while (1) { len = Tcl_Read(in, buf, bufsize); - if (len == ERROR_LENGTH) { + if (len == TCL_INDEX_NONE) { goto readErrorWithChannelOpen; } else if (len == 0) { break; @@ -3299,7 +3293,7 @@ CopyImageFile( */ i = Tcl_Seek(in, 0, SEEK_END); - if (i == ERROR_LENGTH) { + if (i == TCL_INDEX_NONE) { errMsg = "seek error"; goto copyError; } -- cgit v0.12