diff options
Diffstat (limited to 'generic/tclExecute.c')
| -rw-r--r-- | generic/tclExecute.c | 256 |
1 files changed, 232 insertions, 24 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 5b42124..ac78370 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2494,9 +2494,12 @@ TEBCresume( TRACE_APPEND(("\n")); goto processExceptionReturn; - case INST_YIELD: { - CoroutineData *corPtr = iPtr->execEnvPtr->corPtr; + { + CoroutineData *corPtr; + int yieldParameter; + case INST_YIELD: + corPtr = iPtr->execEnvPtr->corPtr; TRACE(("%.30s => ", O2S(OBJ_AT_TOS))); if (!corPtr) { TRACE_APPEND(("ERROR: yield outside coroutine\n")); @@ -2510,11 +2513,74 @@ TEBCresume( } #ifdef TCL_COMPILE_DEBUG - TRACE_WITH_OBJ(("yield, result="), iPtr->objResultPtr); - if (traceInstructions) { - fprintf(stdout, "\n"); + if (tclTraceExec >= 2) { + if (traceInstructions) { + TRACE_APPEND(("YIELD...\n")); + } else { + fprintf(stdout, "%d: (%u) yielding value \"%.30s\"\n", + iPtr->numLevels, (unsigned)(pc - codePtr->codeStart), + Tcl_GetString(OBJ_AT_TOS)); + } + fflush(stdout); + } +#endif + yieldParameter = 0; + Tcl_SetObjResult(interp, OBJ_AT_TOS); + goto doYield; + + case INST_YIELD_TO_INVOKE: + corPtr = iPtr->execEnvPtr->corPtr; + valuePtr = OBJ_AT_TOS; + if (!corPtr) { + TRACE(("[%.30s] => ERROR: yield outside coroutine\n", + O2S(valuePtr))); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "yieldto can only be called in a coroutine", -1)); + DECACHE_STACK_INFO(); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", + NULL); + CACHE_STACK_INFO(); + goto gotError; + } + if (((Namespace *)TclGetCurrentNamespace(interp))->flags & NS_DYING) { + TRACE(("[%.30s] => ERROR: yield in deleted\n", + O2S(valuePtr))); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "yieldto called in deleted namespace", -1)); + DECACHE_STACK_INFO(); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", + NULL); + CACHE_STACK_INFO(); + goto gotError; + } + +#ifdef TCL_COMPILE_DEBUG + if (tclTraceExec >= 2) { + if (traceInstructions) { + TRACE(("[%.30s] => YIELD...\n", O2S(valuePtr))); + } else { + /* FIXME: What is the right thing to trace? */ + fprintf(stdout, "%d: (%u) yielding to [%.30s]\n", + iPtr->numLevels, (unsigned)(pc - codePtr->codeStart), + Tcl_GetString(valuePtr)); + } + fflush(stdout); } #endif + + /* + * Install a tailcall record in the caller and continue with the + * yield. The yield is switched into multi-return mode (via the + * 'yieldParameter'). + */ + + Tcl_IncrRefCount(valuePtr); + iPtr->execEnvPtr = corPtr->callerEEPtr; + TclSetTailcall(interp, valuePtr); + iPtr->execEnvPtr = corPtr->eePtr; + yieldParameter = (PTR2INT(NULL)+1); /*==CORO_ACTIVATE_YIELDM*/ + + doYield: /* TIP #280: Record the last piece of info needed by * 'TclGetSrcInfoForPc', and push the frame. */ @@ -2529,11 +2595,8 @@ TEBCresume( pc++; cleanup = 1; TEBC_YIELD(); - - Tcl_SetObjResult(interp, OBJ_AT_TOS); TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - INT2PTR(0), NULL, NULL); - + INT2PTR(yieldParameter), NULL, NULL); return TCL_OK; } @@ -2553,6 +2616,7 @@ TEBCresume( } #ifdef TCL_COMPILE_DEBUG + /* FIXME: What is the right thing to trace? */ { register int i; @@ -4539,6 +4603,7 @@ TEBCresume( Object *oPtr; CallFrame *framePtr; CallContext *contextPtr; + int skip, newDepth; case INST_TCLOO_SELF: framePtr = iPtr->varFramePtr; @@ -4563,9 +4628,111 @@ TEBCresume( TRACE_WITH_OBJ(("=> "), objResultPtr); NEXT_INST_F(1, 0, 1); + case INST_TCLOO_NEXT_CLASS: + opnd = TclGetUInt1AtPtr(pc+1); + framePtr = iPtr->varFramePtr; + valuePtr = OBJ_AT_DEPTH(opnd - 2); + objv = &OBJ_AT_DEPTH(opnd - 1); + skip = 2; + TRACE(("%d => ", opnd)); + if (framePtr == NULL || + !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { + TRACE_APPEND(("ERROR: no TclOO call context\n")); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "nextto may only be called from inside a method", + -1)); + DECACHE_STACK_INFO(); + Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL); + CACHE_STACK_INFO(); + goto gotError; + } + contextPtr = framePtr->clientData; + + oPtr = (Object *) Tcl_GetObjectFromObj(interp, valuePtr); + if (oPtr == NULL) { + TRACE_APPEND(("ERROR: \"%.30s\" not object\n", O2S(valuePtr))); + goto gotError; + } else { + Class *classPtr = oPtr->classPtr; + struct MInvoke *miPtr; + int i; + const char *methodType; + + if (classPtr == NULL) { + TRACE_APPEND(("ERROR: \"%.30s\" not class\n", O2S(valuePtr))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "\"%s\" is not a class", TclGetString(valuePtr))); + DECACHE_STACK_INFO(); + Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", NULL); + CACHE_STACK_INFO(); + goto gotError; + } + + for (i=contextPtr->index+1 ; i<contextPtr->callPtr->numChain ; i++) { + miPtr = contextPtr->callPtr->chain + i; + if (!miPtr->isFilter && + miPtr->mPtr->declaringClassPtr == classPtr) { + newDepth = i; +#ifdef TCL_COMPILE_DEBUG + if (tclTraceExec >= 2) { + if (traceInstructions) { + strncpy(cmdNameBuf, TclGetString(objv[0]), 20); + } else { + fprintf(stdout, "%d: (%u) invoking ", + iPtr->numLevels, + (unsigned)(pc - codePtr->codeStart)); + } + for (i = 0; i < opnd; i++) { + TclPrintObject(stdout, objv[i], 15); + fprintf(stdout, " "); + } + fprintf(stdout, "\n"); + fflush(stdout); + } +#endif /*TCL_COMPILE_DEBUG*/ + goto doInvokeNext; + } + } + + if (contextPtr->callPtr->flags & CONSTRUCTOR) { + methodType = "constructor"; + } else if (contextPtr->callPtr->flags & DESTRUCTOR) { + methodType = "destructor"; + } else { + methodType = "method"; + } + + TRACE_APPEND(("ERROR: \"%.30s\" not on reachable chain\n", + O2S(valuePtr))); + for (i=contextPtr->index ; i>=0 ; 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", + methodType, TclGetString(valuePtr))); + DECACHE_STACK_INFO(); + Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE", + NULL); + CACHE_STACK_INFO(); + goto gotError; + } + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s has no non-filter implementation by \"%s\"", + methodType, TclGetString(valuePtr))); + DECACHE_STACK_INFO(); + Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL); + CACHE_STACK_INFO(); + goto gotError; + } + case INST_TCLOO_NEXT: opnd = TclGetUInt1AtPtr(pc+1); + objv = &OBJ_AT_DEPTH(opnd - 1); framePtr = iPtr->varFramePtr; + skip = 1; TRACE(("%d => ", opnd)); if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { @@ -4580,7 +4747,8 @@ TEBCresume( } contextPtr = framePtr->clientData; - if (contextPtr->index+1 >= contextPtr->callPtr->numChain) { + newDepth = contextPtr->index + 1; + if (newDepth >= contextPtr->callPtr->numChain) { /* * We're at the end of the chain; generate an error message unless * the interpreter is being torn down, in which case we might be @@ -4605,33 +4773,31 @@ TEBCresume( Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL); CACHE_STACK_INFO(); goto gotError; - } - #ifdef TCL_COMPILE_DEBUG - if (tclTraceExec >= 2) { + } else if (tclTraceExec >= 2) { int i; if (traceInstructions) { strncpy(cmdNameBuf, TclGetString(objv[0]), 20); - TRACE(("next_in_chain ")); } else { - fprintf(stdout, "%d: (%u) invoking next_in_chain ", + fprintf(stdout, "%d: (%u) invoking ", iPtr->numLevels, (unsigned)(pc - codePtr->codeStart)); } - for (i = 0; i < objc; i++) { + for (i = 0; i < opnd; i++) { TclPrintObject(stdout, objv[i], 15); fprintf(stdout, " "); } fprintf(stdout, "\n"); fflush(stdout); - } #endif /*TCL_COMPILE_DEBUG*/ + } + doInvokeNext: bcFramePtr->data.tebc.pc = (char *) pc; iPtr->cmdFramePtr = bcFramePtr; if (iPtr->flags & INTERP_DEBUG_FRAME) { - ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv); + ArgumentBCEnter(interp, codePtr, TD, pc, opnd, objv); } pcAdjustment = 2; @@ -4640,6 +4806,7 @@ TEBCresume( iPtr->varFramePtr = framePtr->callerVarPtr; pc += pcAdjustment; TEBC_YIELD(); + oPtr = contextPtr->oPtr; if (oPtr->flags & FILTER_HANDLING) { TclNRAddCallback(interp, FinalizeOONextFilter, @@ -4650,20 +4817,21 @@ TEBCresume( framePtr, contextPtr, INT2PTR(contextPtr->index), INT2PTR(contextPtr->skip)); } - if (contextPtr->callPtr->chain[++contextPtr->index].isFilter + contextPtr->skip = skip; + contextPtr->index = newDepth; + if (contextPtr->callPtr->chain[newDepth].isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) { oPtr->flags |= FILTER_HANDLING; } else { oPtr->flags &= ~FILTER_HANDLING; } - contextPtr->skip = 1; + { register Method *const mPtr = - contextPtr->callPtr->chain[contextPtr->index].mPtr; + contextPtr->callPtr->chain[newDepth].mPtr; return mPtr->typePtr->callProc(mPtr->clientData, interp, - (Tcl_ObjectContext) contextPtr, opnd, - &OBJ_AT_DEPTH(opnd-1)); + (Tcl_ObjectContext) contextPtr, opnd, objv); } case INST_TCLOO_IS_OBJECT: @@ -5642,6 +5810,25 @@ TEBCresume( TclNewIntObj(objResultPtr, match); NEXT_INST_F(1, 2, 1); + + case INST_STR_CLASS: + opnd = TclGetInt1AtPtr(pc+1); + valuePtr = OBJ_AT_TOS; + TRACE(("%s \"%.30s\" => ", tclStringClassTable[opnd].name, + O2S(valuePtr))); + ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length); + match = 1; + if (length > 0) { + end = ustring1 + length; + for (p=ustring1 ; p<end ; p++) { + if (!tclStringClassTable[opnd].comparator(*p)) { + match = 0; + break; + } + } + } + TRACE_APPEND(("%d\n", match)); + JUMP_PEEPHOLE_F(match, 2, 1); } case INST_STR_MATCH: @@ -5776,6 +5963,14 @@ TEBCresume( int type1, type2; long l1, l2, lResult; + case INST_NUM_TYPE: + if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) { + type1 = 0; + } + TclNewIntObj(objResultPtr, type1); + TRACE(("\"%.20s\" => %d\n", O2S(OBJ_AT_TOS), type1)); + NEXT_INST_F(1, 1, 1); + case INST_EQ: case INST_NEQ: case INST_LT: @@ -6453,6 +6648,17 @@ TEBCresume( * ----------------------------------------------------------------- */ + case INST_TRY_CVT_TO_BOOLEAN: + valuePtr = OBJ_AT_TOS; + if (valuePtr->typePtr == &tclBooleanType) { + objResultPtr = TCONST(1); + } else { + int result = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK); + objResultPtr = TCONST(result); + } + TRACE_WITH_OBJ(("\"%.30s\" => ", O2S(valuePtr)), objResultPtr); + NEXT_INST_F(1, 0, 1); + case INST_BREAK: /* DECACHE_STACK_INFO(); @@ -9411,10 +9617,12 @@ IllegalExprOperandType( ClientData ptr; int type; const unsigned char opcode = *pc; - const char *description, *operator = operatorStrings[opcode - INST_LOR]; + const char *description, *operator = "unknown"; if (opcode == INST_EXPON) { operator = "**"; + } else if (opcode <= INST_STR_NEQ) { + operator = operatorStrings[opcode - INST_LOR]; } if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) { |