Diff
Not logged in

Differences From Artifact [1087d152e0]:

To Artifact [8cd134a40f]:


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
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







-
+



-
+




-
-
+
+







				 * instead. */
    NULL			/* SetFromAny function; Tcl_ConvertToType
				 * should panic instead. */
};

#define ProcSetIntRep(objPtr, procPtr)					\
    do {								\
	Tcl_ObjIntRep ir;						\
	Tcl_ObjInternalRep ir;						\
	(procPtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (procPtr);				\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreIntRep((objPtr), &tclProcBodyType, &ir);		\
	Tcl_StoreInternalRep((objPtr), &tclProcBodyType, &ir);		\
    } while (0)

#define ProcGetIntRep(objPtr, procPtr)					\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &tclProcBodyType);		\
	const Tcl_ObjInternalRep *irPtr;					\
	irPtr = TclFetchInternalRep((objPtr), &tclProcBodyType);		\
	(procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

/*
 * The [upvar]/[uplevel] level reference type. Uses the longValue field
 * to remember the integer value of a parsed #<integer> format.
 *
111
112
113
114
115
116
117
118

119
120
121
122

123
124
125
126
127
128


129
130
131
132
133
134
135
111
112
113
114
115
116
117

118
119
120
121

122
123
124
125
126


127
128
129
130
131
132
133
134
135







-
+



-
+




-
-
+
+







    DupLambdaInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetLambdaFromAny		/* setFromAnyProc */
};

#define LambdaSetIntRep(objPtr, procPtr, nsObjPtr)			\
    do {								\
	Tcl_ObjIntRep ir;						\
	Tcl_ObjInternalRep ir;						\
	ir.twoPtrValue.ptr1 = (procPtr);				\
	ir.twoPtrValue.ptr2 = (nsObjPtr);				\
	Tcl_IncrRefCount((nsObjPtr));					\
	Tcl_StoreIntRep((objPtr), &lambdaType, &ir);			\
	Tcl_StoreInternalRep((objPtr), &lambdaType, &ir);			\
    } while (0)

#define LambdaGetIntRep(objPtr, procPtr, nsObjPtr)			\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &lambdaType);			\
	const Tcl_ObjInternalRep *irPtr;					\
	irPtr = TclFetchInternalRep((objPtr), &lambdaType);			\
	(procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL;		\
	(nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL;		\
    } while (0)


/*
 *----------------------------------------------------------------------
146
147
148
149
150
151
152
153

154
155
156
157
158
159
160
146
147
148
149
150
151
152

153
154
155
156
157
158
159
160







-
+







 *	A new procedure gets created.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ProcObjCmd(
    TCL_UNUSED(ClientData),
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr;
    const char *procName;
526
527
528
529
530
531
532
533

534
535
536
537
538
539
540
526
527
528
529
530
531
532

533
534
535
536
537
538
539
540







-
+







	    Tcl_AppendObjToObj(errorObj, argArray[i]);
	    Tcl_AppendToObj(errorObj, "\"", -1);
	    Tcl_SetObjResult(interp, errorObj);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}
	if ((fieldCount == 0) || (fieldValues[0]->length == 0)) {
	if ((fieldCount == 0) || (Tcl_GetCharLength(fieldValues[0]) == 0)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument with no name", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}

720
721
722
723
724
725
726
727

728
729
730
731
732
733
734
720
721
722
723
724
725
726

727
728
729
730
731
732
733
734







-
+







	int result;
	Tcl_Obj obj;

	obj.bytes = (char *) name;
	obj.length = strlen(name);
	obj.typePtr = NULL;
	result = TclObjGetFrame(interp, &obj, framePtrPtr);
	TclFreeIntRep(&obj);
	TclFreeInternalRep(&obj);
	return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjGetFrame --
758
759
760
761
762
763
764
765

766
767
768
769
770
771
772
758
759
760
761
762
763
764

765
766
767
768
769
770
771
772







-
+







    Tcl_Interp *interp,		/* Interpreter in which to find frame. */
    Tcl_Obj *objPtr,		/* Object describing frame. */
    CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
				 * global frame indicated). */
{
    Interp *iPtr = (Interp *) interp;
    int curLevel, level, result;
    const Tcl_ObjIntRep *irPtr;
    const Tcl_ObjInternalRep *irPtr;
    const char *name = NULL;
    Tcl_WideInt w;

    /*
     * Parse object to figure out which level number to go to.
     */

784
785
786
787
788
789
790
791

792
793
794
795
796
797
798
799
800
801

802
803
804

805
806
807
808
809
810
811
784
785
786
787
788
789
790

791
792
793
794
795
796
797
798
799
800

801
802
803

804
805
806
807
808
809
810
811







-
+









-
+


-
+







	Tcl_GetWideIntFromObj(NULL, objPtr, &w);
	if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) {
	    result = -1;
	} else {
	    level = curLevel - level;
	    result = 1;
	}
    } else if ((irPtr = TclFetchIntRep(objPtr, &levelReferenceType))) {
    } else if ((irPtr = TclFetchInternalRep(objPtr, &levelReferenceType))) {
	level = irPtr->wideValue;
	result = 1;
    } else {
	name = TclGetString(objPtr);
	if (name[0] == '#') {
	    if (TCL_OK == Tcl_GetInt(NULL, name+1, &level)) {
		if (level < 0 || (level > 0 && name[1] == '-')) {
		    result = -1;
		} else {
		    Tcl_ObjIntRep ir;
		    Tcl_ObjInternalRep ir;

		    ir.wideValue = level;
		    Tcl_StoreIntRep(objPtr, &levelReferenceType, &ir);
		    Tcl_StoreInternalRep(objPtr, &levelReferenceType, &ir);
		    result = 1;
		}
	    } else {
		result = -1;
	    }
	} else if (TclGetWideBitsFromObj(NULL, objPtr, &w) == TCL_OK) {
	    /*
892
893
894
895
896
897
898
899

900
901
902
903
904
905
906
892
893
894
895
896
897
898

899
900
901
902
903
904
905
906







-
+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRUplevelObjCmd, clientData, objc, objv);
}

int
TclNRUplevelObjCmd(
    TCL_UNUSED(ClientData),
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    Interp *iPtr = (Interp *) interp;
    CmdFrame *invoker = NULL;
1270
1271
1272
1273
1274
1275
1276
1277

1278
1279
1280
1281
1282
1283
1284
1270
1271
1272
1273
1274
1275
1276

1277
1278
1279
1280
1281
1282
1283
1284







-
+







    int numArgs = procPtr->numArgs, i = 0;

    Tcl_Obj **namePtr;
    Var *varPtr;
    LocalCache *localCachePtr;
    CompiledLocal *localPtr;

    ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
    ByteCodeGetInternalRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);

    /*
     * Cache the names and initial values of local variables; store the
     * cache in both the framePtr for this execution and in the codePtr
     * for future calls.
     */

1342
1343
1344
1345
1346
1347
1348
1349

1350
1351
1352
1353
1354
1355
1356
1342
1343
1344
1345
1346
1347
1348

1349
1350
1351
1352
1353
1354
1355
1356







-
+







    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    Proc *procPtr = framePtr->procPtr;
    ByteCode *codePtr;
    Var *varPtr, *defPtr;
    int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
    Tcl_Obj *const *argObjs;

    ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
    ByteCodeGetInternalRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);

    /*
     * Make sure that the local cache of variable names and initial values has
     * been initialised properly .
     */

    if (localCt) {
1518
1519
1520
1521
1522
1523
1524
1525

1526
1527
1528
1529
1530
1531
1532
1518
1519
1520
1521
1522
1523
1524

1525
1526
1527
1528
1529
1530
1531
1532







-
+







     * If necessary (i.e. if we haven't got a suitable compilation already
     * cached) compile the procedure's body. The compiler will allocate frame
     * slots for the procedure's non-argument local variables. Note that
     * compiling the body might increase procPtr->numCompiledLocals if new
     * local variables are found while compiling.
     */

    ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
    ByteCodeGetInternalRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
    if (codePtr != NULL) {
	Interp *iPtr = (Interp *) interp;

	/*
	 * When we've got bytecode, this is the check for validity. That is,
	 * the bytecode must be for the right interpreter (no cross-leaks!),
	 * the code must be from the current epoch (so subcommand compilation
1728
1729
1730
1731
1732
1733
1734
1735

1736
1737
1738
1739
1740
1741
1742
1728
1729
1730
1731
1732
1733
1734

1735
1736
1737
1738
1739
1740
1741
1742







-
+







#endif /* USE_DTRACE */

    /*
     * Invoke the commands in the procedure's body.
     */

    procPtr->refCount++;
    ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
    ByteCodeGetInternalRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);

    TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
	    NULL, NULL);
    return TclNRExecuteByteCode(interp, codePtr);
}

static int
1862
1863
1864
1865
1866
1867
1868
1869

1870
1871
1872
1873
1874
1875
1876
1862
1863
1864
1865
1866
1867
1868

1869
1870
1871
1872
1873
1874
1875
1876







-
+







    const char *description,	/* string describing this body of code. */
    const char *procName)	/* Name of this procedure. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_CallFrame *framePtr;
    ByteCode *codePtr;

    ByteCodeGetIntRep(bodyPtr, &tclByteCodeType, codePtr);
    ByteCodeGetInternalRep(bodyPtr, &tclByteCodeType, codePtr);

    /*
     * If necessary, compile the procedure's body. The compiler will allocate
     * frame slots for the procedure's non-argument local variables. If the
     * ByteCode already exists, make sure it hasn't been invalidated by
     * someone redefining a core command (this might make the compiled code
     * wrong). Also, if the code was compiled in/for a different interpreter,
1897
1898
1899
1900
1901
1902
1903
1904

1905
1906
1907
1908
1909
1910
1911
1897
1898
1899
1900
1901
1902
1903

1904
1905
1906
1907
1908
1909
1910
1911







-
+







		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			"CROSSINTERPBYTECODE", NULL);
		return TCL_ERROR;
	    }
	    codePtr->compileEpoch = iPtr->compileEpoch;
	    codePtr->nsPtr = nsPtr;
	} else {
	    Tcl_StoreIntRep(bodyPtr, &tclByteCodeType, NULL);
	    Tcl_StoreInternalRep(bodyPtr, &tclByteCodeType, NULL);
	    codePtr = NULL;
	}
    }

    if (codePtr == NULL) {
	Tcl_HashEntry *hePtr;

2593
2594
2595
2596
2597
2598
2599
2600

2601
2602
2603
2604
2605
2606
2607
2593
2594
2595
2596
2597
2598
2599

2600
2601
2602
2603
2604
2605
2606
2607







-
+







    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRApplyObjCmd, clientData, objc, objv);
}

int
TclNRApplyObjCmd(
    TCL_UNUSED(ClientData),
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Proc *procPtr = NULL;
    Tcl_Obj *lambdaPtr, *nsObjPtr;
    int result;