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

89
generic/tclAssembly.c
View File

@@ -497,7 +497,7 @@ static const TalInstDesc TalInstructionTable[] = {
{"variable", ASSEM_LVT4, INST_VARIABLE, 1, 0},
{"verifyDict", ASSEM_1BYTE, INST_DICT_VERIFY, 1, 0},
{"yield", ASSEM_1BYTE, INST_YIELD, 1, 1},
{NULL, 0, 0, 0, 0}
{NULL, ASSEM_1BYTE, 0, 0, 0}
};
/*
@@ -848,7 +848,6 @@ CompileAssembleObj(
const char* source; /* String representation of the source code */
int sourceLen; /* Length of the source code in bytes */
/*
* Get the expression ByteCode from the object. If it exists, make sure it
* is valid in the current context.
@@ -856,7 +855,7 @@ CompileAssembleObj(
if (objPtr->typePtr == &assembleCodeType) {
namespacePtr = iPtr->varFramePtr->nsPtr;
codePtr = objPtr->internalRep.twoPtrValue.ptr1;
codePtr = (ByteCode *)objPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle == iPtr)
&& (codePtr->compileEpoch == iPtr->compileEpoch)
&& (codePtr->nsPtr == namespacePtr)
@@ -903,7 +902,7 @@ CompileAssembleObj(
* Record the local variable context to which the bytecode pertains
*/
codePtr = objPtr->internalRep.twoPtrValue.ptr1;
codePtr = (ByteCode *)objPtr->internalRep.twoPtrValue.ptr1;
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -1144,9 +1143,9 @@ NewAssemblyEnv(
{
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
AssemblyEnv* assemEnvPtr = TclStackAlloc(interp, sizeof(AssemblyEnv));
AssemblyEnv* assemEnvPtr = (AssemblyEnv*)TclStackAlloc(interp, sizeof(AssemblyEnv));
/* Assembler environment under construction */
Tcl_Parse* parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse));
Tcl_Parse* parsePtr = (Tcl_Parse*)TclStackAlloc(interp, sizeof(Tcl_Parse));
/* Parse of one line of assembly code */
assemEnvPtr->envPtr = envPtr;
@@ -1534,7 +1533,7 @@ AssembleOneLine(
goto cleanup;
}
jtPtr = ckalloc(sizeof(JumptableInfo));
jtPtr = (JumptableInfo*)ckalloc(sizeof(JumptableInfo));
Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
@@ -1928,7 +1927,7 @@ MoveExceptionRangesToBasicBlock(
curr_bb->foreignExceptionBase = savedExceptArrayNext;
curr_bb->foreignExceptionCount = exceptionCount;
curr_bb->foreignExceptions =
ckalloc(exceptionCount * sizeof(ExceptionRange));
(ExceptionRange*)ckalloc(exceptionCount * sizeof(ExceptionRange));
memcpy(curr_bb->foreignExceptions,
envPtr->exceptArrayPtr + savedExceptArrayNext,
exceptionCount * sizeof(ExceptionRange));
@@ -1993,7 +1992,7 @@ CreateMirrorJumpTable(
* Allocate the jumptable.
*/
jtPtr = ckalloc(sizeof(JumptableInfo));
jtPtr = (JumptableInfo*)ckalloc(sizeof(JumptableInfo));
jtHashPtr = &jtPtr->hashTable;
Tcl_InitHashTable(jtHashPtr, TCL_STRING_KEYS);
@@ -2053,7 +2052,7 @@ DeleteMirrorJumpTable(
for (entry = Tcl_FirstHashEntry(jtHashPtr, &search);
entry != NULL;
entry = Tcl_NextHashEntry(&search)) {
label = Tcl_GetHashValue(entry);
label = (Tcl_Obj*)Tcl_GetHashValue(entry);
Tcl_DecrRefCount(label);
Tcl_SetHashValue(entry, NULL);
}
@@ -2642,7 +2641,7 @@ AllocBB(
AssemblyEnv* assemEnvPtr) /* Assembly environment */
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
BasicBlock *bb = ckalloc(sizeof(BasicBlock));
BasicBlock *bb = (BasicBlock*)ckalloc(sizeof(BasicBlock));
bb->originalStartOffset =
bb->startOffset = envPtr->codeNext - envPtr->codeStart;
@@ -2833,7 +2832,7 @@ CalculateJumpRelocations(
* target is out of range.
*/
jumpTarget = Tcl_GetHashValue(entry);
jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry);
if (bbPtr->flags & BB_JUMP1) {
offset = jumpTarget->startOffset
- (bbPtr->jumpOffset + motion);
@@ -2900,7 +2899,7 @@ CheckJumpTableLabels(
for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search);
symEntryPtr != NULL;
symEntryPtr = Tcl_NextHashEntry(&search)) {
symbolObj = Tcl_GetHashValue(symEntryPtr);
symbolObj = (Tcl_Obj*)Tcl_GetHashValue(symEntryPtr);
valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
Tcl_GetString(symbolObj));
DEBUG_PRINT(" %s -> %s (%d)\n",
@@ -3029,7 +3028,7 @@ FillInJumpOffsets(
if (bbPtr->jumpTarget != NULL) {
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
Tcl_GetString(bbPtr->jumpTarget));
jumpTarget = Tcl_GetHashValue(entry);
jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry);
fromOffset = bbPtr->jumpOffset;
targetOffset = jumpTarget->startOffset;
if (bbPtr->flags & BB_JUMP1) {
@@ -3088,7 +3087,7 @@ ResolveJumpTableTargets(
auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1);
DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n",
bbPtr, bbPtr->jumpOffset, auxDataIndex);
realJumpTablePtr = TclFetchAuxData(envPtr, auxDataIndex);
realJumpTablePtr = (JumptableInfo*)TclFetchAuxData(envPtr, auxDataIndex);
realJumpHashPtr = &realJumpTablePtr->hashTable;
/*
@@ -3099,12 +3098,12 @@ ResolveJumpTableTargets(
for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search);
symEntryPtr != NULL;
symEntryPtr = Tcl_NextHashEntry(&search)) {
symbolObj = Tcl_GetHashValue(symEntryPtr);
symbolObj = (Tcl_Obj*)Tcl_GetHashValue(symEntryPtr);
DEBUG_PRINT(" symbol %s\n", Tcl_GetString(symbolObj));
valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
Tcl_GetString(symbolObj));
jumpTargetBBPtr = Tcl_GetHashValue(valEntryPtr);
jumpTargetBBPtr = (BasicBlock*)Tcl_GetHashValue(valEntryPtr);
realJumpEntryPtr = Tcl_CreateHashEntry(realJumpHashPtr,
Tcl_GetHashKey(symHash, symEntryPtr), &junk);
@@ -3483,7 +3482,7 @@ StackCheckBasicBlock(
if (result == TCL_OK && blockPtr->jumpTarget != NULL) {
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
Tcl_GetString(blockPtr->jumpTarget));
jumpTarget = Tcl_GetHashValue(entry);
jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry);
result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, blockPtr,
stackDepth);
}
@@ -3497,10 +3496,10 @@ StackCheckBasicBlock(
&jtSearch);
result == TCL_OK && jtEntry != NULL;
jtEntry = Tcl_NextHashEntry(&jtSearch)) {
targetLabel = Tcl_GetHashValue(jtEntry);
targetLabel = (Tcl_Obj*)Tcl_GetHashValue(jtEntry);
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
Tcl_GetString(targetLabel));
jumpTarget = Tcl_GetHashValue(entry);
jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry);
result = StackCheckBasicBlock(assemEnvPtr, jumpTarget,
blockPtr, stackDepth);
}
@@ -3805,7 +3804,7 @@ ProcessCatchesInBasicBlock(
if (result == TCL_OK && bbPtr->jumpTarget != NULL) {
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
Tcl_GetString(bbPtr->jumpTarget));
jumpTarget = Tcl_GetHashValue(entry);
jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry);
result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
jumpEnclosing, jumpState, catchDepth);
}
@@ -3818,10 +3817,10 @@ ProcessCatchesInBasicBlock(
for (jtEntry = Tcl_FirstHashEntry(&bbPtr->jtPtr->hashTable,&jtSearch);
result == TCL_OK && jtEntry != NULL;
jtEntry = Tcl_NextHashEntry(&jtSearch)) {
targetLabel = Tcl_GetHashValue(jtEntry);
targetLabel = (Tcl_Obj*)Tcl_GetHashValue(jtEntry);
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
Tcl_GetString(targetLabel));
jumpTarget = Tcl_GetHashValue(entry);
jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry);
result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
jumpEnclosing, jumpState, catchDepth);
}
@@ -3920,8 +3919,8 @@ BuildExceptionRanges(
* Allocate memory for a stack of active catches.
*/
catches = ckalloc(maxCatchDepth * sizeof(BasicBlock*));
catchIndices = ckalloc(maxCatchDepth * sizeof(int));
catches = (BasicBlock**)ckalloc(maxCatchDepth * sizeof(BasicBlock*));
catchIndices = (int *)ckalloc(maxCatchDepth * sizeof(int));
for (i = 0; i < maxCatchDepth; ++i) {
catches[i] = NULL;
catchIndices[i] = -1;
@@ -3989,7 +3988,7 @@ UnstackExpiredCatches(
* corresponding to the catch contexts */
{
ExceptionRange* range; /* Exception range for a specific catch */
BasicBlock* catch; /* Catch block being examined */
BasicBlock* block; /* Catch block being examined */
BasicBlockCatchState catchState;
/* State of the code relative to the catch
* block being examined ("in catch" or
@@ -4017,18 +4016,18 @@ UnstackExpiredCatches(
*/
catchState = bbPtr->catchState;
catch = bbPtr->enclosingCatch;
block = bbPtr->enclosingCatch;
while (catchDepth > 0) {
--catchDepth;
if (catches[catchDepth] != NULL) {
if (catches[catchDepth] != catch || catchState >= BBCS_CAUGHT) {
if (catches[catchDepth] != block || catchState >= BBCS_CAUGHT) {
range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
catches[catchDepth] = NULL;
catchIndices[catchDepth] = -1;
}
catchState = catch->catchState;
catch = catch->enclosingCatch;
catchState = block->catchState;
block = block->enclosingCatch;
}
}
}
@@ -4057,19 +4056,19 @@ LookForFreshCatches(
BasicBlockCatchState catchState;
/* State ("in catch" or "caught") of the
* current catch. */
BasicBlock* catch; /* Current enclosing catch */
BasicBlock* block; /* Current enclosing catch */
int catchDepth; /* Nesting depth of the current catch */
catchState = bbPtr->catchState;
catch = bbPtr->enclosingCatch;
block = bbPtr->enclosingCatch;
catchDepth = bbPtr->catchDepth;
while (catchDepth > 0) {
--catchDepth;
if (catches[catchDepth] != catch && catchState < BBCS_CAUGHT) {
catches[catchDepth] = catch;
if (catches[catchDepth] != block && catchState < BBCS_CAUGHT) {
catches[catchDepth] = block;
}
catchState = catch->catchState;
catch = catch->enclosingCatch;
catchState = block->catchState;
block = block->enclosingCatch;
}
}
@@ -4097,7 +4096,7 @@ StackFreshCatches(
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
ExceptionRange* range; /* Exception range for a specific catch */
BasicBlock* catch; /* Catch block being examined */
BasicBlock* block; /* Catch block being examined */
BasicBlock* errorExit; /* Error exit from the catch block */
Tcl_HashEntry* entryPtr;
@@ -4114,7 +4113,7 @@ StackFreshCatches(
* Create an exception range for a block that needs one.
*/
catch = catches[catchDepth];
block = catches[catchDepth];
catchIndices[catchDepth] =
TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
@@ -4124,13 +4123,13 @@ StackFreshCatches(
range->codeOffset = bbPtr->startOffset;
entryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
Tcl_GetString(catch->jumpTarget));
Tcl_GetString(block->jumpTarget));
if (entryPtr == NULL) {
Tcl_Panic("undefined label in tclAssembly.c:"
"BuildExceptionRanges, can't happen");
}
errorExit = Tcl_GetHashValue(entryPtr);
errorExit = (BasicBlock*)Tcl_GetHashValue(entryPtr);
range->catchOffset = errorExit->startOffset;
}
}
@@ -4280,7 +4279,7 @@ AddBasicBlockRangeToErrorInfo(
* DupAssembleCodeInternalRep --
*
* Part of the Tcl object type implementation for Tcl assembly language
* bytecode. We do not copy the bytecode intrep. Instead, we return
* bytecode. We do not copy the bytecode internalrep. Instead, we return
* without setting copyPtr->typePtr, so the copy is a plain string copy
* of the assembly source, and if it is to be used as a compiled
* expression, it will need to be reprocessed.
@@ -4289,7 +4288,7 @@ AddBasicBlockRangeToErrorInfo(
* usual (only?) time Tcl_DuplicateObj() will be called is when the copy
* is about to be modified, which would invalidate any copied bytecode
* anyway. The only reason it might make sense to copy the bytecode is if
* we had some modifying routines that operated directly on the intrep,
* we had some modifying routines that operated directly on the internalrep,
* as we do for lists and dicts.
*
* Results:
@@ -4308,6 +4307,7 @@ DupAssembleCodeInternalRep(
{
(void)srcPtr;
(void)copyPtr;
return;
}
@@ -4333,10 +4333,9 @@ static void
FreeAssembleCodeInternalRep(
Tcl_Obj *objPtr)
{
ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
ByteCode *codePtr = (ByteCode *)objPtr->internalRep.twoPtrValue.ptr1;
codePtr->refCount--;
if (codePtr->refCount <= 0) {
if (codePtr->refCount-- <= 1) {
TclCleanupByteCode(codePtr);
}
objPtr->typePtr = NULL;