summaryrefslogtreecommitdiffstats
path: root/generic/tclAssembly.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclAssembly.c')
-rw-r--r--generic/tclAssembly.c105
1 files changed, 52 insertions, 53 deletions
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 120fd9a..5ac9a55 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -32,6 +32,7 @@
#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
+#include <assert.h>
/*
* Structure that represents a range of instructions in the bytecode.
@@ -271,15 +272,12 @@ static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*,
const TalInstDesc*);
static int DefineLabel(AssemblyEnv* envPtr, const char* label);
static void DeleteMirrorJumpTable(JumptableInfo* jtPtr);
-static void DupAssembleCodeInternalRep(Tcl_Obj* src,
- Tcl_Obj* dest);
static void FillInJumpOffsets(AssemblyEnv*);
static int CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
Tcl_Obj* jumpTable);
static int FindLocalVar(AssemblyEnv* envPtr,
Tcl_Token** tokenPtrPtr);
static int FinishAssembly(AssemblyEnv*);
-static void FreeAssembleCodeInternalRep(Tcl_Obj *objPtr);
static void FreeAssemblyEnv(AssemblyEnv*);
static int GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*);
static int GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*);
@@ -318,6 +316,9 @@ static void UnstackExpiredCatches(CompileEnv*, BasicBlock*, int,
* Tcl_ObjType that describes bytecode emitted by the assembler.
*/
+static Tcl_FreeInternalRepProc FreeAssembleCodeInternalRep;
+static Tcl_DupInternalRepProc DupAssembleCodeInternalRep;
+
static const Tcl_ObjType assembleCodeType = {
"assemblecode",
FreeAssembleCodeInternalRep, /* freeIntRepProc */
@@ -847,15 +848,15 @@ 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.
*/
- if (objPtr->typePtr == &assembleCodeType) {
+ ByteCodeGetIntRep(objPtr, &assembleCodeType, codePtr);
+
+ if (codePtr) {
namespacePtr = iPtr->varFramePtr->nsPtr;
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle == iPtr)
&& (codePtr->compileEpoch == iPtr->compileEpoch)
&& (codePtr->nsPtr == namespacePtr)
@@ -869,7 +870,7 @@ CompileAssembleObj(
* Not valid, so free it and regenerate.
*/
- FreeAssembleCodeInternalRep(objPtr);
+ Tcl_StoreIntRep(objPtr, &assembleCodeType, NULL);
}
/*
@@ -894,15 +895,13 @@ CompileAssembleObj(
*/
TclEmitOpcode(INST_DONE, &compEnv);
- TclInitByteCodeObj(objPtr, &compEnv);
- objPtr->typePtr = &assembleCodeType;
+ codePtr = TclInitByteCodeObj(objPtr, &assembleCodeType, &compEnv);
TclFreeCompileEnv(&compEnv);
/*
* Record the local variable context to which the bytecode pertains
*/
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -1304,8 +1303,8 @@ AssembleOneLine(
if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
goto cleanup;
}
- operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
- litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);
+ operand1 = TclGetStringFromObj(operand1Obj, &operand1Len);
+ litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);
BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0);
break;
@@ -1470,8 +1469,8 @@ AssembleOneLine(
&operand1Obj) != TCL_OK) {
goto cleanup;
} else {
- operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
- litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);
+ operand1 = TclGetStringFromObj(operand1Obj, &operand1Len);
+ litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);
/*
* Assumes that PUSH is the first slot!
@@ -1565,7 +1564,7 @@ AssembleOneLine(
* Add the (label_name, address) pair to the hash table.
*/
- if (DefineLabel(assemEnvPtr, Tcl_GetString(operand1Obj)) != TCL_OK) {
+ if (DefineLabel(assemEnvPtr, TclGetString(operand1Obj)) != TCL_OK) {
goto cleanup;
}
break;
@@ -1744,7 +1743,7 @@ AssembleOneLine(
default:
Tcl_Panic("Instruction \"%s\" could not be found, can't happen\n",
- Tcl_GetString(instNameObj));
+ TclGetString(instNameObj));
}
status = TCL_OK;
@@ -2007,15 +2006,15 @@ CreateMirrorJumpTable(
DEBUG_PRINT("jump table {\n");
for (i = 0; i < objc; i+=2) {
- DEBUG_PRINT(" %s -> %s\n", Tcl_GetString(objv[i]),
- Tcl_GetString(objv[i+1]));
- hashEntry = Tcl_CreateHashEntry(jtHashPtr, Tcl_GetString(objv[i]),
+ DEBUG_PRINT(" %s -> %s\n", TclGetString(objv[i]),
+ TclGetString(objv[i+1]));
+ hashEntry = Tcl_CreateHashEntry(jtHashPtr, TclGetString(objv[i]),
&isNew);
if (!isNew) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"duplicate entry in jump table for \"%s\"",
- Tcl_GetString(objv[i])));
+ TclGetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY");
DeleteMirrorJumpTable(jtPtr);
return TCL_ERROR;
@@ -2248,23 +2247,24 @@ GetListIndexOperand(
Tcl_Token* tokenPtr = *tokenPtrPtr;
/* INOUT: Pointer to the next token in the
* source code */
- Tcl_Obj* intObj; /* Integer from the source code */
- int status; /* Tcl status return */
-
- /*
- * Extract the next token as a string.
- */
+ Tcl_Obj *value;
+ int status;
- if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
+ /* General operand validity check */
+ if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &value) != TCL_OK) {
return TCL_ERROR;
}
+ /* Convert to an integer, advance to the next token and return. */
/*
- * Convert to an integer, advance to the next token and return.
+ * NOTE: Indexing a list with an index before it yields the
+ * same result as indexing after it, and might be more easily portable
+ * when list size limits grow.
*/
+ status = TclIndexEncode(interp, value,
+ TCL_INDEX_BEFORE,TCL_INDEX_BEFORE, result);
- status = TclGetIntForIndex(interp, intObj, -2, result);
- Tcl_DecrRefCount(intObj);
+ Tcl_DecrRefCount(value);
*tokenPtrPtr = TokenAfter(tokenPtr);
return status;
}
@@ -2310,7 +2310,7 @@ FindLocalVar(
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {
return -1;
}
- varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen);
+ varNameStr = TclGetStringFromObj(varNameObj, &varNameLen);
if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
Tcl_DecrRefCount(varNameObj);
return -1;
@@ -2823,7 +2823,7 @@ CalculateJumpRelocations(
if (bbPtr->jumpTarget != NULL) {
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(bbPtr->jumpTarget));
+ TclGetString(bbPtr->jumpTarget));
if (entry == NULL) {
ReportUndefinedLabel(assemEnvPtr, bbPtr,
bbPtr->jumpTarget);
@@ -2904,10 +2904,10 @@ CheckJumpTableLabels(
symEntryPtr = Tcl_NextHashEntry(&search)) {
symbolObj = Tcl_GetHashValue(symEntryPtr);
valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(symbolObj));
+ TclGetString(symbolObj));
DEBUG_PRINT(" %s -> %s (%d)\n",
(char*) Tcl_GetHashKey(symHash, symEntryPtr),
- Tcl_GetString(symbolObj), (valEntryPtr != NULL));
+ TclGetString(symbolObj), (valEntryPtr != NULL));
if (valEntryPtr == NULL) {
ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj);
return TCL_ERROR;
@@ -2945,9 +2945,9 @@ ReportUndefinedLabel(
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "undefined label \"%s\"", Tcl_GetString(jumpTarget)));
+ "undefined label \"%s\"", TclGetString(jumpTarget)));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL",
- Tcl_GetString(jumpTarget), NULL);
+ TclGetString(jumpTarget), NULL);
Tcl_SetErrorLine(interp, bbPtr->jumpLine);
}
}
@@ -3030,7 +3030,7 @@ FillInJumpOffsets(
bbPtr = bbPtr->successor1) {
if (bbPtr->jumpTarget != NULL) {
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(bbPtr->jumpTarget));
+ TclGetString(bbPtr->jumpTarget));
jumpTarget = Tcl_GetHashValue(entry);
fromOffset = bbPtr->jumpOffset;
targetOffset = jumpTarget->startOffset;
@@ -3102,17 +3102,17 @@ ResolveJumpTableTargets(
symEntryPtr != NULL;
symEntryPtr = Tcl_NextHashEntry(&search)) {
symbolObj = Tcl_GetHashValue(symEntryPtr);
- DEBUG_PRINT(" symbol %s\n", Tcl_GetString(symbolObj));
+ DEBUG_PRINT(" symbol %s\n", TclGetString(symbolObj));
valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(symbolObj));
+ TclGetString(symbolObj));
jumpTargetBBPtr = Tcl_GetHashValue(valEntryPtr);
realJumpEntryPtr = Tcl_CreateHashEntry(realJumpHashPtr,
Tcl_GetHashKey(symHash, symEntryPtr), &junk);
DEBUG_PRINT(" %s -> %s -> bb %p (pc %d) hash entry %p\n",
(char*) Tcl_GetHashKey(symHash, symEntryPtr),
- Tcl_GetString(symbolObj), jumpTargetBBPtr,
+ TclGetString(symbolObj), jumpTargetBBPtr,
jumpTargetBBPtr->startOffset, realJumpEntryPtr);
Tcl_SetHashValue(realJumpEntryPtr,
@@ -3484,7 +3484,7 @@ StackCheckBasicBlock(
if (result == TCL_OK && blockPtr->jumpTarget != NULL) {
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(blockPtr->jumpTarget));
+ TclGetString(blockPtr->jumpTarget));
jumpTarget = Tcl_GetHashValue(entry);
result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, blockPtr,
stackDepth);
@@ -3501,7 +3501,7 @@ StackCheckBasicBlock(
jtEntry = Tcl_NextHashEntry(&jtSearch)) {
targetLabel = Tcl_GetHashValue(jtEntry);
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(targetLabel));
+ TclGetString(targetLabel));
jumpTarget = Tcl_GetHashValue(entry);
result = StackCheckBasicBlock(assemEnvPtr, jumpTarget,
blockPtr, stackDepth);
@@ -3563,7 +3563,7 @@ StackCheckExit(
* Emit a 'push' of the empty literal.
*/
- litIndex = TclRegisterNewLiteral(envPtr, "", 0);
+ litIndex = TclRegisterLiteral(envPtr, "", 0, 0);
/*
* Assumes that 'push' is at slot 0 in TalInstructionTable.
@@ -3806,7 +3806,7 @@ ProcessCatchesInBasicBlock(
}
if (result == TCL_OK && bbPtr->jumpTarget != NULL) {
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(bbPtr->jumpTarget));
+ TclGetString(bbPtr->jumpTarget));
jumpTarget = Tcl_GetHashValue(entry);
result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
jumpEnclosing, jumpState, catchDepth);
@@ -3822,7 +3822,7 @@ ProcessCatchesInBasicBlock(
jtEntry = Tcl_NextHashEntry(&jtSearch)) {
targetLabel = Tcl_GetHashValue(jtEntry);
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(targetLabel));
+ TclGetString(targetLabel));
jumpTarget = Tcl_GetHashValue(entry);
result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
jumpEnclosing, jumpState, catchDepth);
@@ -4126,7 +4126,7 @@ StackFreshCatches(
range->codeOffset = bbPtr->startOffset;
entryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(catch->jumpTarget));
+ TclGetString(catch->jumpTarget));
if (entryPtr == NULL) {
Tcl_Panic("undefined label in tclAssembly.c:"
"BuildExceptionRanges, can't happen");
@@ -4268,7 +4268,7 @@ AddBasicBlockRangeToErrorInfo(
Tcl_AppendObjToErrorInfo(interp, lineNo);
Tcl_AddErrorInfo(interp, " and ");
if (bbPtr->successor1 != NULL) {
- Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine);
+ TclSetIntObj(lineNo, bbPtr->successor1->startLine);
Tcl_AppendObjToErrorInfo(interp, lineNo);
} else {
Tcl_AddErrorInfo(interp, "end of assembly code");
@@ -4333,13 +4333,12 @@ static void
FreeAssembleCodeInternalRep(
Tcl_Obj *objPtr)
{
- ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ByteCode *codePtr;
- codePtr->refCount--;
- if (codePtr->refCount <= 0) {
- TclCleanupByteCode(codePtr);
- }
- objPtr->typePtr = NULL;
+ ByteCodeGetIntRep(objPtr, &assembleCodeType, codePtr);
+ assert(codePtr != NULL);
+
+ TclReleaseByteCode(codePtr);
}
/*
generated by cgit v0.12 at 2024-11-17 10:06:48 (GMT)