Posted to tcl by apw at Mon Jul 23 10:09:50 GMT 2007view raw

  1. ndex: tclOOInt.h
  2. ===================================================================
  3. RCS file: /cvsroot/tcl/oocore/generic/tclOOInt.h,v
  4. retrieving revision 1.8
  5. diff -b -u -r1.8 tclOOInt.h
  6. --- tclOOInt.h 25 Jun 2007 14:20:20 -0000 1.8
  7. +++ tclOOInt.h 23 Jul 2007 09:55:36 -0000
  8. @@ -131,6 +131,12 @@
  9. Tcl_Obj *cachedNameObj; /* Cache of the name of the object. */
  10. Tcl_HashTable publicContextCache; /* Place to keep unused contexts. */
  11. Tcl_HashTable privateContextCache; /* Place to keep unused contexts. */
  12. +#ifdef ARNULF_FOR_ITCL_CODE
  13. + Tcl_Resolve *resolvePtr;
  14. + /* Points to a struct for resolving commands
  15. + * and variables
  16. + */
  17. +#endif
  18. } Object;
  19.  
  20. #define OBJECT_DELETED 1 /* Flag to say that an object has been
  21. @@ -378,7 +384,7 @@
  22. CallContext *contextPtr);
  23. MODULE_SCOPE CallContext *TclOOGetCallContext(Foundation *fPtr, Object *oPtr,
  24. Tcl_Obj *methodNameObj, int flags,
  25. - Tcl_HashTable *cachePtr);
  26. + Tcl_HashTable *cachePtr, Class *clsPtr);
  27. MODULE_SCOPE int TclOOInvokeContext(Tcl_Interp *interp,
  28. CallContext *contextPtr, int objc,
  29. Tcl_Obj *const *objv);
  30. Index: tclOO.c
  31. ===================================================================
  32. RCS file: /cvsroot/tcl/oocore/generic/tclOO.c,v
  33. retrieving revision 1.20
  34. diff -b -u -r1.20 tclOO.c
  35. --- tclOO.c 16 Jun 2007 14:53:08 -0000 1.20
  36. +++ tclOO.c 23 Jul 2007 09:55:50 -0000
  37. @@ -397,6 +397,9 @@
  38. oPtr->flags = 0;
  39. oPtr->creationEpoch = creationEpoch;
  40. oPtr->metadataPtr = NULL;
  41. +#ifdef ARNULF_FOR_ITCL_CODE
  42. + oPtr->resolvePtr = NULL;
  43. +#endif
  44.  
  45. /*
  46. * Initialize the traces.
  47. @@ -479,7 +482,7 @@
  48. if (!Tcl_InterpDeleted(interp)) {
  49. CallContext *contextPtr =
  50. TclOOGetCallContext(TclOOGetFoundation(interp), oPtr, NULL,
  51. - DESTRUCTOR, NULL);
  52. + DESTRUCTOR, NULL, NULL);
  53.  
  54. if (contextPtr != NULL) {
  55. int result;
  56. @@ -717,6 +720,11 @@
  57. ckfree((char *) oPtr->metadataPtr);
  58. oPtr->metadataPtr = NULL;
  59. }
  60. +#ifdef ARNULF_FOR_ITCL_CODE
  61. + if (oPtr->resolvePtr != NULL) {
  62. + ckfree((char *) oPtr->resolvePtr);
  63. + }
  64. +#endif
  65.  
  66. if (clsPtr != NULL && !(oPtr->flags & ROOT_OBJECT)) {
  67. Class *superPtr, *mixinPtr;
  68. @@ -1162,7 +1170,7 @@
  69.  
  70. if (objc >= 0) {
  71. contextPtr = TclOOGetCallContext(TclOOGetFoundation(interp), oPtr,
  72. - NULL, CONSTRUCTOR, NULL);
  73. + NULL, CONSTRUCTOR, NULL, NULL);
  74. if (contextPtr != NULL) {
  75. int result;
  76. Tcl_InterpState state;
  77. @@ -1675,6 +1683,7 @@
  78. int objc,
  79. Tcl_Obj *const *objv)
  80. {
  81. +
  82. return ObjectCmd(clientData, interp, objc, objv, PUBLIC_METHOD,
  83. &((Object *)clientData)->publicContextCache);
  84. }
  85. @@ -1690,6 +1699,7 @@
  86. &((Object *)clientData)->privateContextCache);
  87. }
  88.  
  89. +void InitClassHierarchy(Foundation *fPtr, Class *classPtr);
  90. static int
  91. ObjectCmd(
  92. Object *oPtr, /* The object being invoked. */
  93. @@ -1701,6 +1711,13 @@
  94. Tcl_HashTable *cachePtr) /* What call chain cache to use. */
  95. {
  96. CallContext *contextPtr;
  97. + Class *clsPtr;
  98. + Class *superPtr;
  99. + Tcl_Obj *objName;
  100. + char *sp;
  101. + char *cp;
  102. + Tcl_Obj *className;
  103. + int i;
  104. int result;
  105.  
  106. if (objc < 2) {
  107. @@ -1708,8 +1725,34 @@
  108. return TCL_ERROR;
  109. }
  110.  
  111. + clsPtr = NULL;
  112. + objName = NULL;
  113. + className = NULL;
  114. + if (objv[1] != NULL) {
  115. + sp = Tcl_GetString(objv[1]);
  116. + cp = strstr(sp, "::");
  117. + if (cp != NULL) {
  118. + objName = Tcl_NewStringObj(cp+2, -1);
  119. + InitClassHierarchy(TclOOGetFoundation(interp), oPtr->selfCls);
  120. + className = Tcl_NewStringObj(sp, cp-sp);
  121. + Tcl_IncrRefCount(className);
  122. + sp = Tcl_GetString(className);
  123. + if (strcmp(oPtr->selfCls->thisPtr->namespacePtr->name, sp) != 0) {
  124. + FOREACH(superPtr, oPtr->selfCls->superclasses) {
  125. + if (strcmp(superPtr->thisPtr->namespacePtr->name, sp) == 0) {
  126. + clsPtr = superPtr;
  127. + break;
  128. + }
  129. +
  130. + }
  131. + } else {
  132. + clsPtr = oPtr->selfCls;
  133. + }
  134. + Tcl_DecrRefCount(className);
  135. + }
  136. + }
  137. contextPtr = TclOOGetCallContext(TclOOGetFoundation(interp), oPtr,
  138. - objv[1], flags | (oPtr->flags & FILTER_HANDLING), cachePtr);
  139. + objName == NULL ? objv[1] : objName, flags | (oPtr->flags & FILTER_HANDLING), cachePtr, clsPtr);
  140. if (contextPtr == NULL) {
  141. Tcl_AppendResult(interp, "impossible to invoke method \"",
  142. TclGetString(objv[1]),
  143. Index: tclOOMethod.c
  144. ===================================================================
  145. RCS file: /cvsroot/tcl/oocore/generic/tclOOMethod.c,v
  146. retrieving revision 1.4
  147. diff -b -u -r1.4 tclOOMethod.c
  148. --- tclOOMethod.c 25 Jun 2007 14:20:21 -0000 1.4
  149. +++ tclOOMethod.c 23 Jul 2007 09:55:57 -0000
  150. @@ -583,6 +583,9 @@
  151. if (pmPtr->flags & USE_DECLARER_NS) {
  152. register Method *mPtr = contextPtr->callChain[contextPtr->index].mPtr;
  153.  
  154. +#ifdef ARNULF_FOR_ITCL_CODE
  155. + flags |= FRAME_HAS_RESOLVER;
  156. +#endif
  157. if (mPtr->declaringClassPtr != NULL) {
  158. nsPtr = mPtr->declaringClassPtr->thisPtr->namespacePtr;
  159. } else {
  160. @@ -615,6 +618,40 @@
  161. framePtr->objv = objv; /* ref counts for args are incremented below */
  162. framePtr->procPtr = pmPtr->procPtr;
  163.  
  164. +#ifdef ARNULF_FOR_ITCL_CODE
  165. + if (flags & FRAME_HAS_RESOLVER) {
  166. + Tcl_DString buffer;
  167. + Tcl_Resolve *resolvePtr;
  168. + Tcl_Namespace *varNsPtr;
  169. +
  170. + if (flags & FRAME_IS_CONSTRUCTOR) {
  171. + Tcl_DStringInit(&buffer);
  172. + Tcl_DStringAppend(&buffer, "::itcl::variables::", -1);
  173. + Tcl_DStringAppend(&buffer,
  174. + Tcl_GetCommandName(interp, oPtr->command), -1);
  175. + varNsPtr = Tcl_FindNamespace(interp, Tcl_DStringValue(&buffer),
  176. + NULL, 0);
  177. +//fprintf(stderr, "CONVNS3!%s!%p\n", Tcl_DStringValue(&buffer), varNsPtr);
  178. + if (varNsPtr != NULL) {
  179. + SetVarResolver((Tcl_Object)oPtr, varNsPtr);
  180. + }
  181. + Tcl_DStringFree(&buffer);
  182. + }
  183. + resolvePtr = oPtr->resolvePtr;
  184. + if ((resolvePtr != NULL) &&
  185. + (oPtr->resolvePtr->objectVarNsPtr != NULL)) {
  186. + Tcl_DStringInit(&buffer);
  187. + Tcl_DStringAppend(&buffer,
  188. + oPtr->resolvePtr->objectVarNsPtr->fullName, -1);
  189. + Tcl_DStringAppend(&buffer, nsPtr->fullName, -1);
  190. + oPtr->resolvePtr->varNsPtr = Tcl_FindNamespace(interp,
  191. + Tcl_DStringValue(&buffer), NULL, 0);
  192. +//fprintf(stderr, "FN!%s!%p\n", Tcl_DStringValue(&buffer), oPtr->resolvePtr->varNsPtr);
  193. + Tcl_DStringFree(&buffer);
  194. + }
  195. + framePtr->resolvePtr = oPtr->resolvePtr;
  196. + }
  197. +#endif
  198. /*
  199. * Finish filling out the extra frame info.
  200. */
  201. @@ -1148,6 +1185,22 @@
  202. return (((Method *)method)->flags & PUBLIC_METHOD) ? 1 : 0;
  203. }
  204.  
  205. +#ifdef ARNULF_FOR_ITCL_CODE
  206. +void
  207. +SetVarResolver(
  208. + Tcl_Object oPtr,
  209. + Tcl_Namespace *nsPtr)
  210. +{
  211. + if (oPtr != NULL) {
  212. + Tcl_Resolve *resolvePtr;
  213. + resolvePtr = (Tcl_Resolve *) ckalloc(sizeof(Tcl_Resolve));
  214. + resolvePtr->objectVarNsPtr = nsPtr;
  215. + resolvePtr->varNsPtr = NULL;
  216. + ((Object*)oPtr)->resolvePtr = resolvePtr;
  217. + }
  218. +}
  219. +#endif
  220. +
  221. /*
  222. * Local Variables:
  223. * mode: c
  224. Index: tclOODefineCmds.c
  225. ===================================================================
  226. RCS file: /cvsroot/tcl/oocore/generic/tclOODefineCmds.c,v
  227. retrieving revision 1.1
  228. diff -b -u -r1.1 tclOODefineCmds.c
  229. --- tclOODefineCmds.c 18 May 2007 13:17:15 -0000 1.1
  230. +++ tclOODefineCmds.c 23 Jul 2007 09:56:06 -0000
  231. @@ -154,12 +154,16 @@
  232. Object *oPtr;
  233. Class *clsPtr;
  234. int bodyLength;
  235. + int use_declarer_ns_flag = 0;
  236.  
  237. - if (objc != 3) {
  238. + if ((objc != 3) && (objc != 4)) {
  239. Tcl_WrongNumArgs(interp, 1, objv, "arguments body");
  240. return TCL_ERROR;
  241. }
  242.  
  243. + if (objc > 3) {
  244. + use_declarer_ns_flag = USE_DECLARER_NS;
  245. + }
  246. /*
  247. * Extract and validate the context, which is the class that we wish to
  248. * modify.
  249. @@ -184,7 +188,7 @@
  250.  
  251. Method *mPtr;
  252.  
  253. - mPtr = TclOONewProcClassMethod(interp, clsPtr, PUBLIC_METHOD, NULL,
  254. + mPtr = TclOONewProcClassMethod(interp, clsPtr, PUBLIC_METHOD|use_declarer_ns_flag, NULL,
  255. objv[1], objv[2]);
  256. if (mPtr == NULL) {
  257. return TCL_ERROR;
  258. @@ -221,12 +225,16 @@
  259. Object *oPtr;
  260. Class *clsPtr;
  261. int bodyLength;
  262. + int use_declarer_ns_flag = 0;
  263.  
  264. - if (objc != 2) {
  265. + if ((objc != 2) && (objc != 3)) {
  266. Tcl_WrongNumArgs(interp, 1, objv, "body");
  267. return TCL_ERROR;
  268. }
  269.  
  270. + if (objc > 2) {
  271. + use_declarer_ns_flag = USE_DECLARER_NS;
  272. + }
  273. oPtr = (Object *) TclOOGetDefineCmdContext(interp);
  274. if (oPtr == NULL) {
  275. return TCL_ERROR;
  276. @@ -246,7 +254,7 @@
  277.  
  278. Method *mPtr;
  279.  
  280. - mPtr = TclOONewProcClassMethod(interp, clsPtr, PUBLIC_METHOD, NULL,
  281. + mPtr = TclOONewProcClassMethod(interp, clsPtr, PUBLIC_METHOD|use_declarer_ns_flag, NULL,
  282. NULL, objv[1]);
  283. if (mPtr == NULL) {
  284. return TCL_ERROR;
  285. @@ -482,12 +490,16 @@
  286. int isSelfMethod = (clientData != NULL);
  287. Object *oPtr;
  288. int bodyLength;
  289. + int use_declarer_ns_flag = 0;
  290.  
  291. - if (objc != 4) {
  292. - Tcl_WrongNumArgs(interp, 1, objv, "name args body");
  293. + if (objc != 4 && objc != 5) {
  294. + Tcl_WrongNumArgs(interp, 1, objv, "name args body ?flag?");
  295. return TCL_ERROR;
  296. }
  297.  
  298. + if (objc > 4) {
  299. + use_declarer_ns_flag = USE_DECLARER_NS;
  300. + }
  301. oPtr = (Object *) TclOOGetDefineCmdContext(interp);
  302. if (oPtr == NULL) {
  303. return TCL_ERROR;
  304. @@ -504,6 +516,7 @@
  305. int isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
  306. ? PUBLIC_METHOD : 0;
  307.  
  308. +isPublic |= use_declarer_ns_flag;
  309. if (isSelfMethod) {
  310. mPtr = TclOONewProcMethod(interp, oPtr, isPublic, objv[1],
  311. objv[2], objv[3]);
  312. Index: tclOOCall.c
  313. ===================================================================
  314. RCS file: /cvsroot/tcl/oocore/generic/tclOOCall.c,v
  315. retrieving revision 1.2
  316. diff -b -u -r1.2 tclOOCall.c
  317. --- tclOOCall.c 15 Jun 2007 14:26:03 -0000 1.2
  318. +++ tclOOCall.c 23 Jul 2007 09:56:11 -0000
  319. @@ -51,13 +51,13 @@
  320. static void AddSimpleChainToCallContext(Object *oPtr,
  321. Tcl_Obj *methodNameObj, struct ChainBuilder *cbPtr,
  322. Tcl_HashTable *doneFilters, int isPublic,
  323. - Class *filterDecl);
  324. + Class *filterDecl, Class *clsPtr);
  325. static void AddSimpleClassChainToCallContext(Class *classPtr,
  326. Tcl_Obj *methodNameObj, struct ChainBuilder *cbPtr,
  327. Tcl_HashTable *doneFilters, int isPublic,
  328. Class *filterDecl);
  329. static int CmpStr(const void *ptr1, const void *ptr2);
  330. -static void InitClassHierarchy(Foundation *fPtr, Class *classPtr);
  331. +void InitClassHierarchy(Foundation *fPtr, Class *classPtr);
  332. static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
  333. static void FreeMethodNameRep(Tcl_Obj *objPtr);
  334.  
  335. @@ -244,7 +244,7 @@
  336. * ----------------------------------------------------------------------
  337. */
  338.  
  339. -static void
  340. +void
  341. InitClassHierarchy(
  342. Foundation *fPtr,
  343. Class *classPtr)
  344. @@ -532,8 +532,9 @@
  345. * Only the bits PUBLIC_METHOD, CONSTRUCTOR,
  346. * PRIVATE_METHOD, DESTRUCTOR and
  347. * FILTER_HANDLING are useful. */
  348. - Tcl_HashTable *cachePtr) /* Where to cache the chain. Ignored for both
  349. + Tcl_HashTable *cachePtr, /* Where to cache the chain. Ignored for both
  350. * constructors and destructors. */
  351. + Class *clsPtr) /* class if direct call with classname in front */
  352. {
  353. struct ChainBuilder cb;
  354. int i, count, doFilters;
  355. @@ -608,7 +609,7 @@
  356. }
  357. FOREACH(filterObj, oPtr->filters) {
  358. AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0,
  359. - NULL);
  360. + NULL, NULL);
  361. }
  362. AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters);
  363. Tcl_DeleteHashTable(&doneFilters);
  364. @@ -619,7 +620,7 @@
  365. * Add the actual method implementations.
  366. */
  367.  
  368. - AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL);
  369. + AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL, clsPtr);
  370.  
  371. /*
  372. * Check to see if the method has no implementation. If so, we probably
  373. @@ -638,7 +639,7 @@
  374. return NULL;
  375. }
  376. AddSimpleChainToCallContext(oPtr, fPtr->unknownMethodNameObj, &cb,
  377. - NULL, 0, NULL);
  378. + NULL, 0, NULL, NULL);
  379. cb.contextPtr->flags |= OO_UNKNOWN_METHOD;
  380. cb.contextPtr->globalEpoch = -1;
  381. if (count == cb.contextPtr->numCallChain) {
  382. @@ -697,7 +698,7 @@
  383. (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj, &isNew);
  384. if (isNew) {
  385. AddSimpleChainToCallContext(oPtr, filterObj, cbPtr, doneFilters,
  386. - 0, clsPtr);
  387. + 0, clsPtr, NULL);
  388. }
  389. }
  390.  
  391. @@ -740,9 +741,10 @@
  392. Tcl_HashTable *doneFilters, /* Where to record what call chain entries
  393. * have been processed. */
  394. int flags, /* What sort of call chain are we building. */
  395. - Class *filterDecl) /* The class that declared the filter. If
  396. + Class *filterDecl, /* The class that declared the filter. If
  397. * NULL, either the filter was declared by the
  398. * object or this isn't a filter. */
  399. + Class *clsPtr) /* class for direct call */
  400. {
  401. int i;
  402.  
  403. @@ -776,7 +778,7 @@
  404. AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr,
  405. doneFilters, flags, filterDecl);
  406. }
  407. - FOREACH(superPtr, oPtr->selfCls->classHierarchy) {
  408. + FOREACH(superPtr, clsPtr == NULL ? oPtr->selfCls->classHierarchy : clsPtr->classHierarchy) {
  409. int j=i; /* HACK: save index so can nest FOREACHes. */
  410. FOREACH(mixinPtr, superPtr->mixins) {
  411. AddSimpleClassChainToCallContext(mixinPtr, methodNameObj,
  412. @@ -790,8 +792,8 @@
  413. filterDecl);
  414. }
  415. }
  416. - AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr,
  417. - doneFilters, flags, filterDecl);
  418. + AddSimpleClassChainToCallContext(clsPtr == NULL ? oPtr->selfCls : clsPtr,
  419. + methodNameObj, cbPtr, doneFilters, flags, filterDecl);
  420. }
  421.  
  422. /*