Tcl Source Code

Check-in [71773cb9e6]
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Implement Tcl_Pkg* functions as macro's around Tcl_Pkg*Ex. This saves stack space, is (marginally) faster, while still being fully up/down compatible. It makes pkgb.so loadable in "novem" without the need to change the Tcl_PkgProvide() call to Tcl_PkgProvideEx().
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-4-branch
Files: files | file ages | folders
SHA1: 71773cb9e65a06ceb0939c9d3ea03c8191c1211b
User & Date: jan.nijtmans 2013-04-12 11:08:18
Context
2013-04-19
08:19
Implement many Tcl_*Var* functions and Tcl_GetIndexFromObj as (faster/stack-saving) macros around re... check-in: 7b32308075 user: jan.nijtmans tags: core-8-4-branch
2013-04-17
15:31
Merge 8.4; Tag for release. check-in: 6c8196ee30 user: dgp tags: core-8-4-20-rc, rc1
2013-04-12
11:22
Implement Tcl_Pkg* functions as macro's around Tcl_Pkg*Ex. This saves stack space, is (marginally) f... check-in: 7314d4f7dc user: jan.nijtmans tags: core-8-5-branch
11:08
Implement Tcl_Pkg* functions as macro's around Tcl_Pkg*Ex. This saves stack space, is (marginally) f... check-in: 71773cb9e6 user: jan.nijtmans tags: core-8-4-branch
2013-04-09
11:04
Allow URLs that don't have a path, but a query, e.g. http://example.com?foo=bar and bump http to 2.5... check-in: 0df32cd91c user: jan.nijtmans tags: core-8-4-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclDecls.h.

︙︙
4512
4513
4514
4515
4516
4517
4518










4519
4520
4521
4522
4523
4524
4525


#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef TclUnusedStubEntry











/*
 * Deprecated Tcl procedures:
 */
#undef Tcl_EvalObj
#define Tcl_EvalObj(interp,objPtr) \
    Tcl_EvalObjEx((interp),(objPtr),0)
#undef Tcl_GlobalEvalObj








>
>
>
>
>
>
>
>
>
>








4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535


#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef TclUnusedStubEntry

#undef Tcl_PkgPresent
#define Tcl_PkgPresent(interp, name, version, exact) \
	Tcl_PkgPresentEx(interp, name, version, exact, NULL)
#undef Tcl_PkgProvide
#define Tcl_PkgProvide(interp, name, version) \
	Tcl_PkgProvideEx(interp, name, version, NULL)
#undef Tcl_PkgRequire
#define Tcl_PkgRequire(interp, name, version, exact) \
	Tcl_PkgRequireEx(interp, name, version, exact, NULL)

/*
 * Deprecated Tcl procedures:
 */
#undef Tcl_EvalObj
#define Tcl_EvalObj(interp,objPtr) \
    Tcl_EvalObjEx((interp),(objPtr),0)
#undef Tcl_GlobalEvalObj
︙︙

Changes to generic/tclPkg.c.

︙︙
115
116
117
118
119
120
121

122
123
124
125
126
127
128

 *	The interpreter remembers that this package is available,
 *	so that no other version of the package may be provided for
 *	the interpreter.
 *
 *----------------------------------------------------------------------
 */


int
Tcl_PkgProvide(interp, name, version)
     Tcl_Interp *interp;	/* Interpreter in which package is now
				 * available. */
     CONST char *name;		/* Name of package. */
     CONST char *version;	/* Version string for package. */
{








>








115
116
117
118
119
120
121
122
123
124
125
126
127
128
129

 *	The interpreter remembers that this package is available,
 *	so that no other version of the package may be provided for
 *	the interpreter.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_PkgProvide
int
Tcl_PkgProvide(interp, name, version)
     Tcl_Interp *interp;	/* Interpreter in which package is now
				 * available. */
     CONST char *name;		/* Name of package. */
     CONST char *version;	/* Version string for package. */
{
︙︙
219
220
221
222
223
224
225

226
227
228
229
230
231
232

     Tcl_Obj *CONST reqv[];     /* 0 means to use the latest version available. */
     ClientData *clientDataPtr;
{
    return TCL_ERROR;
}
#endif


CONST char *
Tcl_PkgRequire(interp, name, version, exact)
    Tcl_Interp *interp;	        /* Interpreter in which package is now
				 * available. */
     CONST char *name;		/* Name of desired package. */
     CONST char *version;	/* Version string for desired version; NULL
				 * means use the latest version available. */








>








220
221
222
223
224
225
226
227
228
229
230
231
232
233
234

     Tcl_Obj *CONST reqv[];     /* 0 means to use the latest version available. */
     ClientData *clientDataPtr;
{
    return TCL_ERROR;
}
#endif

#undef Tcl_PkgRequire
CONST char *
Tcl_PkgRequire(interp, name, version, exact)
    Tcl_Interp *interp;	        /* Interpreter in which package is now
				 * available. */
     CONST char *name;		/* Name of desired package. */
     CONST char *version;	/* Version string for desired version; NULL
				 * means use the latest version available. */
︙︙
823
824
825
826
827
828
829

830
831
832
833
834
835
836

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */


CONST char *
Tcl_PkgPresent(interp, name, version, exact)
     Tcl_Interp *interp;	/* Interpreter in which package is now
				 * available. */
     CONST char *name;		/* Name of desired package. */
     CONST char *version;	/* Version string for desired version;
				 * NULL means use the latest version








>








825
826
827
828
829
830
831
832
833
834
835
836
837
838
839

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_PkgPresent
CONST char *
Tcl_PkgPresent(interp, name, version, exact)
     Tcl_Interp *interp;	/* Interpreter in which package is now
				 * available. */
     CONST char *name;		/* Name of desired package. */
     CONST char *version;	/* Version string for desired version;
				 * NULL means use the latest version
︙︙
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137

	    } 
	    if ((objc > 3) && (CheckVersionAndConvert(interp,
		    TclGetString(objv[3]), NULL, NULL) == TCL_OK)) {
		version = TclGetString(objv[3]);
	    }
	}
#endif
	Tcl_PkgPresent(interp, name, version, exact);
	return TCL_ERROR;
	break;
    }
    case PKG_PROVIDE: {
	if ((objc != 3) && (objc != 4)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");
	    return TCL_ERROR;








|








1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140

	    } 
	    if ((objc > 3) && (CheckVersionAndConvert(interp,
		    TclGetString(objv[3]), NULL, NULL) == TCL_OK)) {
		version = TclGetString(objv[3]);
	    }
	}
#endif
	Tcl_PkgPresentEx(interp, name, version, exact, NULL);
	return TCL_ERROR;
	break;
    }
    case PKG_PROVIDE: {
	if ((objc != 3) && (objc != 4)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");
	    return TCL_ERROR;
︙︙
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165

#ifndef TCL_TIP268
	if (CheckVersion(interp, argv3) != TCL_OK) {
#else
	if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) {
#endif
	    return TCL_ERROR;
	}
	return Tcl_PkgProvide(interp, argv2, argv3);
    }
    case PKG_REQUIRE: {
    require:
	if (objc < 3) {
	requireSyntax:
#ifndef TCL_TIP268
	    Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");








|








1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168

#ifndef TCL_TIP268
	if (CheckVersion(interp, argv3) != TCL_OK) {
#else
	if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) {
#endif
	    return TCL_ERROR;
	}
	return Tcl_PkgProvideEx(interp, argv2, argv3, NULL);
    }
    case PKG_REQUIRE: {
    require:
	if (objc < 3) {
	requireSyntax:
#ifndef TCL_TIP268
	    Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");
︙︙
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199

		return TCL_ERROR;
	    }
	} else if ((objc != 3) || exact) {
	    goto requireSyntax;
	}
	if (exact) {
	    argv3 =  Tcl_GetString(objv[3]);
	    version = Tcl_PkgRequire(interp, argv3, version, exact);
	} else {
	    version = Tcl_PkgRequire(interp, argv2, version, exact);
	}
	if (version == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );
#else
	version = NULL;








|

|








1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202

		return TCL_ERROR;
	    }
	} else if ((objc != 3) || exact) {
	    goto requireSyntax;
	}
	if (exact) {
	    argv3 =  Tcl_GetString(objv[3]);
	    version = Tcl_PkgRequireEx(interp, argv3, version, exact, NULL);
	} else {
	    version = Tcl_PkgRequireEx(interp, argv2, version, exact, NULL);
	}
	if (version == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );
#else
	version = NULL;
︙︙

Changes to unix/dltest/pkgb.c.

︙︙
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134


    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }
    code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd,
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd,
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);








|








120
121
122
123
124
125
126
127
128
129
130
131
132
133
134


    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }
    code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd,
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd,
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
︙︙
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175


    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }
    code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, (ClientData) 0,
	    (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}








|








161
162
163
164
165
166
167
168
169
170
171
172
173
174
175


    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }
    code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, (ClientData) 0,
	    (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}

This page was generated in about 0.049s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19