Index: generic/nsf.c =================================================================== diff -u -raf4c49445c888e9b52f1563d5dea90f39373722a -rb604626384c5692394df7e276ac9c10e6229dbfd --- generic/nsf.c (.../nsf.c) (revision af4c49445c888e9b52f1563d5dea90f39373722a) +++ generic/nsf.c (.../nsf.c) (revision b604626384c5692394df7e276ac9c10e6229dbfd) @@ -15039,6 +15039,8 @@ result = "configure"; } else if (proc == NsfOVolatileMethodStub) { result = "volatile"; + } else if (proc == NsfOVolatile1MethodStub) { + result = "volatile"; } else if (proc == NsfOAutonameMethodStub) { result = "autoname"; } else if (proc == NsfOUplevelMethodStub) { @@ -16330,6 +16332,47 @@ return TCL_OK; } +#ifdef NSF_WITH_TCL_OBJ_TYPES_AS_CONVERTER +int Nsf_ConvertToTclObjType(Tcl_Interp *interp, Tcl_Obj *objPtr, const Nsf_Param *pPtr, + ClientData *clientData, Tcl_Obj **UNUSED(outObjPtr)) + nonnull(1) nonnull(2) nonnull(3) nonnull(4) nonnull(5); + +int +Nsf_ConvertToTclObjType(Tcl_Interp *interp, Tcl_Obj *objPtr, const Nsf_Param *pPtr, + ClientData *clientData, Tcl_Obj **outObjPtr) { + int result = TCL_OK; + + nonnull_assert(interp != NULL); + nonnull_assert(objPtr != NULL); + nonnull_assert(pPtr != NULL); + nonnull_assert(clientData != NULL); + + fprintf(stderr, "Nsf_ConvertToTclObjType: converterArg %p\n", (void*)pPtr->converterArg); + if (unlikely(pPtr->converterArg != NULL)) { + const Tcl_ObjType *tclObjType = pPtr->converterArg->internalRep.twoPtrValue.ptr1; + + if (tclObjType != NULL) { + result = Tcl_ConvertToType(interp, objPtr, tclObjType); + fprintf(stderr, "Nsf_ConvertToTclObjType:type %p -> %d\n", (void*)tclObjType, result); + + if (result != TCL_OK) { + Tcl_ResetResult(interp); + result = NsfObjErrType(interp, NULL, objPtr, tclObjType->name, (Nsf_Param *)pPtr); + } + } + } + *outObjPtr = objPtr; + /* + nsf::proc foo {a:ns:mem_unit} {return $a} + nsf::proc bar {a:ns:mem_unit} {return [expr {$a + 1}]} + foo 1kB + foo xxx + bar 1kB + */ + return result; +} +#endif + /* *---------------------------------------------------------------------- * Nsf_ConvertToTclobj -- @@ -17414,6 +17457,9 @@ result = ParamOptionSetConverter(interp, paramPtr, option, ConvertToNothing); } else { Tcl_DString ds, *dsPtr = &ds; +#ifdef NSF_WITH_TCL_OBJ_TYPES_AS_CONVERTER + const Tcl_ObjType *tclObjType; +#endif if (option[0] == '\0') { NsfLog(interp, NSF_LOG_WARN, "empty parameter option ignored"); @@ -17430,13 +17476,27 @@ return TCL_ERROR; } + /*fprintf(stderr, "HAV TYPE converter for <%s> ?\n", option);*/ + if (Nsf_PointerTypeLookup(Tcl_DStringValue(dsPtr))) { /* * Check whether the option refers to a pointer converter. */ ParamOptionSetConverter(interp, paramPtr, Tcl_DStringValue(dsPtr), Nsf_ConvertToPointer); Tcl_DStringFree(dsPtr); +#ifdef NSF_WITH_TCL_OBJ_TYPES_AS_CONVERTER + } else if ((tclObjType = Tcl_GetObjType(option)) != NULL) { + // xxxxxx + fprintf(stderr, "SET TYPE converter for <%s>\n", option); + result = ParamOptionSetConverter(interp, paramPtr, Tcl_DStringValue(dsPtr), Nsf_ConvertToTclObjType); + if (paramPtr->converterArg != NULL) { + DECR_REF_COUNT(paramPtr->converterArg); + } + paramPtr->converterArg = Tcl_NewObj(); + paramPtr->converterArg->internalRep.twoPtrValue.ptr1 = (void *)tclObjType; + INCR_REF_COUNT(paramPtr->converterArg); +#endif } else { int i, found = -1; @@ -18639,7 +18699,7 @@ /* fprintf(stderr, "NsfProcStubDeleteProc received %p\n", clientData); fprintf(stderr, "... procName %s paramDefs %p\n", ObjStr(tcd->procName), tcd->paramDefs);*/ - + DECR_REF_COUNT2("procNameObj", tcd->procName); if (tcd->cmd != NULL) { /* NsfCommandRelease(tcd->cmd); */ @@ -18738,7 +18798,7 @@ } #if defined(NRE) - /* fprintf(stderr, "CALL TclNRInterpProcCore proc '%s' %s nameObj %p %s\n", + /* fprintf(stderr, "CALL TclNRInterpProcCore proc '%s' %s nameObj %p %s\n", ObjStr(objv[0]), fullMethodName, procNameObj, ObjStr(procNameObj)); */ Tcl_NRAddCallback(interp, ProcDispatchFinalize, @@ -18790,38 +18850,38 @@ nonnull_assert(objv != NULL); tcd = clientData; - + /*fprintf(stderr, "NsfProcStub %s is called, tcd %p, paramDefs %p\n", ObjStr(objv[0]), tcd, tcd ? tcd->paramDefs : NULL);*/ if ((((unsigned int)Tcl_Command_flags(tcd->cmd) & CMD_IS_DELETED) == 0u) || Tcl_Command_cmdEpoch(tcd->cmd) != 0) { /* * It seems as if the (cached) command was deleted (e.g., rename), or * someone messed around with the shadowed proc. - * + * * We must refetch the command ... */ - + Tcl_Command newCmdPtr = Tcl_GetCommandFromObj(interp, tcd->procName); - + if (unlikely(newCmdPtr == NULL)) { return NsfPrintError(interp, "cannot lookup command '%s'", ObjStr(tcd->procName)); } - + if (unlikely(!CmdIsProc(newCmdPtr))) { return NsfPrintError(interp, "command '%s' is not a proc", ObjStr(tcd->procName)); } - + /* * ... and update the refCounts and cmd in ClientData */ NsfCommandRelease(tcd->cmd); tcd->cmd = newCmdPtr; NsfCommandPreserve(tcd->cmd); } - + assert(tcd->cmd != NULL); pcPtr = (ParseContext *) NsfTclStackAlloc(interp, sizeof(ParseContext), @@ -18880,11 +18940,11 @@ trt.usec = 0; } #endif - + if ((cmdFlags & NSF_CMD_DEPRECATED_METHOD) != 0u) { NsfDeprecatedCmd(interp, "proc", ObjStr(objv[0]), ""); } - + result = InvokeShadowedProc(interp, tcd->procName, tcd->cmd, pcPtr, &trt, cmdFlags, Tcl_Command_nsPtr(cmd)); @@ -19087,7 +19147,7 @@ Tcl_Command procCmd = Tcl_GetCommandFromObj(interp, procNameObj); assert(procCmd != NULL); - + tcd->cmd = procCmd; NsfCommandPreserve(tcd->cmd); @@ -32246,13 +32306,15 @@ /* objectMethod volatile NsfOVolatileMethod { } +objectMethod volatile1 NsfOVolatile1Method { +} */ static int -NsfOVolatileMethod(Tcl_Interp *interp, NsfObject *object) { - int result = TCL_ERROR; - Tcl_Obj *objPtr; - const char *fullName, *vn; - callFrameContext ctx = {NULL, NULL, 0}; +VolatileMethod(Tcl_Interp *interp, NsfObject *object, bool shallow) { + int result = TCL_ERROR; + Tcl_Obj *objPtr; + const char *fullName, *vn; + callFrameContext ctx = {NULL, NULL, 0}; nonnull_assert(interp != NULL); nonnull_assert(object != NULL); @@ -32261,8 +32323,70 @@ return NsfPrintError(interp, "can't make objects volatile during shutdown"); } - CallStackUseActiveFrame(interp, &ctx); + if (shallow) { + CallStackUseActiveFrame(interp, &ctx); + } else { + NsfObjectSystem *osPtr = GetObjectSystem(object); + Tcl_CallFrame *invocationFrame; + + /* + * XOTcl1 style + */ + /*NsfShowStack(interp);*/ + + CallStackUseActiveFrame(interp, &ctx); + + /*fprintf(stderr, "active varframe %p\n", (void*)Tcl_Interp_varFramePtr(interp));*/ + invocationFrame = (Tcl_CallFrame *)Tcl_Interp_varFramePtr(interp); + + while (1) { + + if (((unsigned int)Tcl_CallFrame_isProcCallFrame(invocationFrame) & (FRAME_IS_NSF_METHOD|FRAME_IS_NSF_CMETHOD)) != 0u) { + NsfCallStackContent *cscPtr; + + cscPtr = ((NsfCallStackContent *)Tcl_CallFrame_clientData(invocationFrame)); + /* + * We were not called from a NSF frame. + */ + if (cscPtr == NULL) { + break; + } + + + /* + * Walk up the stack of this objects invocations. This skips + * e.g. overloaded internally called methods like "configure". + */ + /*fprintf(stderr, "compare object %p == %p\n", (void*)object, (void*)cscPtr->self);*/ + if (cscPtr->self == object) { + invocationFrame = Tcl_CallFrame_callerPtr(invocationFrame); + /*fprintf(stderr, "same object, continue with %p\n", (void*)invocationFrame);*/ + continue; + } + + /* + * Final special case to achieve better XOTcl1 compliance: In case, we + * were called from an "unknown" method, skip this frame as well. + */ + /*fprintf(stderr, "cmd %s\n", Tcl_GetCommandName(interp, cscPtr->cmdPtr));*/ + if (strcmp(osPtr->methodNames[NSF_o_unknown_idx], Tcl_GetCommandName(interp, cscPtr->cmdPtr)) == 0) { + invocationFrame = Tcl_CallFrame_callerPtr(invocationFrame); + /*fprintf(stderr, "have unknown, continue with %p\n", (void*)invocationFrame);*/ + continue; + + } + } + break; + } + /* + * Finally, set the invocation frame. The original frame context was saved + * already by CallStackUseActiveFrame() and will be properly restored. + */ + Tcl_Interp_varFramePtr(interp) = (CallFrame *)invocationFrame; + + } + objPtr = object->cmdName; fullName = ObjStr(objPtr); vn = NSTail(fullName); @@ -32286,6 +32410,18 @@ return result; } +static int +NsfOVolatileMethod(Tcl_Interp *interp, NsfObject *object) { + + return VolatileMethod(interp, object, NSF_TRUE); +} + +static int +NsfOVolatile1Method(Tcl_Interp *interp, NsfObject *object) { + + return VolatileMethod(interp, object, NSF_FALSE); +} + /*********************************************************************** * End Object Methods ***********************************************************************/ Index: generic/nsf.h =================================================================== diff -u -r625e5b42ce67fb5b427852f477e9dac8746e8025 -rb604626384c5692394df7e276ac9c10e6229dbfd --- generic/nsf.h (.../nsf.h) (revision 625e5b42ce67fb5b427852f477e9dac8746e8025) +++ generic/nsf.h (.../nsf.h) (revision b604626384c5692394df7e276ac9c10e6229dbfd) @@ -126,6 +126,7 @@ /* Experimental language feature #define NSF_WITH_INHERIT_NAMESPACES 1 +#define NSF_WITH_TCL_OBJ_TYPES_AS_CONVERTER 1 */ #define NSF_WITH_OS_RESOLVER 1 Index: generic/nsfAPI.decls =================================================================== diff -u -r1919d17fefad9446170fa6d532b439f494189b32 -rb604626384c5692394df7e276ac9c10e6229dbfd --- generic/nsfAPI.decls (.../nsfAPI.decls) (revision 1919d17fefad9446170fa6d532b439f494189b32) +++ generic/nsfAPI.decls (.../nsfAPI.decls) (revision b604626384c5692394df7e276ac9c10e6229dbfd) @@ -419,6 +419,9 @@ objectMethod volatile NsfOVolatileMethod { } +objectMethod volatile1 NsfOVolatile1Method { +} + # # class methods # Index: generic/nsfAPI.h =================================================================== diff -u -r1919d17fefad9446170fa6d532b439f494189b32 -rb604626384c5692394df7e276ac9c10e6229dbfd --- generic/nsfAPI.h (.../nsfAPI.h) (revision 1919d17fefad9446170fa6d532b439f494189b32) +++ generic/nsfAPI.h (.../nsfAPI.h) (revision b604626384c5692394df7e276ac9c10e6229dbfd) @@ -281,7 +281,7 @@ /* just to define the symbol */ -static Nsf_methodDefinition method_definitions[120]; +static Nsf_methodDefinition method_definitions[121]; static const char *method_command_namespace_names[] = { "::nsf::methods::object::info", @@ -477,6 +477,8 @@ NSF_nonnull(1) NSF_nonnull(2) NSF_nonnull(4); static int NsfOUpvarMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv) NSF_nonnull(1) NSF_nonnull(2) NSF_nonnull(4); +static int NsfOVolatile1MethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv) + NSF_nonnull(1) NSF_nonnull(2) NSF_nonnull(4); static int NsfOVolatileMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv) NSF_nonnull(1) NSF_nonnull(2) NSF_nonnull(4); static int NsfObjInfoBaseclassMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv) @@ -716,6 +718,8 @@ NSF_nonnull(1) NSF_nonnull(2); static int NsfOUpvarMethod(Tcl_Interp *interp, NsfObject *object, int objc, Tcl_Obj *const* objv) NSF_nonnull(1) NSF_nonnull(2); +static int NsfOVolatile1Method(Tcl_Interp *interp, NsfObject *object) + NSF_nonnull(1) NSF_nonnull(2); static int NsfOVolatileMethod(Tcl_Interp *interp, NsfObject *object) NSF_nonnull(1) NSF_nonnull(2); static int NsfObjInfoBaseclassMethod(Tcl_Interp *interp, NsfObject *object) @@ -862,6 +866,7 @@ NsfOResidualargsMethodIdx, NsfOUplevelMethodIdx, NsfOUpvarMethodIdx, + NsfOVolatile1MethodIdx, NsfOVolatileMethodIdx, NsfObjInfoBaseclassMethodIdx, NsfObjInfoChildrenMethodIdx, @@ -3086,6 +3091,26 @@ } static int +NsfOVolatile1MethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv) { + NsfObject *object; + + NSF_nonnull_assert(clientData != NULL); + assert(objc > 0); + + object = (NsfObject *)clientData; + + + if (unlikely(objc != 1)) { + return NsfArgumentError(interp, "too many arguments:", + method_definitions[NsfOVolatile1MethodIdx].paramDefs, + NULL, objv[0]); + } + + return NsfOVolatile1Method(interp, object); + +} + +static int NsfOVolatileMethodStub(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const* objv) { NsfObject *object; @@ -3715,7 +3740,7 @@ } } -static Nsf_methodDefinition method_definitions[120] = { +static Nsf_methodDefinition method_definitions[121] = { {"::nsf::methods::class::alloc", NsfCAllocMethodStub, 1, { {"objectName", NSF_ARG_REQUIRED, 1, Nsf_ConvertTo_Tclobj, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, @@ -4132,6 +4157,9 @@ {"::nsf::methods::object::upvar", NsfOUpvarMethodStub, 1, { {"args", 0, 1, ConvertToNothing, NULL,NULL,"allargs",NULL,NULL,NULL,NULL,NULL}} }, +{"::nsf::methods::object::volatile1", NsfOVolatile1MethodStub, 0, { + {NULL, 0, 0, NULL, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} +}, {"::nsf::methods::object::volatile", NsfOVolatileMethodStub, 0, { {NULL, 0, 0, NULL, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL}} }, Index: library/xotcl/library/xotcl2.tcl =================================================================== diff -u -rf7b560fcf16d625dfa38b9e9533f9014ba9a3ca7 -rb604626384c5692394df7e276ac9c10e6229dbfd --- library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision f7b560fcf16d625dfa38b9e9533f9014ba9a3ca7) +++ library/xotcl/library/xotcl2.tcl (.../xotcl2.tcl) (revision b604626384c5692394df7e276ac9c10e6229dbfd) @@ -127,7 +127,7 @@ # ::nsf::method::alias Object unknown ::nsf::methods::object::unknown ::nsf::method::alias Object uplevel ::nsf::methods::object::uplevel ::nsf::method::alias Object upvar ::nsf::methods::object::upvar - ::nsf::method::alias Object volatile ::nsf::methods::object::volatile + ::nsf::method::alias Object volatile ::nsf::methods::object::volatile1 # # object methods