Diff
Not logged in
Home Timeline Branches Tags Tickets Wiki Login
Annotate Patch Side-by-side Diff

Differences From Artifact [6c847ae5ad]:

To Artifact [e42a6eb76c]:

︙
148
149
150
151
152
153
154
155
156



157
158
159
160
161
162



163
164
165
166
167

168
169


170
171
172
173
174
175
176
177

148
149
150
151
152
153
154


155
156
157
158
159
160
161


162
163
164
165
166
167
168
169
170


171
172

173
174
175
176
177
178
179








-
-
+
+
+




-
-
+
+
+





+
-
-
+
+
-








     */

    fullName = TclGetString(objv[1]);
    TclGetNamespaceForQualName(interp, fullName, NULL, 0,
	    &nsPtr, &altNsPtr, &cxtNsPtr, &procName);

    if (nsPtr == NULL) {
	Tcl_AppendResult(interp, "can't create procedure \"", fullName,
		"\": unknown namespace", NULL);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create procedure \"%s\": unknown namespace",
		fullName));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
	return TCL_ERROR;
    }
    if (procName == NULL) {
	Tcl_AppendResult(interp, "can't create procedure \"", fullName,
		"\": bad procedure name", NULL);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create procedure \"%s\": bad procedure name",
		fullName));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
	return TCL_ERROR;
    }
    if ((nsPtr != iPtr->globalNsPtr)
	    && (procName != NULL) && (procName[0] == ':')) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	Tcl_AppendResult(interp, "can't create procedure \"", procName,
		"\" in non-global namespace with name starting with \":\"",
		"can't create procedure \"%s\" in non-global namespace with"
		" name starting with \":\"", procName));
		NULL);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
	return TCL_ERROR;
    }

    /*
     * Create the data structure to represent the procedure.
     */
︙
514
515
516
517
518
519
520
521
522
523



524
525
526
527
528
529

530

531
532
533
534
535
536
537

516
517
518
519
520
521
522



523
524
525
526
527
528
529
530
531
532

533
534
535
536
537
538
539
540








-
-
-
+
+
+






+
-
+








	result = Tcl_SplitList(interp, argArray[i], &fieldCount,
		&fieldValues);
	if (result != TCL_OK) {
	    goto procError;
	}
	if (fieldCount > 2) {
	    ckfree(fieldValues);
	    Tcl_AppendResult(interp,
		    "too many fields in argument specifier \"",
		    argArray[i], "\"", NULL);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "too many fields in argument specifier \"%s\"",
		    argArray[i]));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}
	if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
	    ckfree(fieldValues);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    Tcl_AppendResult(interp, "argument with no name", NULL);
		    "argument with no name", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}

	nameLength = strlen(fieldValues[0]);
	if (fieldCount == 2) {
︙
549
550
551
552
553
554
555

556
557


558
559
560
561
562
563

564
565


566
567
568
569
570
571
572

552
553
554
555
556
557
558
559


560
561
562
563
564
565
566
567
568


569
570
571
572
573
574
575
576
577








+
-
-
+
+






+
-
-
+
+








	    if (*p == '(') {
		const char *q = p;
		do {
		    q++;
		} while (*q != '\0');
		q--;
		if (*q == ')') {	/* We have an array element. */
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    Tcl_AppendResult(interp, "formal parameter \"",
			    fieldValues[0], "\" is an array element", NULL);
			    "formal parameter \"%s\" is an array element",
			    fieldValues[0]));
		    ckfree(fieldValues);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			    "FORMALARGUMENTFORMAT", NULL);
		    goto procError;
		}
	    } else if ((*p == ':') && (*(p+1) == ':')) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		Tcl_AppendResult(interp, "formal parameter \"",
			fieldValues[0], "\" is not a simple name", NULL);
			"formal parameter \"%s\" is not a simple name",
			fieldValues[0]));
		ckfree(fieldValues);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			"FORMALARGUMENTFORMAT", NULL);
		goto procError;
	    }
	    p++;
	}
︙
763
764
765
766
767
768
769
770

771
772
773
774
775
776
777
778

768
769
770
771
772
773
774

775

776
777
778
779
780
781
782








-
+
-








	goto levelError;
    }

    *framePtrPtr = framePtr;
    return result;

  levelError:
    Tcl_ResetResult(interp);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
    Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
︙
896
897
898
899
900
901
902
903

904
905
906
907
908
909
910
911

900
901
902
903
904
905
906

907

908
909
910
911
912
913
914








-
+
-








    if (framePtr == NULL) {
	goto levelError;
    }
    *framePtrPtr = framePtr;
    return result;

  levelError:
    Tcl_ResetResult(interp);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
    Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
︙
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884



1885
1886
1887
1888
1889
1890
1891
1892

1878
1879
1880
1881
1882
1883
1884



1885
1886
1887

1888
1889
1890
1891
1892
1893
1894








-
-
-
+
+
+
-








    case TCL_CONTINUE:
    case TCL_BREAK:
	/*
	 * It's an error to get to this point from a 'break' or 'continue', so
	 * transform to an error now.
	 */

	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "invoked \"",
		((result == TCL_BREAK) ? "break" : "continue"),
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"invoked \"%s\" outside of a loop",
		((result == TCL_BREAK) ? "break" : "continue")));
		"\" outside of a loop", NULL);
	Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", NULL);
	result = TCL_ERROR;

	/*
	 * Fall through to the TCL_ERROR handling code.
	 */
︙
1995
1996
1997
1998
1999
2000
2001
2002
2003


2004
2005
2006
2007
2008
2009
2010

1997
1998
1999
2000
2001
2002
2003


2004
2005
2006
2007
2008
2009
2010
2011
2012








-
-
+
+








		&& (codePtr->nsPtr == nsPtr)
		&& (codePtr->nsEpoch == nsPtr->resolverEpoch)) {
	    return TCL_OK;
	}

	if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
	    if ((Interp *) *codePtr->interpHandle != iPtr) {
		Tcl_AppendResult(interp,
			"a precompiled script jumped interps", NULL);
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"a precompiled script jumped interps", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			"CROSSINTERPBYTECODE", NULL);
		return TCL_ERROR;
	    }
	    codePtr->compileEpoch = iPtr->compileEpoch;
	    codePtr->nsPtr = nsPtr;
	} else {
︙
2928
2929
2930
2931
2932
2933
2934
2935
2936


2937
2938
2939
2940
2941
2942
2943

2930
2931
2932
2933
2934
2935
2936


2937
2938
2939
2940
2941
2942
2943
2944
2945








-
-
+
+








	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "procName");
	    return TCL_ERROR;
	}

	procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
	if (procPtr == NULL) {
	    Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
		    "\" isn't a procedure", NULL);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "\"%s\" isn't a procedure", TclGetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
		    TclGetString(objv[2]), NULL);
	    return TCL_ERROR;
	}

	/*
	 * Compile (if uncompiled) and disassemble a procedure.
︙
2978
2979
2980
2981
2982
2983
2984
2985
2986


2987
2988
2989
2990
2991
2992
2993

2980
2981
2982
2983
2984
2985
2986


2987
2988
2989
2990
2991
2992
2993
2994
2995








-
-
+
+








	 */

	oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
	if (oPtr == NULL) {
	    return TCL_ERROR;
	}
	if (oPtr->classPtr == NULL) {
	    Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
		    "\" is not a class", NULL);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "\"%s\" is not a class", TclGetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
		    TclGetString(objv[2]), NULL);
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
		(char *) objv[3]);
	goto methodBody;
︙
3013
3014
3015
3016
3017
3018
3019
3020
3021


3022
3023
3024
3025
3026
3027
3028
3029


3030
3031
3032
3033
3034
3035
3036

3015
3016
3017
3018
3019
3020
3021


3022
3023
3024
3025
3026
3027
3028
3029


3030
3031
3032
3033
3034
3035
3036
3037
3038








-
-
+
+






-
-
+
+








	/*
	 * Compile (if necessary) and disassemble a method body.
	 */

    methodBody:
	if (hPtr == NULL) {
	unknownMethod:
	    Tcl_AppendResult(interp, "unknown method \"",
		    TclGetString(objv[3]), "\"", NULL);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "unknown method \"%s\"", TclGetString(objv[3])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		    TclGetString(objv[3]), NULL);
	    return TCL_ERROR;
	}
	procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
	if (procPtr == NULL) {
	    Tcl_AppendResult(interp,
		    "body not available for this kind of method", NULL);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "body not available for this kind of method", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "METHODTYPE", NULL);
	    return TCL_ERROR;
	}
	if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
	    Command cmd;
︙
3057
3058
3059
3060
3061
3062
3063

3064

3065
3066
3067
3068
3069
3070
3071

3059
3060
3061
3062
3063
3064
3065
3066

3067
3068
3069
3070
3071
3072
3073
3074








+
-
+









    /*
     * Do the actual disassembly.
     */

    if (((ByteCode *) codeObjPtr->internalRep.otherValuePtr)->flags
	    & TCL_BYTECODE_PRECOMPILED) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
	Tcl_AppendResult(interp,"may not disassemble prebuilt bytecode",NULL);
		"may not disassemble prebuilt bytecode", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		"BYTECODE", NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(codeObjPtr));
    return TCL_OK;
}
︙
This page was created in about 0.027s by Fossil version [1205ec86cb] 2025-04-30 16:57:32