Diff
Not logged in

Differences From Artifact [001bff7698]:

To Artifact [00fc6b51db]:


95
96
97
98
99
100
101
102










103
104
105
106
107
108
109
95
96
97
98
99
100
101

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118







-
+
+
+
+
+
+
+
+
+
+







 * Helper macros (derived from things private to tclVar.c)
 */

#define TclVarTable(contextNs) \
    ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable))
#define TclVarHashGetValue(hPtr) \
    ((Tcl_Var) ((char *)hPtr - offsetof(VarInHash, entry)))


/*
 * ----------------------------------------------------------------------
 *
 * AllocProcedureMethodRecord --
 *
 *	Allocate and initialise the record for procedure-like methods.
 *
 * ----------------------------------------------------------------------
 */
static inline ProcedureMethod *
AllocProcedureMethodRecord(
    int flags)
{
    ProcedureMethod *pmPtr = (ProcedureMethod *)
	    Tcl_Alloc(sizeof(ProcedureMethod));
    memset(pmPtr, 0, sizeof(ProcedureMethod));
581
582
583
584
585
586
587
588


589
590
591
592
593
594
595
590
591
592
593
594
595
596

597
598
599
600
601
602
603
604
605







-
+
+







	     * 'context' is going out of scope; account for the reference that
	     * it's holding to the path name.
	     */

	    Tcl_DecrRefCount(context.data.eval.path);
	    context.data.eval.path = NULL;
	}
    }}
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOMakeProcInstanceMethod --
 *
 *	The guts of the code to make a procedure-like method for an object.
776
777
778
779
780
781
782
783

784
785
786
787
788
789
790
791
792

793
794
795
796
797
798
799
786
787
788
789
790
791
792

793
794
795
796
797
798
799
800
801

802
803
804
805
806
807
808
809







-
+








-
+







    return TclNewMethod((Tcl_Class) clsPtr, nameObj, flags,
	    (const Tcl_MethodType *)typePtr, clientData);
}

/*
 * ----------------------------------------------------------------------
 *
 * InvokeProcedureMethod, PushMethodCallFrame --
 * InvokeProcedureMethod, FinalizePMCall, PushMethodCallFrame --
 *
 *	How to invoke a procedure-like method.
 *
 * ----------------------------------------------------------------------
 */

static int
InvokeProcedureMethod(
    void *clientData,		/* Pointer to some per-method context. */
    void *clientData,		/* Pointer to the per-method record. */
    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 = (ProcedureMethod *) clientData;
    int result;
889
890
891
892
893
894
895
896
897
898



899
900
901
902
903
904
905
899
900
901
902
903
904
905



906
907
908
909
910
911
912
913
914
915







-
-
-
+
+
+







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

static int
FinalizePMCall(
    void *data[],
    Tcl_Interp *interp,
    int result)
    void *data[],		/* Data from InvokeProcedureMethod. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int result)			/* Result of the body of the method. */
{
    ProcedureMethod *pmPtr = (ProcedureMethod *) data[0];
    Tcl_ObjectContext context = (Tcl_ObjectContext) data[1];
    PMFrameData *fdPtr = (PMFrameData *) data[2];

    /*
     * Give the post-call callback a chance to do some cleanup. Note that at
1543
1544
1545
1546
1547
1548
1549
1550

1551
1552
1553
1554
1555
1556
1557
1553
1554
1555
1556
1557
1558
1559

1560
1561
1562
1563
1564
1565
1566
1567







-
+







    return (Method *) TclNewMethod((Tcl_Class) clsPtr, nameObj,
	    flags, &fwdMethodType, fmPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * InvokeForwardMethod --
 * InvokeForwardMethod, FinalizeForwardCall --
 *
 *	How to invoke a forwarded method. Works by doing some ensemble-like
 *	command rearranging and then invokes some other Tcl command.
 *
 * ----------------------------------------------------------------------
 */

1575
1576
1577
1578
1579
1580
1581
1582

1583
1584
1585
1586
1587
1588
1589
1585
1586
1587
1588
1589
1590
1591

1592
1593
1594
1595
1596
1597
1598
1599







-
+







     * non-empty list, so there's a whole class of failures ("not a list") we
     * can ignore here.
     */

    TclListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs);
    argObjs = InitEnsembleRewrite(interp, objc, objv, skip,
	    numPrefixes, prefixObjs, &len);
    Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
    TclNRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
    /*
     * NOTE: The combination of direct set of iPtr->lookupNsPtr and the use
     * of the TCL_EVAL_NOERR flag results in an evaluation configuration
     * very much like TCL_EVAL_INVOKE.
     */
    ((Interp *) interp)->lookupNsPtr = (Namespace *)
	    contextPtr->oPtr->namespacePtr;
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1713
1714
1715
1716
1717
1718
1719

1720
1721
1722
1723
1724
1725
1726







-







 *                           |                    |
 *                           V                    V
 *      argObjs:     |=================|===============================|
 *                    <------------------*lengthPtr------------------->
 *
 * ----------------------------------------------------------------------
 */

static Tcl_Obj **
InitEnsembleRewrite(
    Tcl_Interp *interp,		/* Place to log the rewrite info. */
    int objc,			/* Number of real arguments. */
    Tcl_Obj *const *objv,	/* The real arguments. */
    int toRewrite,		/* Number of real arguments to replace. */
    int rewriteLength,		/* Number of arguments to insert instead. */