Posted to tcl by apw at Sun Aug 19 09:30:04 GMT 2007view raw

  1. Index: tcl.h
  2. ===================================================================
  3. RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
  4. retrieving revision 1.234
  5. diff -d -u -r1.234 tcl.h
  6. --- tcl.h 31 Jul 2007 17:03:35 -0000 1.234
  7. +++ tcl.h 19 Aug 2007 09:14:33 -0000
  8. @@ -835,6 +835,21 @@
  9. * namespace. */
  10. } Tcl_Namespace;
  11.  
  12. +#ifdef ARNULF_FOR_ITCL_CODE
  13. +struct Tcl_Resolve;
  14. +typedef Tcl_Command (Tcl_CmdAliasProc)(Tcl_Interp *interp,
  15. + Tcl_Namespace *nsPtr, CONST char *cmdName,
  16. + struct Tcl_Resolve *resolvePtr);
  17. +typedef Tcl_Var (Tcl_VarAliasProc)(Tcl_Interp *interp,
  18. + Tcl_Namespace *nsPtr, CONST char *varName,
  19. + struct Tcl_Resolve *resolvePtr);
  20. +typedef struct Tcl_Resolve {
  21. + Tcl_VarAliasProc *varProcPtr;
  22. + Tcl_CmdAliasProc *cmdProcPtr;
  23. + ClientData clientData;
  24. +} Tcl_Resolve;
  25. +#endif
  26. +
  27. /*
  28. * The following structure represents a call frame, or activation record. A
  29. * call frame defines a naming context for a procedure call: its local scope
  30. @@ -871,6 +886,9 @@
  31. char *dummy10;
  32. char *dummy11;
  33. char *dummy12;
  34. +#ifdef ARNULF_FOR_ITCL_CODE
  35. + char *dummy13;
  36. +#endif
  37. } Tcl_CallFrame;
  38.  
  39. /*
  40. Index: tclInt.h
  41. ===================================================================
  42. RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
  43. retrieving revision 1.329
  44. diff -d -u -r1.329 tclInt.h
  45. --- tclInt.h 7 Aug 2007 17:28:39 -0000 1.329
  46. +++ tclInt.h 19 Aug 2007 09:15:16 -0000
  47. @@ -320,6 +320,9 @@
  48. NamespacePathEntry *commandPathSourceList;
  49. /* Linked list of path entries that point to
  50. * this namespace. */
  51. +#ifdef ARNULF_FOR_ITCL_CODE
  52. + Tcl_Resolve *resolvePtr;
  53. +#endif
  54. } Namespace;
  55.  
  56. /*
  57. @@ -960,6 +963,7 @@
  58. ClientData clientData; /* Value to pass to proc. */
  59. } AssocData;
  60.  
  61. +
  62. /*
  63. * The structure below defines a call frame. A call frame defines a naming
  64. * context for a procedure call: its local naming scope (for local variables)
  65. @@ -1044,10 +1048,21 @@
  66. * meaning of the value is, which we do not
  67. * specify. */
  68. LocalCache *localCachePtr;
  69. +#ifdef ARNULF_FOR_ITCL_CODE
  70. + Tcl_Resolve *resolvePtr;
  71. + /* points to a struct with info for command
  72. + * and variable resolving, may be NULL.
  73. + * Only relevant if flag FRAME_HAS_RESOLVER in
  74. + * isProcCallFrame is set
  75. + */
  76. +#endif
  77. } CallFrame;
  78.  
  79. #define FRAME_IS_PROC 0x1
  80. #define FRAME_IS_LAMBDA 0x2
  81. +#ifdef ARNULF_FOR_ITCL_CODE
  82. +#define FRAME_HAS_RESOLVER 0x100
  83. +#endif
  84.  
  85. /*
  86. * TIP #280
  87. Index: tclNamesp.c
  88. ===================================================================
  89. RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
  90. retrieving revision 1.148
  91. diff -d -u -r1.148 tclNamesp.c
  92. --- tclNamesp.c 3 Aug 2007 13:51:40 -0000 1.148
  93. +++ tclNamesp.c 19 Aug 2007 09:16:19 -0000
  94. @@ -813,6 +813,9 @@
  95. nsPtr->commandPathLength = 0;
  96. nsPtr->commandPathArray = NULL;
  97. nsPtr->commandPathSourceList = NULL;
  98. +#ifdef ARNULF_FOR_ITCL_CODE
  99. + nsPtr->resolvePtr = NULL;
  100. +#endif
  101.  
  102. if (parentPtr != NULL) {
  103. entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
  104. @@ -2354,6 +2357,13 @@
  105. register Command *cmdPtr;
  106. const char *simpleName;
  107. int result;
  108. +#ifdef ARNULF_FOR_ITCL_CODE
  109. + int frame_has_resolver = 0;
  110. + if (iPtr->varFramePtr != NULL) {
  111. + frame_has_resolver = iPtr->varFramePtr->isProcCallFrame &
  112. + FRAME_HAS_RESOLVER;
  113. + }
  114. +#endif
  115.  
  116. /*
  117. * If this namespace has a command resolver, then give it first crack at
  118. @@ -2396,6 +2406,18 @@
  119. return (Tcl_Command) NULL;
  120. }
  121. }
  122. +#ifdef ARNULF_FOR_ITCL_CODE
  123. + if (frame_has_resolver && (iPtr->varFramePtr->resolvePtr)) {
  124. + Tcl_Command resolvedCmdPtr = NULL;
  125. + Tcl_Resolve *resolvePtr = iPtr->varFramePtr->resolvePtr;
  126. + if (resolvePtr->cmdProcPtr != NULL) {
  127. + resolvedCmdPtr = (resolvePtr->cmdProcPtr)(interp, (Tcl_Namespace *)iPtr->varFramePtr->nsPtr, name, resolvePtr);
  128. + if (resolvedCmdPtr != NULL) {
  129. + return resolvedCmdPtr;
  130. + }
  131. + }
  132. + }
  133. +#endif
  134.  
  135. /*
  136. * Find the namespace(s) that contain the command.
  137. @@ -3269,6 +3291,12 @@
  138. */
  139.  
  140. Interp *iPtr = (Interp *) interp;
  141. +#ifdef ARNULF_FOR_ITCL_CODE
  142. + if (((Namespace *)namespacePtr)->resolvePtr != NULL) {
  143. + framePtr->isProcCallFrame |= FRAME_HAS_RESOLVER;
  144. + framePtr->resolvePtr = ((Namespace *)namespacePtr)->resolvePtr;
  145. + }
  146. +#endif
  147.  
  148. result = TclEvalObjEx(interp, objv[3], 0, iPtr->cmdFramePtr, 3);
  149. } else {
  150. @@ -3284,6 +3312,12 @@
  151. * TIP #280: Make invoking context available to eval'd script.
  152. */
  153.  
  154. +#ifdef ARNULF_FOR_ITCL_CODE
  155. + if (((Namespace *)namespacePtr)->resolvePtr != NULL) {
  156. + framePtr->isProcCallFrame |= FRAME_HAS_RESOLVER;
  157. + framePtr->resolvePtr = ((Namespace *)namespacePtr)->resolvePtr;
  158. + }
  159. +#endif
  160. result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0);
  161. }
  162.  
  163. @@ -5984,6 +6018,11 @@
  164. int reparseCount = 0; /* Number of reparses. */
  165.  
  166. if (objc < 2) {
  167. +#ifdef ARNULF_FOR_ITCL_CODE
  168. + if (ensemblePtr->unknownHandler != NULL) {
  169. + goto unknownOrAmbiguousSubcommand;
  170. + }
  171. +#endif
  172. Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument ...?");
  173. return TCL_ERROR;
  174. }
  175. Index: tclProc.c
  176. ===================================================================
  177. RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
  178. retrieving revision 1.127
  179. diff -d -u -r1.127 tclProc.c
  180. --- tclProc.c 4 Aug 2007 18:32:27 -0000 1.127
  181. +++ tclProc.c 19 Aug 2007 09:16:35 -0000
  182. @@ -1114,6 +1114,7 @@
  183. *
  184. *----------------------------------------------------------------------
  185. */
  186. +
  187. void
  188. TclInitCompiledLocals(
  189. Tcl_Interp *interp, /* Current interpreter. */
  190. @@ -1170,6 +1171,10 @@
  191. int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
  192. CompiledLocal *firstLocalPtr, *localPtr;
  193. int varNum;
  194. +#ifdef ARNULF_FOR_ITCL_CODE
  195. + int frame_has_resolver = iPtr->varFramePtr->isProcCallFrame & FRAME_HAS_RESOLVER;
  196. +#endif
  197. +
  198.  
  199. /*
  200. * Find the localPtr corresponding to varPtr
  201. @@ -1186,7 +1191,11 @@
  202. //maybe for VAR_TEMPORARY? Who cares really?) A job for tbcload, not us.
  203. */
  204.  
  205. - if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS))) {
  206. + if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS))
  207. +#ifdef ARNULF_FOR_ITCL_CODE
  208. + && !frame_has_resolver
  209. +#endif
  210. + ) {
  211. /*
  212. * Initialize the array of local variables stored in the call frame.
  213. * Some variables may have special resolution rules. In that case, we
  214. @@ -1195,7 +1204,11 @@
  215. */
  216.  
  217. doInitCompiledLocals:
  218. - if (!haveResolvers) {
  219. + if (!haveResolvers
  220. +#ifdef ARNULF_FOR_ITCL_CODE
  221. + && !frame_has_resolver
  222. +#endif
  223. + ) {
  224. /*
  225. * Should not be called: deadwood.
  226. */
  227. @@ -1223,7 +1236,7 @@
  228. (*resVarInfo->fetchProc)(interp, resVarInfo);
  229. if (resolvedVarPtr) {
  230. VarHashRefCount(resolvedVarPtr)++;
  231. - varPtr->flags = VAR_LINK;
  232. + TclSetVarLink(varPtr);
  233. varPtr->value.linkPtr = resolvedVarPtr;
  234. }
  235. }
  236. @@ -1275,6 +1288,25 @@
  237. localPtr->flags |= VAR_RESOLVED;
  238. }
  239. }
  240. +#ifdef ARNULF_FOR_ITCL_CODE
  241. + if (frame_has_resolver &&
  242. + !(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY)) &&
  243. + (iPtr->varFramePtr->resolvePtr != NULL)) {
  244. + Tcl_Resolve *resolvePtr = iPtr->varFramePtr->resolvePtr;
  245. + varPtr->flags = localPtr->flags;
  246. + varPtr->value.objPtr = NULL;
  247. + if (resolvePtr->varProcPtr != NULL) {
  248. + Var *resolvedVarPtr;
  249. + resolvedVarPtr = (Var *)(resolvePtr->varProcPtr)(interp, (Tcl_Namespace*)iPtr->varFramePtr->nsPtr, localPtr->name, resolvePtr);
  250. + if (resolvedVarPtr != NULL) {
  251. + VarHashRefCount(resolvedVarPtr)++;
  252. + TclSetVarLink(varPtr);
  253. + varPtr->value.linkPtr = resolvedVarPtr;
  254. + }
  255. + }
  256. + varPtr++;
  257. + }
  258. +#endif
  259. }
  260. localPtr = firstLocalPtr;
  261. codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS;
  262. @@ -1373,6 +1405,9 @@
  263. register Var *varPtr, *defPtr;
  264. int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
  265. Tcl_Obj *const *argObjs;
  266. +#ifdef ARNULF_FOR_ITCL_CODE
  267. + int haveFrameResolver = framePtr->isProcCallFrame & FRAME_HAS_RESOLVER;
  268. +#endif
  269.  
  270. /*
  271. * Make sure that the local cache of variable names and initial values has
  272. @@ -1482,7 +1517,11 @@
  273.  
  274. correctArgs:
  275. if (numArgs < localCt) {
  276. - if (!framePtr->nsPtr->compiledVarResProc && !((Interp *)interp)->resolverPtr) {
  277. + if (!framePtr->nsPtr->compiledVarResProc && !((Interp *)interp)->resolverPtr
  278. +#ifdef ARNULF_FOR_ITCL_CODE
  279. + && !haveFrameResolver
  280. +#endif
  281. + ) {
  282. memset(varPtr, 0, (localCt - numArgs)*sizeof(Var));
  283. } else {
  284. InitCompiledLocals(interp, codePtr, varPtr, framePtr->nsPtr);
  285. @@ -2711,6 +2750,9 @@
  286. (overflow ? limit : nameLen), procName,
  287. (overflow ? "..." : ""), interp->errorLine));
  288. }
  289.  
  290. /*
  291. * Local Variables:
  292. Index: tclVar.c
  293. ===================================================================
  294. RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v
  295. retrieving revision 1.149
  296. diff -d -u -r1.149 tclVar.c
  297. --- tclVar.c 4 Aug 2007 18:32:28 -0000 1.149
  298. +++ tclVar.c 19 Aug 2007 09:17:05 -0000
  299. @@ -880,6 +880,50 @@
  300. }
  301. }
  302.  
  303. +#ifdef ARNULF_FOR_ITCL_CODE
  304. + int frame_has_resolver = 0;
  305. + if (iPtr->varFramePtr != NULL) {
  306. + frame_has_resolver = iPtr->varFramePtr->isProcCallFrame &
  307. + FRAME_HAS_RESOLVER;
  308. + }
  309. + /*
  310. + * If this namespace has a call frame variable resolver, then give it
  311. + * first crack at the variable resolution. It may return a Tcl_Var value,
  312. + * otherwise just continue
  313. + */
  314. +
  315. + if (frame_has_resolver && (iPtr->varFramePtr->resolvePtr) &&
  316. + !(flags & LOOKUP_FOR_UPVAR)) {
  317. + Var *resolvedVarPtr = NULL;
  318. + Tcl_Resolve *resolvePtr = iPtr->varFramePtr->resolvePtr;
  319. + if (resolvePtr->varProcPtr != NULL) {
  320. + resolvedVarPtr = (Var *)(resolvePtr->varProcPtr)(interp, (Tcl_Namespace *)iPtr->varFramePtr->nsPtr, varName, resolvePtr);
  321. + if (resolvedVarPtr != NULL) {
  322. + CompiledLocal *lPtr;
  323. + if (iPtr->varFramePtr->procPtr != NULL) {
  324. + lPtr = iPtr->varFramePtr->procPtr->firstLocalPtr;
  325. +
  326. + int j = 0;
  327. + for (;lPtr != NULL; lPtr = lPtr->nextPtr, j++) {
  328. + if ((varName[0] == lPtr->name[0])
  329. + && (strcmp(varName, lPtr->name) == 0)) {
  330. + if (j > varFramePtr->procPtr->numArgs) {
  331. + break;
  332. + } else {
  333. + resolvedVarPtr = NULL;
  334. + break;
  335. + }
  336. + }
  337. + }
  338. + }
  339. + if (resolvedVarPtr != NULL) {
  340. + return resolvedVarPtr;
  341. + }
  342. + }
  343. + }
  344. + }
  345. +#endif
  346. +
  347. /*
  348. * Look up varName. Look it up as either a namespace variable or as a
  349. * local variable in a procedure call frame (varFramePtr). Interpret
  350.  

Comments

Posted by apw at Sun Aug 19 09:40:20 GMT 2007 [text] [code]

The idea of the CallFrame resolvers is to lookup variables in just another namespace the the callframe namespace using the Tcl_FindNamespaceVar function and return the result of that call. Similar for Commands. The resolution ther includes where to lookup namespace1::method1 stuff where the class namespaces are not in hierarchical order concerning namespace names. example: namespace eval ::class1::ns1 { proc ns1m1 {} {} } namespace eval ::class2::ns2 { proc ns2m1 {} { ns1::ns1m1 } } In that case normal namespace resolution does not work and for Itcl I cannot use namespace path for other reasons