Skip to content

Commit

Permalink
Find script library in zipfs archive and inform Tcl library how to di…
Browse files Browse the repository at this point in the history 
…rect

every interp to find it when created without fuss.
  • Loading branch information
dgp committed Nov 13, 2023
2 parents d086345 + b5b660a commit 88dd7bd
Show file tree
Hide file tree
Showing 2 changed files with 57 additions and 60 deletions.
1 change: 0 additions & 1 deletion generic/tclInterp.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -402,7 +402,6 @@ Tcl_Init(
"if {$tail eq [info tclversion]} continue\n"
"file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n"
" }\n"
" lappend scripts {::tcl::zipfs::tcl_library_init}\n"
" if {[info exists tclDefaultLibrary]} {\n"
" lappend scripts {set tclDefaultLibrary}\n"
" } else {\n"
Expand Down
116 changes: 57 additions & 59 deletions generic/tclZipfs.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -91,6 +91,17 @@ static const z_crc_t* crc32tab;
#define ZIPFS_VOLUME_LEN 9
#define ZIPFS_APP_MOUNT ZIPFS_VOLUME "app"
#define ZIPFS_ZIP_MOUNT ZIPFS_VOLUME "lib/tcl"

#define ZIPFS_SCRIPT_PREFIX "set ::tcl_library "
#define ZIPFS_TCL_LIBRARY_1 ZIPFS_APP_MOUNT "/tcl_library"
#define ZIPFS_INIT_SCRIPT_1 ZIPFS_SCRIPT_PREFIX ZIPFS_TCL_LIBRARY_1

#define ZIPFS_TCL_LIBRARY_2 ZIPFS_ZIP_MOUNT
#define ZIPFS_INIT_SCRIPT_2 ZIPFS_SCRIPT_PREFIX ZIPFS_TCL_LIBRARY_2

#define ZIPFS_TCL_LIBRARY_3 ZIPFS_ZIP_MOUNT "/tcl_library"
#define ZIPFS_INIT_SCRIPT_3 ZIPFS_SCRIPT_PREFIX ZIPFS_TCL_LIBRARY_3

#define ZIPFS_FALLBACK_ENCODING "cp437"

/*
Expand Down Expand Up @@ -313,6 +324,7 @@ static const char pwrot[17] =
"\x10\x90\x50\xD0\x30\xB0\x70\xF0";

static const char *zipfs_literal_tcl_library = NULL;
static const char *zipfs_init_script = NULL;

/* Function prototypes */

Expand Down Expand Up @@ -4231,6 +4243,28 @@ ScriptLibrarySetup(
Tcl_Obj *libDirObj = Tcl_NewStringObj(dirName, -1);
Tcl_Obj *subDirObj, *searchPathObj;

/*
* We know where the init.tcl is located in the attached script library
* archive. Use a pre-init script to tell every Tcl interp as it gets
* created where that is, so none of them need to construct and then
* iterate through some search path. That's the literal documented
* purpose of Tcl_SetPreInitScript(). Use it.
*
* TODO: Examine why we need so many variations and eliminate as many
* as possible.
*/

if (0 == strcmp(zipfs_literal_tcl_library, ZIPFS_TCL_LIBRARY_1)) {
zipfs_init_script = ZIPFS_INIT_SCRIPT_1;
} else if (0 == strcmp(zipfs_literal_tcl_library, ZIPFS_TCL_LIBRARY_2)) {
zipfs_init_script = ZIPFS_INIT_SCRIPT_2;
} else if (0 == strcmp(zipfs_literal_tcl_library, ZIPFS_TCL_LIBRARY_3)) {
zipfs_init_script = ZIPFS_INIT_SCRIPT_3;
}
if (zipfs_init_script) {
Tcl_SetPreInitScript(zipfs_init_script);
}

TclNewLiteralStringObj(subDirObj, "encoding");
Tcl_IncrRefCount(subDirObj);
TclNewObj(searchPathObj);
Expand Down Expand Up @@ -4268,13 +4302,12 @@ TclZipfs_TclLibrary(void)
* Look for the library file system within the executable.
*/

vfsInitScript = Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",
-1);
vfsInitScript = Tcl_NewStringObj(ZIPFS_TCL_LIBRARY_1 "/init.tcl", -1);
Tcl_IncrRefCount(vfsInitScript);
found = Tcl_FSAccess(vfsInitScript, F_OK);
Tcl_DecrRefCount(vfsInitScript);
if (found == TCL_OK) {
zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
return ScriptLibrarySetup(zipfs_literal_tcl_library);
}

Expand Down Expand Up @@ -4320,44 +4353,6 @@ TclZipfs_TclLibrary(void)
return NULL;
}

/*
*-------------------------------------------------------------------------
*
* ZipFSTclLibraryObjCmd --
*
* This procedure is invoked to process the
* [::tcl::zipfs::tcl_library_init] command, usually called during the
* execution of Tcl's interpreter startup. It returns the root that Tcl's
* library files are mounted under.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* May initialise the cache of where such library files are to be found.
* This cache is never cleared.
*
*-------------------------------------------------------------------------
*/

static int
ZipFSTclLibraryObjCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
TCL_UNUSED(int) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *)) /*objv*/
{
if (!Tcl_IsSafe(interp)) {
Tcl_Obj *pResult = TclZipfs_TclLibrary();

if (!pResult) {
TclNewObj(pResult);
}
Tcl_SetObjResult(interp, pResult);
}
return TCL_OK;
}

/*
*-------------------------------------------------------------------------
*
Expand Down Expand Up @@ -6253,8 +6248,6 @@ TclZipfs_Init(
Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1),
Tcl_NewStringObj("::tcl::zipfs::find", -1));
Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init",
ZipFSTclLibraryObjCmd, NULL, NULL);
Tcl_PkgProvide(interp, "tcl::zipfs", "2.0");
}
return TCL_OK;
Expand Down Expand Up @@ -6283,22 +6276,21 @@ ZipfsAppHookFindTclInit(
return TCL_ERROR;
}

TclNewLiteralStringObj(vfsInitScript, ZIPFS_ZIP_MOUNT "/init.tcl");
TclNewLiteralStringObj(vfsInitScript, ZIPFS_TCL_LIBRARY_2 "/init.tcl");
Tcl_IncrRefCount(vfsInitScript);
found = Tcl_FSAccess(vfsInitScript, F_OK);
Tcl_DecrRefCount(vfsInitScript);
if (found == 0) {
zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT;
zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_2;
return TCL_OK;
}

TclNewLiteralStringObj(vfsInitScript,
ZIPFS_ZIP_MOUNT "/tcl_library/init.tcl");
TclNewLiteralStringObj(vfsInitScript, ZIPFS_TCL_LIBRARY_3 "/init.tcl");
Tcl_IncrRefCount(vfsInitScript);
found = Tcl_FSAccess(vfsInitScript, F_OK);
Tcl_DecrRefCount(vfsInitScript);
if (found == 0) {
zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT "/tcl_library";
zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_3;
return TCL_OK;
}

Expand Down Expand Up @@ -6415,12 +6407,13 @@ TclZipfs_AppHook(

if (!zipfs_literal_tcl_library) {
TclNewLiteralStringObj(vfsInitScript,
ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
ZIPFS_TCL_LIBRARY_1 "/init.tcl");
Tcl_IncrRefCount(vfsInitScript);
found = Tcl_FSAccess(vfsInitScript, F_OK);
Tcl_DecrRefCount(vfsInitScript);
if (found == TCL_OK) {
zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
Tcl_DecrRefCount(TclZipfs_TclLibrary());
return version;
}
}
Expand All @@ -6447,9 +6440,9 @@ TclZipfs_AppHook(
* wants it.
*/

TclZipfs_TclLibrary();
Tcl_DecrRefCount(TclZipfs_TclLibrary());
TclNewLiteralStringObj(vfsInitScript,
ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl");
ZIPFS_TCL_LIBRARY_3 "install.tcl");
Tcl_IncrRefCount(vfsInitScript);
if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
Tcl_SetStartupScript(vfsInitScript, NULL);
Expand All @@ -6459,6 +6452,17 @@ TclZipfs_AppHook(
int found;
Tcl_Obj *vfsInitScript;

/* Set Tcl Encodings */
TclNewLiteralStringObj(vfsInitScript,
ZIPFS_TCL_LIBRARY_1 "/init.tcl");
Tcl_IncrRefCount(vfsInitScript);
found = Tcl_FSAccess(vfsInitScript, F_OK);
Tcl_DecrRefCount(vfsInitScript);
if (found == TCL_OK) {
zipfs_literal_tcl_library = ZIPFS_TCL_LIBRARY_1;
Tcl_DecrRefCount(TclZipfs_TclLibrary());
}

TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
Tcl_IncrRefCount(vfsInitScript);
if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
Expand All @@ -6470,14 +6474,8 @@ TclZipfs_AppHook(
} else {
Tcl_DecrRefCount(vfsInitScript);
}
/* Set Tcl Encodings */
TclNewLiteralStringObj(vfsInitScript,
ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
Tcl_IncrRefCount(vfsInitScript);
found = Tcl_FSAccess(vfsInitScript, F_OK);
Tcl_DecrRefCount(vfsInitScript);

if (found == TCL_OK) {
zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
return version;
}
}
Expand Down

0 comments on commit 88dd7bd

Please sign in to comment.