Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | NRE-aware TclOO. |
---|---|
Downloads: | Tarball | ZIP archive |
Timelines: | family | ancestors | descendants | both | trunk | potential incompatibility |
Files: | files | file ages | folders |
SHA1: |
a8d83acd188df8a873518f5d731cf8ce |
User & Date: | dkf 2008-07-16 22:08:59.000 |
Context
2008-07-16
| ||
23:31 | * win/tclWinThrd.c: Test for TLS_OUT_OF_INDEXES to make certain that thread key creation is successf... check-in: fc0e0a02ad user: georgeps tags: trunk | |
22:08 | NRE-aware TclOO. check-in: a8d83acd18 user: dkf tags: trunk, potential incompatibility | |
00:44 |
* tests/NRE.test: better constraint for testing the * tests/stack.test: existence of teststack...check-in: 41e62e1505 user: msofer tags: trunk | |
Changes
Changes to ChangeLog.
1 2 | 2008-07-15 Miguel Sofer <[email protected]> | > > > > > > > > > > > > | | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 | 2008-07-16 Donal K. Fellows <[email protected]> * generic/tclOO.c, generic/tclOOInt.h, generic/tclOOBasic.c: * generic/tclOOCall.c, generic/tclOOMethod.c: NRE-enable the TclOO implementation in Tcl. No change to public APIs, except that method implementations can now be NRE-aware if they choose (which normal methods and forwards are). On the other hand, callers of TclOOInvokeObject (which is only in the internal stub table) will need to deal with the fact that it's only safe to call inside an NRE-aware context. ***POTENTIAL INCOMPATIBILITY*** 2008-07-15 Miguel Sofer <[email protected]> * tests/NRE.test: Better constraint for testing the existence of * tests/stack.test: teststacklimit, to insure that the test suite runs under tclsh. * generic/tclParse.c: fixing incomplete reversion of "fix" for [Bug 2017583], missing TclResetCancellation call. 2008-07-15 Donal K. Fellows <[email protected]> * generic/tclBasic.c (Tcl_CancelEval): Fix blunder. [Bug 2018603] * doc/DictObj.3: Fix error in example. [Bug 2016740] * generic/tclNamesp.c (EnsembleUnknownCallback): Factor out some of the more complex parts of the ensemble code to make it easier to understand and hence to permit tighter compilation of code on the critical path. 2008-07-14 Miguel Sofer <[email protected]> * generic/tclParse.c: Reverting the "fix" for [Bug 2017583], numLevel * tests/parse.test: management and TclInterpReady check seems to be necessary after all. 2008-07-14 Donal K. Fellows <[email protected]> * generic/tclProc.c (TclNRApplyObjCmd, TclObjInterpProcCore): * generic/tclBasic.c (TclNR_AddCallback, TclEvalObjv_NR2): * generic/tclNRE.h (TEOV_callback): Change the callback storage type to use an array, so guaranteeing correct inter-member spacing and |
︙ | ︙ |
Changes to generic/tclOO.c.
1 2 3 4 5 6 7 8 9 10 | /* * tclOO.c -- * * This file contains the object-system core (NB: not Tcl_Obj, but ::oo) * * Copyright (c) 2005-2008 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | /* * tclOO.c -- * * This file contains the object-system core (NB: not Tcl_Obj, but ::oo) * * Copyright (c) 2005-2008 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclOO.c,v 1.10 2008/07/16 22:09:00 dkf Exp $ */ #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "tclInt.h" #include "tclOOInt.h" |
︙ | ︙ | |||
66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 | static Object * AllocObject(Tcl_Interp *interp, const char *nameStr, const char *nsNameStr); static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr, Method *mPtr, Tcl_Obj *namePtr, Method **newMPtrPtr); static int CloneObjectMethod(Tcl_Interp *interp, Object *oPtr, Method *mPtr, Tcl_Obj *namePtr); static void InitFoundation(Tcl_Interp *interp); static void KillFoundation(ClientData clientData, Tcl_Interp *interp); static void ObjectNamespaceDeleted(ClientData clientData); static void ObjectRenamedTrace(ClientData clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); static void ReleaseClassContents(Tcl_Interp *interp,Object *oPtr); static int PublicObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int PrivateObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); /* * Methods in the oo::object and oo::class classes. First, we define a helper * macro that makes building the method type declaration structure a lot * easier. No point in making life harder than it has to be! * | > > > > > > > > > > | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 | static Object * AllocObject(Tcl_Interp *interp, const char *nameStr, const char *nsNameStr); static int CloneClassMethod(Tcl_Interp *interp, Class *clsPtr, Method *mPtr, Tcl_Obj *namePtr, Method **newMPtrPtr); static int CloneObjectMethod(Tcl_Interp *interp, Object *oPtr, Method *mPtr, Tcl_Obj *namePtr); static int FinalizeNext(ClientData data[], Tcl_Interp *interp, int result); static int FinalizeObjectCall(ClientData data[], Tcl_Interp *interp, int result); static void InitFoundation(Tcl_Interp *interp); static void KillFoundation(ClientData clientData, Tcl_Interp *interp); static void ObjectNamespaceDeleted(ClientData clientData); static void ObjectRenamedTrace(ClientData clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); static void ReleaseClassContents(Tcl_Interp *interp,Object *oPtr); static int PublicObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int PublicNRObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int PrivateObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); static int PrivateNRObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv); /* * Methods in the oo::object and oo::class classes. First, we define a helper * macro that makes building the method type declaration structure a lot * easier. No point in making life harder than it has to be! * |
︙ | ︙ | |||
472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 | oPtr->command = Tcl_CreateObjCommand(interp, nameStr, PublicObjectCmd, oPtr, NULL); } } else { oPtr->command = Tcl_CreateObjCommand(interp, oPtr->namespacePtr->fullName, PublicObjectCmd, oPtr, NULL); } /* * Access the namespace command table directly when creating "my" to avoid * a bottleneck in string manipulation. */ { register Command *cmdPtr = (Command *) ckalloc(sizeof(Command)); memset(cmdPtr, 0, sizeof(Command)); cmdPtr->nsPtr = (Namespace *) oPtr->namespacePtr; cmdPtr->hPtr = Tcl_CreateHashEntry(&cmdPtr->nsPtr->cmdTable, "my", &creationEpoch /*ignored*/ ); cmdPtr->refCount = 1; cmdPtr->objProc = PrivateObjectCmd; cmdPtr->objClientData = oPtr; cmdPtr->proc = TclInvokeObjectCommand; cmdPtr->clientData = cmdPtr; Tcl_SetHashValue(cmdPtr->hPtr, cmdPtr); } Tcl_TraceCommand(interp, TclGetString(TclOOObjectName(interp, oPtr)), TCL_TRACE_RENAME|TCL_TRACE_DELETE, ObjectRenamedTrace, oPtr); return oPtr; | > > | 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 | oPtr->command = Tcl_CreateObjCommand(interp, nameStr, PublicObjectCmd, oPtr, NULL); } } else { oPtr->command = Tcl_CreateObjCommand(interp, oPtr->namespacePtr->fullName, PublicObjectCmd, oPtr, NULL); } ((Command *) oPtr->command)->nreProc = PublicNRObjectCmd; /* * Access the namespace command table directly when creating "my" to avoid * a bottleneck in string manipulation. */ { register Command *cmdPtr = (Command *) ckalloc(sizeof(Command)); memset(cmdPtr, 0, sizeof(Command)); cmdPtr->nsPtr = (Namespace *) oPtr->namespacePtr; cmdPtr->hPtr = Tcl_CreateHashEntry(&cmdPtr->nsPtr->cmdTable, "my", &creationEpoch /*ignored*/ ); cmdPtr->refCount = 1; cmdPtr->objProc = PrivateObjectCmd; cmdPtr->objClientData = oPtr; cmdPtr->proc = TclInvokeObjectCommand; cmdPtr->clientData = cmdPtr; cmdPtr->nreProc = PrivateNRObjectCmd; Tcl_SetHashValue(cmdPtr->hPtr, cmdPtr); } Tcl_TraceCommand(interp, TclGetString(TclOOObjectName(interp, oPtr)), TCL_TRACE_RENAME|TCL_TRACE_DELETE, ObjectRenamedTrace, oPtr); return oPtr; |
︙ | ︙ | |||
554 555 556 557 558 559 560 | if (contextPtr != NULL) { int result; Tcl_InterpState state; contextPtr->callPtr->flags |= DESTRUCTOR; contextPtr->skip = 0; state = Tcl_SaveInterpState(interp, TCL_OK); | > | | 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 | if (contextPtr != NULL) { int result; Tcl_InterpState state; contextPtr->callPtr->flags |= DESTRUCTOR; contextPtr->skip = 0; state = Tcl_SaveInterpState(interp, TCL_OK); result = TclNR_CallObjProc(interp, TclOOInvokeContext, contextPtr, 0, NULL); if (result != TCL_OK) { Tcl_BackgroundError(interp); } Tcl_RestoreInterpState(interp, state); TclOODeleteContext(contextPtr); } } |
︙ | ︙ | |||
1239 1240 1241 1242 1243 1244 1245 | int result; Tcl_InterpState state; AddRef(oPtr); state = Tcl_SaveInterpState(interp, TCL_OK); contextPtr->callPtr->flags |= CONSTRUCTOR; contextPtr->skip = skip; | > | | 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 | int result; Tcl_InterpState state; AddRef(oPtr); state = Tcl_SaveInterpState(interp, TCL_OK); contextPtr->callPtr->flags |= CONSTRUCTOR; contextPtr->skip = skip; result = TclNR_CallObjProc(interp, TclOOInvokeContext, contextPtr, objc, objv); TclOODeleteContext(contextPtr); DelRef(oPtr); if (result != TCL_OK) { Tcl_DiscardInterpState(state); Tcl_DeleteCommandFromToken(interp, oPtr->command); return NULL; } |
︙ | ︙ | |||
1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 | static int PublicObjectCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { return TclOOObjectCmdCore(clientData, interp, objc, objv, PUBLIC_METHOD, NULL); } static int PrivateObjectCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { return TclOOObjectCmdCore(clientData, interp, objc, objv, 0, NULL); } | > > > > > > > > > > > > > > > > > > > > | 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 | static int PublicObjectCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { return TclNR_CallObjProc(interp, PublicNRObjectCmd, clientData,objc,objv); } static int PublicNRObjectCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { return TclOOObjectCmdCore(clientData, interp, objc, objv, PUBLIC_METHOD, NULL); } static int PrivateObjectCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { return TclNR_CallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv); } static int PrivateNRObjectCmd( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { return TclOOObjectCmdCore(clientData, interp, objc, objv, 0, NULL); } |
︙ | ︙ | |||
1898 1899 1900 1901 1902 1903 1904 | break; } } if (contextPtr->index >= contextPtr->callPtr->numChain) { result = TCL_ERROR; Tcl_SetResult(interp, "no valid method implementation", TCL_STATIC); | | | > | > > > > > > > > > > < | | > | 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 | break; } } if (contextPtr->index >= contextPtr->callPtr->numChain) { result = TCL_ERROR; Tcl_SetResult(interp, "no valid method implementation", TCL_STATIC); TclOODeleteContext(contextPtr); return TCL_ERROR; } } /* * Invoke the call chain, locking the object structure against deletion * for the duration. */ AddRef(oPtr); TclNR_AddCallback(interp, FinalizeObjectCall, contextPtr,oPtr, NULL,NULL); return TclOOInvokeContext(contextPtr, interp, objc, objv); } static int FinalizeObjectCall( ClientData data[], Tcl_Interp *interp, int result) { register CallContext *contextPtr = data[0]; register Object *oPtr = data[1]; /* * Dispose of the call chain and drop the lock on the object's structure. */ TclOODeleteContext(contextPtr); DelRef(oPtr); return result; } /* * ---------------------------------------------------------------------- * * Tcl_ObjectContextInvokeNext, TclNRObjectContextInvokeNext -- * * Invokes the next stage of the call chain described in an object * context. This is the core of the implementation of the [next] command. * Does not do management of the call-frame stack. Available in public * (standard API) and private (NRE-aware) forms. * * ---------------------------------------------------------------------- */ int Tcl_ObjectContextInvokeNext( Tcl_Interp *interp, |
︙ | ︙ | |||
1983 1984 1985 1986 1987 1988 1989 | contextPtr->index++; contextPtr->skip = skip; /* * Invoke the (advanced) method call context in the caller context. */ | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 | contextPtr->index++; contextPtr->skip = skip; /* * Invoke the (advanced) method call context in the caller context. */ result = TclNR_CallObjProc(interp, TclOOInvokeContext, contextPtr, objc, objv); /* * Restore the call chain context index as we've finished the inner invoke * and want to operate in the outer context again. */ contextPtr->index = savedIndex; contextPtr->skip = savedSkip; return result; } int TclNRObjectContextInvokeNext( Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip) { register CallContext *contextPtr = (CallContext *) context; if (contextPtr->index+1 >= contextPtr->callPtr->numChain) { /* * We're at the end of the chain; generate an error message. */ const char *methodType; if (contextPtr->callPtr->flags & CONSTRUCTOR) { methodType = "constructor"; } else if (contextPtr->callPtr->flags & DESTRUCTOR) { methodType = "destructor"; } else { methodType = "method"; } Tcl_AppendResult(interp, "no next ", methodType, " implementation", NULL); return TCL_ERROR; } /* * Advance to the next method implementation in the chain in the method * call context while we process the body. However, need to adjust the * argument-skip control because we're guaranteed to have a single prefix * arg (i.e., 'next') and not the variable amount that can happen because * method invokations (i.e., '$obj meth' and 'my meth'), constructors * (i.e., '$cls new' and '$cls create obj') and destructors (no args at * all) come through the same code. */ TclNR_AddCallback(interp, FinalizeNext, contextPtr, INT2PTR(contextPtr->index), INT2PTR(contextPtr->skip), NULL); contextPtr->index++; contextPtr->skip = skip; /* * Invoke the (advanced) method call context in the caller context. */ return TclOOInvokeContext(contextPtr, interp, objc, objv); } static int FinalizeNext( ClientData data[], Tcl_Interp *interp, int result) { CallContext *contextPtr = data[0]; /* * Restore the call chain context index as we've finished the inner invoke * and want to operate in the outer context again. */ contextPtr->index = PTR2INT(data[1]); contextPtr->skip = PTR2INT(data[2]); return result; } /* * ---------------------------------------------------------------------- * * Tcl_GetObjectFromObj -- * * Utility function to get an object from a Tcl_Obj containing its name. |
︙ | ︙ |
Changes to generic/tclOOBasic.c.
1 2 3 4 5 6 7 8 9 10 11 | /* * tclOOBasic.c -- * * This file contains implementations of the "simple" commands and * methods from the object-system core. * * Copyright (c) 2005-2008 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | /* * tclOOBasic.c -- * * This file contains implementations of the "simple" commands and * methods from the object-system core. * * Copyright (c) 2005-2008 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclOOBasic.c,v 1.2 2008/07/16 22:09:01 dkf Exp $ */ #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "tclInt.h" #include "tclOOInt.h" static int RestoreFrame(ClientData data[], Tcl_Interp *interp, int result); /* * ---------------------------------------------------------------------- * * TclOO_Class_Create -- * * Implementation for oo::class->create method. |
︙ | ︙ | |||
577 578 579 580 581 582 583 | Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; CallFrame *framePtr = iPtr->varFramePtr; Tcl_ObjectContext context; | < > | > > > > > > > > > > | | 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 | Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) { Interp *iPtr = (Interp *) interp; CallFrame *framePtr = iPtr->varFramePtr; Tcl_ObjectContext context; /* * Start with sanity checks on the calling context to make sure that we * are invoked from a suitable method context. If so, we can safely * retrieve the handle to the object call context. */ if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) { Tcl_AppendResult(interp, TclGetString(objv[0]), " may only be called from inside a method", NULL); return TCL_ERROR; } context = framePtr->clientData; /* * Invoke the (advanced) method call context in the caller context. Note * that this is like [uplevel 1] and not [eval]. */ TclNR_AddCallback(interp, RestoreFrame, framePtr, NULL, NULL, NULL); iPtr->varFramePtr = framePtr->callerVarPtr; return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1); } static int RestoreFrame( ClientData data[], Tcl_Interp *interp, int result) { Interp *iPtr = (Interp *) interp; iPtr->varFramePtr = data[0]; return result; } /* * ---------------------------------------------------------------------- * * TclOOSelfObjCmd -- |
︙ | ︙ |
Changes to generic/tclOOCall.c.
1 2 3 4 5 6 7 8 9 10 11 | /* * tclOOCall.c -- * * This file contains the method call chain management code for the * object-system core. * * Copyright (c) 2005-2008 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | /* * tclOOCall.c -- * * This file contains the method call chain management code for the * object-system core. * * Copyright (c) 2005-2008 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclOOCall.c,v 1.8 2008/07/16 22:09:02 dkf Exp $ */ #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "tclInt.h" #include "tclOOInt.h" |
︙ | ︙ | |||
62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 | static void AddSimpleClassChainToCallContext(Class *classPtr, Tcl_Obj *const methodNameObj, struct ChainBuilder *const cbPtr, Tcl_HashTable *const doneFilters, int flags, Class *const filterDecl); static int CmpStr(const void *ptr1, const void *ptr2); static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr); static void FreeMethodNameRep(Tcl_Obj *objPtr); static inline int IsStillValid(CallChain *callPtr, Object *oPtr, int flags, int reuseMask); static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr); /* * Object type used to manage type caches attached to method names. */ static Tcl_ObjType methodNameType = { | > > > > > > | 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | static void AddSimpleClassChainToCallContext(Class *classPtr, Tcl_Obj *const methodNameObj, struct ChainBuilder *const cbPtr, Tcl_HashTable *const doneFilters, int flags, Class *const filterDecl); static int CmpStr(const void *ptr1, const void *ptr2); static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr); static int FinalizeMethodRefs(ClientData data[], Tcl_Interp *interp, int result); static void FreeMethodNameRep(Tcl_Obj *objPtr); static inline int IsStillValid(CallChain *callPtr, Object *oPtr, int flags, int reuseMask); static int ResetFilterFlags(ClientData data[], Tcl_Interp *interp, int result); static int SetFilterFlags(ClientData data[], Tcl_Interp *interp, int result); static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr); /* * Object type used to manage type caches attached to method names. */ static Tcl_ObjType methodNameType = { |
︙ | ︙ | |||
227 228 229 230 231 232 233 | * in stack usage as possible. * * ---------------------------------------------------------------------- */ int TclOOInvokeContext( | > | < < | | > < < | > > > > > > > > | > > > > | | | > | > > | < | > | > > | > > > > > > > > > | > > > > > > > < | 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 | * in stack usage as possible. * * ---------------------------------------------------------------------- */ int TclOOInvokeContext( ClientData clientData, /* The method call context. */ Tcl_Interp *interp, /* Interpreter for error reporting, and many * other sorts of context handling (e.g., * commands, variables) depending on method * implementation. */ int objc, /* The number of arguments. */ Tcl_Obj *const objv[]) /* The arguments as actually seen. */ { register CallContext *const contextPtr = clientData; Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; const int isFilter = contextPtr->callPtr->chain[contextPtr->index].isFilter; /* * If this is the first step along the chain, we preserve the method * entries in the chain so that they do not get deleted out from under our * feet. */ if (contextPtr->index == 0) { int i; for (i=0 ; i<contextPtr->callPtr->numChain ; i++) { AddRef(contextPtr->callPtr->chain[i].mPtr); } /* * Ensure that the method name itself is part of the arguments when * we're doing unknown processing. */ if (contextPtr->callPtr->flags & OO_UNKNOWN_METHOD) { contextPtr->skip--; } /* * Add a callback to ensure that method references are dropped once * this call is finished. */ TclNR_AddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL, NULL); } /* * Save whether we were in a filter and set up whether we are now. */ if (contextPtr->oPtr->flags & FILTER_HANDLING) { TclNR_AddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL); } else { TclNR_AddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL); } if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) { contextPtr->oPtr->flags |= FILTER_HANDLING; } else { contextPtr->oPtr->flags &= ~FILTER_HANDLING; } /* * Run the method implementation. */ return mPtr->typePtr->callProc(mPtr->clientData, interp, (Tcl_ObjectContext) contextPtr, objc, objv); } static int SetFilterFlags( ClientData data[], Tcl_Interp *interp, int result) { CallContext *contextPtr = data[0]; contextPtr->oPtr->flags |= FILTER_HANDLING; return result; } static int ResetFilterFlags( ClientData data[], Tcl_Interp *interp, int result) { CallContext *contextPtr = data[0]; contextPtr->oPtr->flags &= ~FILTER_HANDLING; return result; } static int FinalizeMethodRefs( ClientData data[], Tcl_Interp *interp, int result) { CallContext *contextPtr = data[0]; int i; for (i=0 ; i<contextPtr->callPtr->numChain ; i++) { TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr); } return result; } /* * ---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclOOInt.h.
1 2 3 4 5 6 7 8 9 10 11 | /* * tclOOInt.h -- * * This file contains the structure definitions and some of the function * declarations for the object-system (NB: not Tcl_Obj, but ::oo). * * Copyright (c) 2006 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | /* * tclOOInt.h -- * * This file contains the structure definitions and some of the function * declarations for the object-system (NB: not Tcl_Obj, but ::oo). * * Copyright (c) 2006 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclOOInt.h,v 1.3 2008/07/16 22:09:02 dkf Exp $ */ #include <tclInt.h> #include "tclOO.h" /* * Forward declarations. |
︙ | ︙ | |||
489 490 491 492 493 494 495 | MODULE_SCOPE Proc * TclOOGetProcFromMethod(Method *mPtr); MODULE_SCOPE int TclOOGetSortedClassMethodList(Class *clsPtr, int flags, const char ***stringsPtr); MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr, int flags, const char ***stringsPtr); MODULE_SCOPE int TclOOInit(Tcl_Interp *interp); MODULE_SCOPE void TclOOInitInfo(Tcl_Interp *interp); | | | | > > > | 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 | MODULE_SCOPE Proc * TclOOGetProcFromMethod(Method *mPtr); MODULE_SCOPE int TclOOGetSortedClassMethodList(Class *clsPtr, int flags, const char ***stringsPtr); MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr, int flags, const char ***stringsPtr); MODULE_SCOPE int TclOOInit(Tcl_Interp *interp); MODULE_SCOPE void TclOOInitInfo(Tcl_Interp *interp); MODULE_SCOPE int TclOOInvokeContext(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclNRObjectContextInvokeNext(Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); MODULE_SCOPE void TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr, const DeclaredClassMethod *dcm); MODULE_SCOPE Tcl_Obj * TclOOObjectName(Tcl_Interp *interp, Object *oPtr); MODULE_SCOPE void TclOORemoveFromInstances(Object *oPtr, Class *clsPtr); MODULE_SCOPE void TclOORemoveFromMixinSubs(Class *subPtr, Class *mixinPtr); MODULE_SCOPE void TclOORemoveFromSubclasses(Class *subPtr, |
︙ | ︙ |
Changes to generic/tclOOMethod.c.
1 2 3 4 5 6 7 8 9 10 | /* * tclOOMethod.c -- * * This file contains code to create and manage methods. * * Copyright (c) 2005-2008 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | /* * tclOOMethod.c -- * * This file contains code to create and manage methods. * * Copyright (c) 2005-2008 by Donal K. Fellows * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: tclOOMethod.c,v 1.6 2008/07/16 22:09:02 dkf Exp $ */ #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "tclInt.h" #include "tclOOInt.h" |
︙ | ︙ | |||
51 52 53 54 55 56 57 58 59 60 61 62 63 64 | static Tcl_Obj ** InitEnsembleRewrite(Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int toRewrite, int rewriteLength, Tcl_Obj *const *rewriteObjs, int *lengthPtr); static int InvokeProcedureMethod(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int PushMethodCallFrame(Tcl_Interp *interp, CallContext *contextPtr, ProcedureMethod *pmPtr, int objc, Tcl_Obj *const *objv, PMFrameData *fdPtr); static void DeleteProcedureMethodRecord(ProcedureMethod *pmPtr); static void DeleteProcedureMethod(ClientData clientData); static int CloneProcedureMethod(Tcl_Interp *interp, | > > | 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 | static Tcl_Obj ** InitEnsembleRewrite(Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int toRewrite, int rewriteLength, Tcl_Obj *const *rewriteObjs, int *lengthPtr); static int InvokeProcedureMethod(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv); static int FinalizePMCall(ClientData data[], Tcl_Interp *interp, int result); static int PushMethodCallFrame(Tcl_Interp *interp, CallContext *contextPtr, ProcedureMethod *pmPtr, int objc, Tcl_Obj *const *objv, PMFrameData *fdPtr); static void DeleteProcedureMethodRecord(ProcedureMethod *pmPtr); static void DeleteProcedureMethod(ClientData clientData); static int CloneProcedureMethod(Tcl_Interp *interp, |
︙ | ︙ | |||
629 630 631 632 633 634 635 | Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Arguments as actually seen. */ { ProcedureMethod *pmPtr = clientData; int result; | < < | > > | > > > > | < < > > | > | > > > > > > > > | < | 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 | Tcl_Interp *interp, Tcl_ObjectContext context, /* The method calling context. */ int objc, /* Number of arguments. */ Tcl_Obj *const *objv) /* Arguments as actually seen. */ { ProcedureMethod *pmPtr = clientData; int result; PMFrameData *fdPtr; /* Important data that has to have a lifetime * matched by this function (or rather, by the * call frame's lifetime). */ /* * Allocate the special frame data. */ fdPtr = (PMFrameData *) TclStackAlloc(interp, sizeof(PMFrameData)); /* * Create a call frame for this method. */ result = PushMethodCallFrame(interp, (CallContext *) context, pmPtr, objc, objv, fdPtr); if (result != TCL_OK) { TclStackFree(interp, fdPtr); return result; } pmPtr->refCount++; /* * Give the pre-call callback a chance to do some setup and, possibly, * veto the call. */ if (pmPtr->preCallProc != NULL) { int isFinished; result = pmPtr->preCallProc(pmPtr->clientData, interp, context, (Tcl_CallFrame *) fdPtr->framePtr, &isFinished); if (isFinished || result != TCL_OK) { Tcl_PopCallFrame(interp); TclStackFree(interp, fdPtr->framePtr); if (--pmPtr->refCount < 1) { DeleteProcedureMethodRecord(pmPtr); } TclStackFree(interp, fdPtr); return result; } } /* * Now invoke the body of the method. */ TclNR_AddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL); return TclNRInterpProcCore(interp, fdPtr->nameObj, Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc); } static int FinalizePMCall( ClientData data[], Tcl_Interp *interp, int result) { ProcedureMethod *pmPtr = data[0]; Tcl_ObjectContext context = data[1]; PMFrameData *fdPtr = data[2]; /* * Give the post-call callback a chance to do some cleanup. Note that at * this point the call frame itself is invalid; it's already been popped. */ if (pmPtr->postCallProc) { result = pmPtr->postCallProc(pmPtr->clientData, interp, context, Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)), result); } /* * Scrap the special frame data now that we're done with it. Note that we * are inlining DeleteProcedureMethod() here; this location is highly * sensitive when it comes to performance! */ if (--pmPtr->refCount < 1) { DeleteProcedureMethodRecord(pmPtr); } TclStackFree(interp, fdPtr); return result; } |
︙ | ︙ | |||
1132 1133 1134 1135 1136 1137 1138 | * can ignore here. */ Tcl_ListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs); argObjs = InitEnsembleRewrite(interp, objc, objv, skip, numPrefixes, prefixObjs, &len); | | | 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 | * can ignore here. */ Tcl_ListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs); argObjs = InitEnsembleRewrite(interp, objc, objv, skip, numPrefixes, prefixObjs, &len); result = TclNR_EvalObjv(interp, len, argObjs, TCL_EVAL_INVOKE); TclStackFree(interp, argObjs); return result; } /* * ---------------------------------------------------------------------- * |
︙ | ︙ |