Diff
Not logged in

Differences From Artifact [ffa63c4fd9]:

To Artifact [aa155ba0ca]:


63
64
65
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
63
64
65
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







-
+









-
+

-
+






-
-
+
+


-
+

-
+







 * Function declarations for things defined in this file.
 */

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,
static int		InvokeProcedureMethod(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static Tcl_NRPostProc	FinalizeForwardCall;
static Tcl_NRPostProc	FinalizePMCall;
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 void		DeleteProcedureMethod(void *clientData);
static int		CloneProcedureMethod(Tcl_Interp *interp,
			    ClientData clientData, ClientData *newClientData);
			    void *clientData, void **newClientData);
static void		MethodErrorHandler(Tcl_Interp *interp,
			    Tcl_Obj *procNameObj);
static void		ConstructorErrorHandler(Tcl_Interp *interp,
			    Tcl_Obj *procNameObj);
static void		DestructorErrorHandler(Tcl_Interp *interp,
			    Tcl_Obj *procNameObj);
static Tcl_Obj *	RenderDeclarerName(ClientData clientData);
static int		InvokeForwardMethod(ClientData clientData,
static Tcl_Obj *	RenderDeclarerName(void *clientData);
static int		InvokeForwardMethod(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static void		DeleteForwardMethod(ClientData clientData);
static void		DeleteForwardMethod(void *clientData);
static int		CloneForwardMethod(Tcl_Interp *interp,
			    ClientData clientData, ClientData *newClientData);
			    void *clientData, void **newClientData);
static int		ProcedureMethodVarResolver(Tcl_Interp *interp,
			    const char *varName, Tcl_Namespace *contextNs,
			    int flags, Tcl_Var *varPtr);
static int		ProcedureMethodCompiledVarResolver(Tcl_Interp *interp,
			    const char *varName, int length,
			    Tcl_Namespace *contextNs,
			    Tcl_ResolvedVarInfo **rPtrPtr);
142
143
144
145
146
147
148
149

150
151
152
153
154
155
156
142
143
144
145
146
147
148

149
150
151
152
153
154
155
156







-
+







				 * up to caller to manage storage (e.g., when
				 * it is a constructor or destructor). */
    int flags,			/* Whether this is a public method. */
    const Tcl_MethodType *typePtr,
				/* The type of method this is, which defines
				 * how to invoke, delete and clone the
				 * method. */
    ClientData clientData)	/* Some data associated with the particular
    void *clientData)	/* Some data associated with the particular
				 * method to be created. */
{
    register Object *oPtr = (Object *) object;
    register Method *mPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

214
215
216
217
218
219
220
221

222
223
224
225
226
227
228
214
215
216
217
218
219
220

221
222
223
224
225
226
227
228







-
+







				 * for constructors or destructors); if so, up
				 * to caller to manage storage. */
    int flags,			/* Whether this is a public method. */
    const Tcl_MethodType *typePtr,
				/* The type of method this is, which defines
				 * how to invoke, delete and clone the
				 * method. */
    ClientData clientData)	/* Some data associated with the particular
    void *clientData)	/* Some data associated with the particular
				 * method to be created. */
{
    register Class *clsPtr = (Class *) cls;
    register Method *mPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

454
455
456
457
458
459
460
461

462
463
464
465
466
467
468
454
455
456
457
458
459
460

461
462
463
464
465
466
467
468







-
+







				 * NULL. */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which _must not_ be NULL. */
    Tcl_Obj *bodyObj,		/* The body of the method, which _must not_ be
				 * NULL. */
    const Tcl_MethodType *typePtr,
				/* The type of the method to create. */
    ClientData clientData,	/* The per-method type-specific data. */
    void *clientData,	/* The per-method type-specific data. */
    Proc **procPtrPtr)		/* A pointer to the variable in which to write
				 * the procedure record reference. Presumably
				 * inside the structure indicated by the
				 * pointer in clientData. */
{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr;
567
568
569
570
571
572
573
574

575
576
577
578
579
580
581
567
568
569
570
571
572
573

574
575
576
577
578
579
580
581







-
+







				 * _must not_ be NULL. */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which _must not_ be NULL. */
    Tcl_Obj *bodyObj,		/* The body of the method, which _must not_ be
				 * NULL. */
    const Tcl_MethodType *typePtr,
				/* The type of the method to create. */
    ClientData clientData,	/* The per-method type-specific data. */
    void *clientData,	/* The per-method type-specific data. */
    Proc **procPtrPtr)		/* A pointer to the variable in which to write
				 * the procedure record reference. Presumably
				 * inside the structure indicated by the
				 * pointer in clientData. */
{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr;
662
663
664
665
666
667
668
669

670
671
672
673
674
675
676
662
663
664
665
666
667
668

669
670
671
672
673
674
675
676







-
+







 *	How to invoke a procedure-like method.
 *
 * ----------------------------------------------------------------------
 */

static int
InvokeProcedureMethod(
    ClientData clientData,	/* Pointer to some per-method context. */
    void *clientData,	/* Pointer to some per-method context. */
    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;
741
742
743
744
745
746
747
748

749
750
751
752
753
754
755
741
742
743
744
745
746
747

748
749
750
751
752
753
754
755







-
+







    TclNRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL);
    return TclNRInterpProcCore(interp, fdPtr->nameObj,
	    Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc);
}

static int
FinalizePMCall(
    ClientData data[],
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    ProcedureMethod *pmPtr = data[0];
    Tcl_ObjectContext context = data[1];
    PMFrameData *fdPtr = data[2];

1148
1149
1150
1151
1152
1153
1154
1155

1156
1157
1158
1159
1160
1161
1162
1148
1149
1150
1151
1152
1153
1154

1155
1156
1157
1158
1159
1160
1161
1162







-
+







 *	itself) isn't done until it is needed.
 *
 * ----------------------------------------------------------------------
 */

static Tcl_Obj *
RenderDeclarerName(
    ClientData clientData)
    void *clientData)
{
    struct PNI *pni = clientData;
    Tcl_Object object = Tcl_MethodDeclarerObject(pni->method);

    if (object == NULL) {
	object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pni->method));
    }
1290
1291
1292
1293
1294
1295
1296
1297

1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310


1311
1312
1313
1314
1315
1316
1317
1290
1291
1292
1293
1294
1295
1296

1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308


1309
1310
1311
1312
1313
1314
1315
1316
1317







-
+











-
-
+
+







	pmPtr->deleteClientdataProc(pmPtr->clientData);
    }
    ckfree(pmPtr);
}

static void
DeleteProcedureMethod(
    ClientData clientData)
    void *clientData)
{
    register ProcedureMethod *pmPtr = clientData;

    if (pmPtr->refCount-- <= 1) {
	DeleteProcedureMethodRecord(pmPtr);
    }
}

static int
CloneProcedureMethod(
    Tcl_Interp *interp,
    ClientData clientData,
    ClientData *newClientData)
    void *clientData,
    void **newClientData)
{
    ProcedureMethod *pmPtr = clientData;
    ProcedureMethod *pm2Ptr;
    Tcl_Obj *bodyObj, *argsObj;
    CompiledLocal *localPtr;

    /*
1456
1457
1458
1459
1460
1461
1462
1463

1464
1465
1466
1467
1468
1469
1470
1456
1457
1458
1459
1460
1461
1462

1463
1464
1465
1466
1467
1468
1469
1470







-
+







 *	command rearranging and then invokes some other Tcl command.
 *
 * ----------------------------------------------------------------------
 */

static int
InvokeForwardMethod(
    ClientData clientData,	/* Pointer to some per-method context. */
    void *clientData,	/* Pointer to some per-method context. */
    Tcl_Interp *interp,
    Tcl_ObjectContext context,	/* The method calling context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Arguments as actually seen. */
{
    CallContext *contextPtr = (CallContext *) context;
    ForwardMethod *fmPtr = clientData;
1490
1491
1492
1493
1494
1495
1496
1497

1498
1499
1500
1501
1502
1503
1504
1490
1491
1492
1493
1494
1495
1496

1497
1498
1499
1500
1501
1502
1503
1504







-
+







    ((Interp *)interp)->lookupNsPtr
	    = (Namespace *) contextPtr->oPtr->namespacePtr;
    return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, NULL);
}

static int
FinalizeForwardCall(
    ClientData data[],
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **argObjs = data[0];

    TclStackFree(interp, argObjs);
    return result;
1512
1513
1514
1515
1516
1517
1518
1519

1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531


1532
1533
1534
1535
1536
1537
1538
1512
1513
1514
1515
1516
1517
1518

1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529


1530
1531
1532
1533
1534
1535
1536
1537
1538







-
+










-
-
+
+







 *	How to delete and clone forwarded methods.
 *
 * ----------------------------------------------------------------------
 */

static void
DeleteForwardMethod(
    ClientData clientData)
    void *clientData)
{
    ForwardMethod *fmPtr = clientData;

    Tcl_DecrRefCount(fmPtr->prefixObj);
    ckfree(fmPtr);
}

static int
CloneForwardMethod(
    Tcl_Interp *interp,
    ClientData clientData,
    ClientData *newClientData)
    void *clientData,
    void **newClientData)
{
    ForwardMethod *fmPtr = clientData;
    ForwardMethod *fm2Ptr = ckalloc(sizeof(ForwardMethod));

    fm2Ptr->prefixObj = fmPtr->prefixObj;
    Tcl_IncrRefCount(fm2Ptr->prefixObj);
    *newClientData = fm2Ptr;
1673
1674
1675
1676
1677
1678
1679
1680

1681
1682
1683
1684
1685
1686
1687
1673
1674
1675
1676
1677
1678
1679

1680
1681
1682
1683
1684
1685
1686
1687







-
+







    return ((Method *) method)->namePtr;
}

int
Tcl_MethodIsType(
    Tcl_Method method,
    const Tcl_MethodType *typePtr,
    ClientData *clientDataPtr)
    void **clientDataPtr)
{
    Method *mPtr = (Method *) method;

    if (mPtr->typePtr == typePtr) {
	if (clientDataPtr != NULL) {
	    *clientDataPtr = mPtr->clientData;
	}
1711
1712
1713
1714
1715
1716
1717
1718

1719
1720
1721
1722
1723
1724
1725
1711
1712
1713
1714
1715
1716
1717

1718
1719
1720
1721
1722
1723
1724
1725







-
+







Tcl_Method
TclOONewProcInstanceMethodEx(
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    Tcl_Object oPtr,		/* The object to modify. */
    TclOO_PreCallProc *preCallPtr,
    TclOO_PostCallProc *postCallPtr,
    ProcErrorProc *errProc,
    ClientData clientData,
    void *clientData,
    Tcl_Obj *nameObj,		/* The name of the method, which must not be
				 * NULL. */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which must not be NULL. */
    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
				 * NULL. */
    int flags,			/* Whether this is a public method. */
1748
1749
1750
1751
1752
1753
1754
1755

1756
1757
1758
1759
1760
1761
1762
1748
1749
1750
1751
1752
1753
1754

1755
1756
1757
1758
1759
1760
1761
1762







-
+







Tcl_Method
TclOONewProcMethodEx(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Tcl_Class clsPtr,		/* The class to modify. */
    TclOO_PreCallProc *preCallPtr,
    TclOO_PostCallProc *postCallPtr,
    ProcErrorProc *errProc,
    ClientData clientData,
    void *clientData,
    Tcl_Obj *nameObj,		/* The name of the method, which may be NULL;
				 * if so, up to caller to manage storage
				 * (e.g., because it is a constructor or
				 * destructor). */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which may be NULL; if so, it is equivalent
				 * to an empty list. */