| ︙ | | | ︙ | |
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target;
LoadedPackage *pkgPtr, *defaultPtr;
Tcl_DString pkgName, tmp, initName, safeInitName;
Tcl_DString unloadName, safeUnloadName;
InterpPackage *ipFirstPtr, *ipPtr;
int code, namesMatch, filesMatch, offset;
const char *symbols[2];
Tcl_PackageInitProc *initProc;
const char *p, *fullFileName, *packageName;
Tcl_LoadHandle loadHandle;
|
|
|
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target;
LoadedPackage *pkgPtr, *defaultPtr;
Tcl_DString prefix, tmp, initName, safeInitName;
Tcl_DString unloadName, safeUnloadName;
InterpPackage *ipFirstPtr, *ipPtr;
int code, namesMatch, filesMatch, offset;
const char *symbols[2];
Tcl_PackageInitProc *initProc;
const char *p, *fullFileName, *packageName;
Tcl_LoadHandle loadHandle;
|
| ︙ | | | ︙ | |
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
return TCL_ERROR;
}
if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
return TCL_ERROR;
}
fullFileName = Tcl_GetString(objv[1]);
Tcl_DStringInit(&pkgName);
Tcl_DStringInit(&initName);
Tcl_DStringInit(&safeInitName);
Tcl_DStringInit(&unloadName);
Tcl_DStringInit(&safeUnloadName);
Tcl_DStringInit(&tmp);
packageName = NULL;
|
|
|
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
return TCL_ERROR;
}
if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
return TCL_ERROR;
}
fullFileName = Tcl_GetString(objv[1]);
Tcl_DStringInit(&prefix);
Tcl_DStringInit(&initName);
Tcl_DStringInit(&safeInitName);
Tcl_DStringInit(&unloadName);
Tcl_DStringInit(&safeUnloadName);
Tcl_DStringInit(&tmp);
packageName = NULL;
|
| ︙ | | | ︙ | |
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
|
Tcl_MutexLock(&packageMutex);
defaultPtr = NULL;
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
if (packageName == NULL) {
namesMatch = 0;
} else {
TclDStringClear(&pkgName);
Tcl_DStringAppend(&pkgName, packageName, -1);
TclDStringClear(&tmp);
Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
Tcl_UtfToLower(Tcl_DStringValue(&tmp));
if (strcmp(Tcl_DStringValue(&tmp),
Tcl_DStringValue(&pkgName)) == 0) {
namesMatch = 1;
} else {
namesMatch = 0;
}
}
TclDStringClear(&pkgName);
filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
if (filesMatch && (namesMatch || (packageName == NULL))) {
break;
}
if (namesMatch && (fullFileName[0] == 0)) {
defaultPtr = pkgPtr;
|
|
|
|
|
|
|
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
|
Tcl_MutexLock(&packageMutex);
defaultPtr = NULL;
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
if (packageName == NULL) {
namesMatch = 0;
} else {
TclDStringClear(&prefix);
Tcl_DStringAppend(&prefix, packageName, -1);
TclDStringClear(&tmp);
Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
Tcl_UtfToLower(Tcl_DStringValue(&prefix));
Tcl_UtfToLower(Tcl_DStringValue(&tmp));
if (strcmp(Tcl_DStringValue(&tmp),
Tcl_DStringValue(&prefix)) == 0) {
namesMatch = 1;
} else {
namesMatch = 0;
}
}
TclDStringClear(&prefix);
filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
if (filesMatch && (namesMatch || (packageName == NULL))) {
break;
}
if (namesMatch && (fullFileName[0] == 0)) {
defaultPtr = pkgPtr;
|
| ︙ | | | ︙ | |
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
|
}
/*
* Figure out the module name if it wasn't provided explicitly.
*/
if (packageName != NULL) {
Tcl_DStringAppend(&pkgName, packageName, -1);
} else {
int retc;
/*
* Threading note - this call used to be protected by a mutex.
*/
retc = TclGuessPackageName(fullFileName, &pkgName);
if (!retc) {
Tcl_Obj *splitPtr, *pkgGuessPtr;
int pElements;
const char *pkgGuess;
/*
* The platform-specific code couldn't figure out the module
|
|
|
|
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
|
}
/*
* Figure out the module name if it wasn't provided explicitly.
*/
if (packageName != NULL) {
Tcl_DStringAppend(&prefix, packageName, -1);
} else {
int retc;
/*
* Threading note - this call used to be protected by a mutex.
*/
retc = TclGuessPackageName(fullFileName, &prefix);
if (!retc) {
Tcl_Obj *splitPtr, *pkgGuessPtr;
int pElements;
const char *pkgGuess;
/*
* The platform-specific code couldn't figure out the module
|
| ︙ | | | ︙ | |
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
|
"couldn't figure out package name for %s",
fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
"WHATPACKAGE", NULL);
code = TCL_ERROR;
goto done;
}
Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess);
Tcl_DecrRefCount(splitPtr);
}
}
/*
* Fix the capitalization in the package name so that the first
* character is in caps (or title case) but the others are all
* lower-case.
*/
Tcl_DStringSetLength(&pkgName,
Tcl_UtfToTitle(Tcl_DStringValue(&pkgName)));
/*
* Compute the names of the two initialization functions, based on the
* package name.
*/
TclDStringAppendDString(&initName, &pkgName);
TclDStringAppendLiteral(&initName, "_Init");
TclDStringAppendDString(&safeInitName, &pkgName);
TclDStringAppendLiteral(&safeInitName, "_SafeInit");
TclDStringAppendDString(&unloadName, &pkgName);
TclDStringAppendLiteral(&unloadName, "_Unload");
TclDStringAppendDString(&safeUnloadName, &pkgName);
TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload");
/*
* Call platform-specific code to load the package and find the two
* initialization functions.
*/
|
|
|
|
|
|
|
|
|
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
|
"couldn't figure out package name for %s",
fullFileName));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
"WHATPACKAGE", NULL);
code = TCL_ERROR;
goto done;
}
Tcl_DStringAppend(&prefix, pkgGuess, p - pkgGuess);
Tcl_DecrRefCount(splitPtr);
}
}
/*
* Fix the capitalization in the package name so that the first
* character is in caps (or title case) but the others are all
* lower-case.
*/
Tcl_DStringSetLength(&prefix,
Tcl_UtfToTitle(Tcl_DStringValue(&prefix)));
/*
* Compute the names of the two initialization functions, based on the
* package name.
*/
TclDStringAppendDString(&initName, &prefix);
TclDStringAppendLiteral(&initName, "_Init");
TclDStringAppendDString(&safeInitName, &prefix);
TclDStringAppendLiteral(&safeInitName, "_SafeInit");
TclDStringAppendDString(&unloadName, &prefix);
TclDStringAppendLiteral(&unloadName, "_Unload");
TclDStringAppendDString(&safeUnloadName, &prefix);
TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload");
/*
* Call platform-specific code to load the package and find the two
* initialization functions.
*/
|
| ︙ | | | ︙ | |
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
|
* Create a new record to describe this package.
*/
pkgPtr = ckalloc(sizeof(LoadedPackage));
len = strlen(fullFileName) + 1;
pkgPtr->fileName = ckalloc(len);
memcpy(pkgPtr->fileName, fullFileName, len);
len = (unsigned) Tcl_DStringLength(&pkgName) + 1;
pkgPtr->packageName = ckalloc(len);
memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len);
pkgPtr->loadHandle = loadHandle;
pkgPtr->initProc = initProc;
pkgPtr->safeInitProc = (Tcl_PackageInitProc *)
Tcl_FindSymbol(interp, loadHandle,
Tcl_DStringValue(&safeInitName));
pkgPtr->unloadProc = (Tcl_PackageUnloadProc *)
Tcl_FindSymbol(interp, loadHandle,
|
|
|
|
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
|
* Create a new record to describe this package.
*/
pkgPtr = ckalloc(sizeof(LoadedPackage));
len = strlen(fullFileName) + 1;
pkgPtr->fileName = ckalloc(len);
memcpy(pkgPtr->fileName, fullFileName, len);
len = (unsigned) Tcl_DStringLength(&prefix) + 1;
pkgPtr->packageName = ckalloc(len);
memcpy(pkgPtr->packageName, Tcl_DStringValue(&prefix), len);
pkgPtr->loadHandle = loadHandle;
pkgPtr->initProc = initProc;
pkgPtr->safeInitProc = (Tcl_PackageInitProc *)
Tcl_FindSymbol(interp, loadHandle,
Tcl_DStringValue(&safeInitName));
pkgPtr->unloadProc = (Tcl_PackageUnloadProc *)
Tcl_FindSymbol(interp, loadHandle,
|
| ︙ | | | ︙ | |
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
|
ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
ipPtr = ckalloc(sizeof(InterpPackage));
ipPtr->pkgPtr = pkgPtr;
ipPtr->nextPtr = ipFirstPtr;
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);
done:
Tcl_DStringFree(&pkgName);
Tcl_DStringFree(&initName);
Tcl_DStringFree(&safeInitName);
Tcl_DStringFree(&unloadName);
Tcl_DStringFree(&safeUnloadName);
Tcl_DStringFree(&tmp);
return code;
}
|
|
|
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
|
ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
ipPtr = ckalloc(sizeof(InterpPackage));
ipPtr->pkgPtr = pkgPtr;
ipPtr->nextPtr = ipFirstPtr;
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);
done:
Tcl_DStringFree(&prefix);
Tcl_DStringFree(&initName);
Tcl_DStringFree(&safeInitName);
Tcl_DStringFree(&unloadName);
Tcl_DStringFree(&safeUnloadName);
Tcl_DStringFree(&tmp);
return code;
}
|
| ︙ | | | ︙ | |
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
|
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target; /* Which interpreter to unload from. */
LoadedPackage *pkgPtr, *defaultPtr;
Tcl_DString pkgName, tmp;
Tcl_PackageUnloadProc *unloadProc;
InterpPackage *ipFirstPtr, *ipPtr;
int i, index, code, complain = 1, keepLibrary = 0;
int trustedRefCount = -1, safeRefCount = -1;
const char *fullFileName = "";
const char *packageName;
static const char *const options[] = {
|
|
|
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
|
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Interp *target; /* Which interpreter to unload from. */
LoadedPackage *pkgPtr, *defaultPtr;
Tcl_DString prefix, tmp;
Tcl_PackageUnloadProc *unloadProc;
InterpPackage *ipFirstPtr, *ipPtr;
int i, index, code, complain = 1, keepLibrary = 0;
int trustedRefCount = -1, safeRefCount = -1;
const char *fullFileName = "";
const char *packageName;
static const char *const options[] = {
|
| ︙ | | | ︙ | |
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
|
return TCL_ERROR;
}
if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
return TCL_ERROR;
}
fullFileName = Tcl_GetString(objv[i]);
Tcl_DStringInit(&pkgName);
Tcl_DStringInit(&tmp);
packageName = NULL;
if (objc - i >= 2) {
packageName = Tcl_GetString(objv[i+1]);
if (packageName[0] == '\0') {
packageName = NULL;
|
|
|
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
|
return TCL_ERROR;
}
if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
return TCL_ERROR;
}
fullFileName = Tcl_GetString(objv[i]);
Tcl_DStringInit(&prefix);
Tcl_DStringInit(&tmp);
packageName = NULL;
if (objc - i >= 2) {
packageName = Tcl_GetString(objv[i+1]);
if (packageName[0] == '\0') {
packageName = NULL;
|
| ︙ | | | ︙ | |
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
|
defaultPtr = NULL;
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
int namesMatch, filesMatch;
if (packageName == NULL) {
namesMatch = 0;
} else {
TclDStringClear(&pkgName);
Tcl_DStringAppend(&pkgName, packageName, -1);
TclDStringClear(&tmp);
Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
Tcl_UtfToLower(Tcl_DStringValue(&tmp));
if (strcmp(Tcl_DStringValue(&tmp),
Tcl_DStringValue(&pkgName)) == 0) {
namesMatch = 1;
} else {
namesMatch = 0;
}
}
TclDStringClear(&pkgName);
filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
if (filesMatch && (namesMatch || (packageName == NULL))) {
break;
}
if (namesMatch && (fullFileName[0] == 0)) {
defaultPtr = pkgPtr;
|
|
|
|
|
|
|
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
|
defaultPtr = NULL;
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
int namesMatch, filesMatch;
if (packageName == NULL) {
namesMatch = 0;
} else {
TclDStringClear(&prefix);
Tcl_DStringAppend(&prefix, packageName, -1);
TclDStringClear(&tmp);
Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
Tcl_UtfToLower(Tcl_DStringValue(&prefix));
Tcl_UtfToLower(Tcl_DStringValue(&tmp));
if (strcmp(Tcl_DStringValue(&tmp),
Tcl_DStringValue(&prefix)) == 0) {
namesMatch = 1;
} else {
namesMatch = 0;
}
}
TclDStringClear(&prefix);
filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
if (filesMatch && (namesMatch || (packageName == NULL))) {
break;
}
if (namesMatch && (fullFileName[0] == 0)) {
defaultPtr = pkgPtr;
|
| ︙ | | | ︙ | |
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
|
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "DISABLED",
NULL);
code = TCL_ERROR;
#endif
}
done:
Tcl_DStringFree(&pkgName);
Tcl_DStringFree(&tmp);
if (!complain && (code != TCL_OK)) {
code = TCL_OK;
Tcl_ResetResult(interp);
}
return code;
}
|
|
|
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
|
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "DISABLED",
NULL);
code = TCL_ERROR;
#endif
}
done:
Tcl_DStringFree(&prefix);
Tcl_DStringFree(&tmp);
if (!complain && (code != TCL_OK)) {
code = TCL_OK;
Tcl_ResetResult(interp);
}
return code;
}
|
| ︙ | | | ︙ | |
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
|
void
Tcl_StaticPackage(
Tcl_Interp *interp, /* If not NULL, it means that the package has
* already been loaded into the given
* interpreter by calling the appropriate init
* proc. */
const char *pkgName, /* Name of package (must be properly
* capitalized: first letter upper case,
* others lower case). */
Tcl_PackageInitProc *initProc,
/* Function to call to incorporate this
* package into a trusted interpreter. */
Tcl_PackageInitProc *safeInitProc)
/* Function to call to incorporate this
|
|
|
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
|
void
Tcl_StaticPackage(
Tcl_Interp *interp, /* If not NULL, it means that the package has
* already been loaded into the given
* interpreter by calling the appropriate init
* proc. */
const char *prefix, /* Prefix (must be properly
* capitalized: first letter upper case,
* others lower case). */
Tcl_PackageInitProc *initProc,
/* Function to call to incorporate this
* package into a trusted interpreter. */
Tcl_PackageInitProc *safeInitProc)
/* Function to call to incorporate this
|
| ︙ | | | ︙ | |
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
|
* statically loaded in the process.
*/
Tcl_MutexLock(&packageMutex);
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
if ((pkgPtr->initProc == initProc)
&& (pkgPtr->safeInitProc == safeInitProc)
&& (strcmp(pkgPtr->packageName, pkgName) == 0)) {
break;
}
}
Tcl_MutexUnlock(&packageMutex);
/*
* If the package is not yet recorded as being loaded statically, add it
* to the list now.
*/
if (pkgPtr == NULL) {
pkgPtr = ckalloc(sizeof(LoadedPackage));
pkgPtr->fileName = ckalloc(1);
pkgPtr->fileName[0] = 0;
pkgPtr->packageName = ckalloc(strlen(pkgName) + 1);
strcpy(pkgPtr->packageName, pkgName);
pkgPtr->loadHandle = NULL;
pkgPtr->initProc = initProc;
pkgPtr->safeInitProc = safeInitProc;
Tcl_MutexLock(&packageMutex);
pkgPtr->nextPtr = firstPackagePtr;
firstPackagePtr = pkgPtr;
Tcl_MutexUnlock(&packageMutex);
|
|
|
|
|
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
|
* statically loaded in the process.
*/
Tcl_MutexLock(&packageMutex);
for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
if ((pkgPtr->initProc == initProc)
&& (pkgPtr->safeInitProc == safeInitProc)
&& (strcmp(pkgPtr->packageName, prefix) == 0)) {
break;
}
}
Tcl_MutexUnlock(&packageMutex);
/*
* If the package is not yet recorded as being loaded statically, add it
* to the list now.
*/
if (pkgPtr == NULL) {
pkgPtr = ckalloc(sizeof(LoadedPackage));
pkgPtr->fileName = ckalloc(1);
pkgPtr->fileName[0] = 0;
pkgPtr->packageName = ckalloc(strlen(prefix) + 1);
strcpy(pkgPtr->packageName, prefix);
pkgPtr->loadHandle = NULL;
pkgPtr->initProc = initProc;
pkgPtr->safeInitProc = safeInitProc;
Tcl_MutexLock(&packageMutex);
pkgPtr->nextPtr = firstPackagePtr;
firstPackagePtr = pkgPtr;
Tcl_MutexUnlock(&packageMutex);
|
| ︙ | | | ︙ | |