429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
|
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
NULL);
code = TCL_ERROR;
goto done;
}
code = pkgPtr->initProc(target);
}
/*
* Record the fact that the package has been loaded in the target
* interpreter.
*/
if (code == TCL_OK) {
/*
* Update the proper reference count.
*/
Tcl_MutexLock(&packageMutex);
if (Tcl_IsSafe(target)) {
pkgPtr->safeInterpRefCount++;
} else {
pkgPtr->interpRefCount++;
}
Tcl_MutexUnlock(&packageMutex);
/*
* Refetch ipFirstPtr: loading the package may have introduced
* additional static packages at the head of the linked list!
*/
ipFirstPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
ipPtr = ckalloc(sizeof(InterpPackage));
ipPtr->pkgPtr = pkgPtr;
ipPtr->nextPtr = ipFirstPtr;
Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);
} else {
Tcl_TransferResult(target, code, interp);
}
|
|
|
|
>
>
>
>
|
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
<
<
|
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
|
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
NULL);
code = TCL_ERROR;
goto done;
}
code = pkgPtr->initProc(target);
}
/*
* Test for whether the initialization failed. If so, transfer the error
* from the target interpreter to the originating one.
*/
if (code != TCL_OK) {
Tcl_TransferResult(target, code, interp);
goto done;
}
/*
* Record the fact that the package has been loaded in the target
* interpreter.
*
* Update the proper reference count.
*/
Tcl_MutexLock(&packageMutex);
if (Tcl_IsSafe(target)) {
pkgPtr->safeInterpRefCount++;
} else {
pkgPtr->interpRefCount++;
}
Tcl_MutexUnlock(&packageMutex);
/*
* Refetch ipFirstPtr: loading the package may have introduced additional
* static packages at the head of the linked list!
*/
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);
|
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
|
Tcl_Interp *interp, /* Interpreter in which to return information
* or error message. */
const char *targetName) /* Name of target interpreter or NULL. If
* NULL, return info about all interps;
* otherwise, just return info about this
* interpreter. */
{
/* TODO: Use Tcl_Obj APIs to generate this info for cleanliness. */
const char *prefix;
if (targetName == NULL) {
/*
* Return information about all of the available packages.
*/
prefix = "{";
Tcl_MutexLock(&packageMutex);
for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
pkgPtr = pkgPtr->nextPtr) {
Tcl_AppendResult(interp, prefix, NULL);
Tcl_AppendElement(interp, pkgPtr->fileName);
Tcl_AppendElement(interp, pkgPtr->packageName);
Tcl_AppendResult(interp, "}", NULL);
prefix = " {";
prefix = "{";
for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
pkgPtr = ipPtr->pkgPtr;
Tcl_AppendResult(interp, prefix, NULL);
Tcl_AppendElement(interp, pkgPtr->fileName);
Tcl_AppendElement(interp, pkgPtr->packageName);
Tcl_AppendResult(interp, "}", NULL);
prefix = " {";
|
<
|
|
<
|
|
|
<
>
>
|
<
|
|
|
<
>
|
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
|
Tcl_Interp *interp, /* Interpreter in which to return information
* or error message. */
const char *targetName) /* Name of target interpreter or NULL. If
* NULL, return info about all interps;
* otherwise, just return info about this
* interpreter. */
{
Tcl_Interp *target;
LoadedPackage *pkgPtr;
InterpPackage *ipPtr;
Tcl_Obj *resultObj, *pkgDesc[2];
if (targetName == NULL) {
/*
* Return information about all of the available packages.
*/
resultObj = Tcl_NewObj();
Tcl_MutexLock(&packageMutex);
for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
pkgPtr = pkgPtr->nextPtr) {
pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
Tcl_ListObjAppendElement(NULL, resultObj,
Tcl_NewListObj(2, pkgDesc));
}
Tcl_MutexUnlock(&packageMutex);
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
/*
* Return information about only the packages that are loaded in a given
* interpreter.
*/
target = Tcl_GetSlave(interp, targetName);
if (target == NULL) {
return TCL_ERROR;
}
ipPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
resultObj = Tcl_NewObj();
for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
pkgPtr = ipPtr->pkgPtr;
pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewListObj(2, pkgDesc));
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* LoadCleanupProc --
|