ag/cpython-source-deps
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Import Tcl 8.6.12

Browse Source
This commit is contained in:
Steve Dower
2021-11-08 17:30:58 +00:00
parent 1aadb2455c
commit 674867e7e6
608 changed files with 78089 additions and 60360 deletions
Download Patch File Download Diff File Expand all files Collapse all files

59
generic/tclListObj.c
View File

@@ -19,7 +19,7 @@
static List * AttemptNewList(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static List * NewListIntRep(int objc, Tcl_Obj *const objv[], int p);
static List * NewListInternalRep(int objc, Tcl_Obj *const objv[], int p);
static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void FreeListInternalRep(Tcl_Obj *listPtr);
static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
@@ -46,6 +46,15 @@ const Tcl_ObjType tclListType = {
SetListFromAny /* setFromAnyProc */
};
/* Macros to manipulate the List internal rep */
#define ListSetInternalRep(objPtr, listRepPtr) \
(objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(listRepPtr), \
(objPtr)->internalRep.twoPtrValue.ptr2 = NULL, \
(listRepPtr)->refCount++, \
(objPtr)->typePtr = &tclListType
#ifndef TCL_MIN_ELEMENT_GROWTH
#define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *)
#endif
@@ -53,7 +62,7 @@ const Tcl_ObjType tclListType = {
/*
*----------------------------------------------------------------------
*
* NewListIntRep --
* NewListInternalRep --
*
* Creates a 'List' structure with space for 'objc' elements. 'objc' must
* be > 0. If 'objv' is not NULL, The list is initialized with first
@@ -76,7 +85,7 @@ const Tcl_ObjType tclListType = {
*/
static List *
NewListIntRep(
NewListInternalRep(
int objc,
Tcl_Obj *const objv[],
int p)
@@ -84,7 +93,7 @@ NewListIntRep(
List *listRepPtr;
if (objc <= 0) {
Tcl_Panic("NewListIntRep: expects postive element count");
Tcl_Panic("NewListInternalRep: expects postive element count");
}
/*
@@ -102,7 +111,7 @@ NewListIntRep(
return NULL;
}
listRepPtr = attemptckalloc(LIST_SIZE(objc));
listRepPtr = (List *)attemptckalloc(LIST_SIZE(objc));
if (listRepPtr == NULL) {
if (p) {
Tcl_Panic("list creation failed: unable to alloc %u bytes",
@@ -136,7 +145,7 @@ NewListIntRep(
*
* AttemptNewList --
*
* Like NewListIntRep, but additionally sets an error message on failure.
* Like NewListInternalRep, but additionally sets an error message on failure.
*
*----------------------------------------------------------------------
*/
@@ -147,7 +156,7 @@ AttemptNewList(
int objc,
Tcl_Obj *const objv[])
{
List *listRepPtr = NewListIntRep(objc, objv, 0);
List *listRepPtr = NewListInternalRep(objc, objv, 0);
if (interp != NULL && listRepPtr == NULL) {
if (objc > LIST_MAX) {
@@ -218,14 +227,14 @@ Tcl_NewListObj(
* Create the internal rep.
*/
listRepPtr = NewListIntRep(objc, objv, 1);
listRepPtr = NewListInternalRep(objc, objv, 1);
/*
* Now create the object.
*/
TclInvalidateStringRep(listPtr);
ListSetIntRep(listPtr, listRepPtr);
ListSetInternalRep(listPtr, listRepPtr);
return listPtr;
}
#endif /* if TCL_MEM_DEBUG */
@@ -269,14 +278,14 @@ Tcl_DbNewListObj(
* Create the internal rep.
*/
listRepPtr = NewListIntRep(objc, objv, 1);
listRepPtr = NewListInternalRep(objc, objv, 1);
/*
* Now create the object.
*/
TclInvalidateStringRep(listPtr);
ListSetIntRep(listPtr, listRepPtr);
ListSetInternalRep(listPtr, listRepPtr);
return listPtr;
}
@@ -333,8 +342,8 @@ Tcl_SetListObj(
*/
if (objc > 0) {
listRepPtr = NewListIntRep(objc, objv, 1);
ListSetIntRep(objPtr, listRepPtr);
listRepPtr = NewListInternalRep(objc, objv, 1);
ListSetInternalRep(objPtr, listRepPtr);
} else {
objPtr->bytes = tclEmptyStringRep;
objPtr->length = 0;
@@ -580,7 +589,7 @@ Tcl_ListObjAppendElement(
if (needGrow && !isShared) {
/*
* Need to grow + unshared intrep => try to realloc
* Need to grow + unshared internalrep => try to realloc
*/
attempt = 2 * numRequired;
@@ -608,8 +617,8 @@ Tcl_ListObjAppendElement(
Tcl_Obj **dst, **src = &listRepPtr->elements;
/*
* Either we have a shared intrep and we must copy to write, or we
* need to grow and realloc attempts failed. Attempt intrep copy.
* Either we have a shared internalrep and we must copy to write, or we
* need to grow and realloc attempts failed. Attempt internalrep copy.
*/
attempt = 2 * numRequired;
@@ -640,7 +649,7 @@ Tcl_ListObjAppendElement(
if (isShared) {
/*
* The original intrep must remain undisturbed. Copy into the new
* The original internalrep must remain undisturbed. Copy into the new
* one and bump refcounts
*/
while (numElems--) {
@@ -650,7 +659,7 @@ Tcl_ListObjAppendElement(
listRepPtr->refCount--;
} else {
/*
* Old intrep to be freed, re-use refCounts.
* Old internalrep to be freed, re-use refCounts.
*/
memcpy(dst, src, numElems * sizeof(Tcl_Obj *));
@@ -1085,7 +1094,7 @@ Tcl_ListObjReplace(
*
* Implemented entirely as a wrapper around 'TclLindexFlat'. Reconfigures
* the argument format into required form while taking care to manage
* shimmering so as to tend to keep the most useful intreps
* shimmering so as to tend to keep the most useful internalreps
* and/or avoid the most expensive conversions.
*
* Value
@@ -1469,8 +1478,8 @@ TclLsetFlat(
/*
* Replace the original elemPtr[index] in parentList with a copy
* we know to be unshared. This call will also deal with the
* situation where parentList shares its intrep with other
* Tcl_Obj's. Dealing with the shared intrep case can cause
* situation where parentList shares its internalrep with other
* Tcl_Obj's. Dealing with the shared internalrep case can cause
* subListPtr to become shared again, so detect that case and make
* and store another copy.
*/
@@ -1495,7 +1504,7 @@ TclLsetFlat(
* variable. Later on, when we set valuePtr in its proper place,
* then all containing lists will have their values changed, and
* will need their string reps spoiled. We maintain a list of all
* those Tcl_Obj's (via a little intrep surgery) so we can spoil
* those Tcl_Obj's (via a little internalrep surgery) so we can spoil
* them at that time.
*/
@@ -1524,7 +1533,7 @@ TclLsetFlat(
}
/*
* Clear away our intrep surgery mess.
* Clear away our internalrep surgery mess.
*/
chainPtr = objPtr->internalRep.twoPtrValue.ptr2;
@@ -1768,7 +1777,7 @@ DupListInternalRep(
{
List *listRepPtr = ListRepPtr(srcPtr);
ListSetIntRep(copyPtr, listRepPtr);
ListSetInternalRep(copyPtr, listRepPtr);
}
/*
@@ -1905,7 +1914,7 @@ SetListFromAny(
*/
TclFreeIntRep(objPtr);
ListSetIntRep(objPtr, listRepPtr);
ListSetInternalRep(objPtr, listRepPtr);
return TCL_OK;
}