/*
* tclMacLoad.c --
*
* This procedure provides a version of the TclLoadFile for use
* on the Macintosh. This procedure will only work with systems
* that use the Code Fragment Manager.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id: tclMacLoad.c,v 1.16 2002/10/09 11:54:26 das Exp $
*/
#include <CodeFragments.h>
#include <Errors.h>
#include <Resources.h>
#include <Strings.h>
#include <FSpCompat.h>
/*
* Seems that the 3.0.1 Universal headers leave this define out. So we
* define it here...
*/
#ifndef fragNoErr
#define fragNoErr noErr
#endif
#include "tclPort.h"
#include "tclInt.h"
#include "tclMacInt.h"
#if GENERATINGPOWERPC
#define OUR_ARCH_TYPE kPowerPCCFragArch
#else
#define OUR_ARCH_TYPE kMotorola68KCFragArch
#endif
/*
* The following data structure defines the structure of a code fragment
* resource. We can cast the resource to be of this type to access
* any fields we need to see.
*/
struct CfrgHeader {
long res1;
long res2;
long version;
long res3;
long res4;
long filler1;
long filler2;
long itemCount;
char arrayStart; /* Array of externalItems begins here. */
};
typedef struct CfrgHeader CfrgHeader, *CfrgHeaderPtr, **CfrgHeaderPtrHand;
/*
* The below structure defines a cfrag item within the cfrag resource.
*/
struct CfrgItem {
OSType archType;
long updateLevel;
long currVersion;
long oldDefVersion;
long appStackSize;
short appSubFolder;
char usage;
char location;
long codeOffset;
long codeLength;
long res1;
long res2;
short itemSize;
Str255 name; /* This is actually variable sized. */
};
typedef struct CfrgItem CfrgItem;
/*
* On MacOS, old shared libraries which contain many code fragments
* cannot, it seems, be loaded in one go. We need to look provide
* the name of a code fragment while we load. Since with the
* separation of the 'load' and 'findsymbol' be do not necessarily
* know a symbol name at load time, we have to store some further
* information in a structure like this so we can ensure we load
* properly in 'findsymbol' if the first attempts didn't work.
*/
typedef struct TclMacLoadInfo {
int loaded;
CFragConnectionID connID;
FSSpec fileSpec;
} TclMacLoadInfo;
static int TryToLoad(Tcl_Interp *interp, TclMacLoadInfo *loadInfo, Tcl_Obj *pathPtr,
CONST char *sym /* native */);
/*
*----------------------------------------------------------------------
*
* TclpDlopen --
*
* This procedure is called to carry out dynamic loading of binary
* code for the Macintosh. This implementation is based on the
* Code Fragment Manager & will not work on other systems.
*
* Results:
* The result is TCL_ERROR, and an error message is left in
* the interp's result.
*
* Side effects:
* New binary code is loaded.
*
*----------------------------------------------------------------------
*/
int
TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Obj *pathPtr; /* Name of the file containing the desired
* code (UTF-8). */
Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded
* file which will be passed back to
* (*unloadProcPtr)() to unload the file. */
Tcl_FSUnloadFileProc **unloadProcPtr;
/* Filled with address of Tcl_FSUnloadFileProc
* function which should be used for
* this file. */
{
OSErr err;
FSSpec fileSpec;
CONST char *native;
TclMacLoadInfo *loadInfo;
native = Tcl_FSGetNativePath(pathPtr);
err = FSpLocationFromPath(strlen(native), native, &fileSpec);
if (err != noErr) {
Tcl_SetResult(interp, "could not locate shared library", TCL_STATIC);
return TCL_ERROR;
}
loadInfo = (TclMacLoadInfo *) ckalloc(sizeof(TclMacLoadInfo));
loadInfo->loaded = 0;
loadInfo->fileSpec = fileSpec;
loadInfo->connID = NULL;
if (TryToLoad(interp, loadInfo, pathPtr, NULL) != TCL_OK) {
ckfree((char*) loadInfo);
return TCL_ERROR;
}
*loadHandle = (Tcl_LoadHandle)loadInfo;
*unloadProcPtr = &TclpUnloadFile;
return TCL_OK;
}
/*
* See the comments about 'struct TclMacLoadInfo' above. This
* function ensures the appropriate library or symbol is
* loaded.
*/
static int
TryToLoad(Tcl_Interp *interp, TclMacLoadInfo *loadInfo, Tcl_Obj *pathPtr,
CONST char *sym /* native */)
{
OSErr err;
CFragConnectionID connID;
Ptr dummy;
short fragFileRef, saveFileRef;
Handle fragResource;
UInt32 offset = 0;
UInt32 length = kCFragGoesToEOF;
Str255 errName;
StringPtr fragName=NULL;
if (loadInfo->loaded == 1) {
return TCL_OK;
}
/*
* See if this fragment has a 'cfrg' resource. It will tell us where
* to look for the fragment in the file. If it doesn't exist we will
* assume we have a ppc frag using the whole data fork. If it does
* exist we find the frag that matches the one we are looking for and
* get the offset and size from the resource.
*/
saveFileRef = CurResFile();
SetResLoad(false);
fragFileRef = FSpOpenResFile(&loadInfo->fileSpec, fsRdPerm);
SetResLoad(true);
if (fragFileRef != -1) {
if (sym != NULL) {
UseResFile(fragFileRef);
fragResource = Get1Resource(kCFragResourceType, kCFragResourceID);
HLock(fragResource);
if (ResError() == noErr) {
CfrgItem* srcItem;
long itemCount, index;
Ptr itemStart;
itemCount = (*(CfrgHeaderPtrHand)fragResource)->itemCount;
itemStart = &(*(CfrgHeaderPtrHand)fragResource)->arrayStart;
for (index = 0; index < itemCount;
index++, itemStart += srcItem->itemSize) {
srcItem = (CfrgItem*)itemStart;
if (srcItem->archType != OUR_ARCH_TYPE) continue;
if (!strncasecmp(sym, (char *) srcItem->name + 1,
strlen(sym))) {
offset = srcItem->codeOffset;
length = srcItem->codeLength;
fragName=srcItem->name;
}
}
}
}
/*
* Close the resource file. If the extension wants to reopen the
* resource fork it should use the tclMacLibrary.c file during it's
* construction.
*/
HUnlock(fragResource);
ReleaseResource(fragResource);
CloseResFile(fragFileRef);
UseResFile(saveFileRef);
if (sym == NULL) {
/* We just return */
return TCL_OK;
}
}
/*
* Now we can attempt to load the fragment using the offset & length
* obtained from the resource. We don't worry about the main entry point
* as we are going to search for specific entry points passed to us.
*/
err = GetDiskFragment(&loadInfo->fileSpec, offset, length, fragName,
kLoadCFrag, &connID, &dummy, errName);
if (err != fragNoErr) {
p2cstr(errName);
if(pathPtr) {
Tcl_AppendResult(interp, "couldn't load file \"",
Tcl_GetString(pathPtr),
"\": ", errName, (char *) NULL);
} else if(sym) {
Tcl_AppendResult(interp, "couldn't load library \"",
sym,
"\": ", errName, (char *) NULL);
}
return TCL_ERROR;
}
loadInfo->connID = connID;
loadInfo->loaded = 1;
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclpFindSymbol --
*
* Looks up a symbol, by name, through a handle associated with
* a previously loaded piece of code (shared library).
*
* Results:
* Returns a pointer to the function associated with 'symbol' if
* it is found. Otherwise returns NULL and may leave an error
* message in the interp's result.
*
*----------------------------------------------------------------------
*/
Tcl_PackageInitProc*
TclpFindSymbol(interp, loadHandle, symbol)
Tcl_Interp *interp;
Tcl_LoadHandle loadHandle;
CONST char *symbol;
{
Tcl_DString ds;
Tcl_PackageInitProc *proc=NULL;
TclMacLoadInfo *loadInfo = (TclMacLoadInfo *)loadHandle;
Str255 symbolName;
CFragSymbolClass symClass;
OSErr err;
if (loadInfo->loaded == 0) {
int res;
/*
* First thing we must do is infer the package name from the
* sym variable. We do this by removing the '_Init'.
*/
Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
Tcl_DStringSetLength(&ds, Tcl_DStringLength(&ds) - 5);
res = TryToLoad(interp, loadInfo, NULL, Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
if (res != TCL_OK) {
return NULL;
}
}
Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
strcpy((char *) symbolName + 1, Tcl_DStringValue(&ds));
symbolName[0] = (unsigned) Tcl_DStringLength(&ds);
err = FindSymbol(loadInfo->connID, symbolName, (Ptr *) &proc, &symClass);
Tcl_DStringFree(&ds);
if (err != fragNoErr || symClass == kDataCFragSymbol) {
Tcl_SetResult(interp,
"could not find Initialization routine in library",
TCL_STATIC);
return NULL;
}
return proc;
}
/*
*----------------------------------------------------------------------
*
* TclpUnloadFile --
*
* Unloads a dynamically loaded binary code file from memory.
* Code pointers in the formerly loaded file are no longer valid
* after calling this function.
*
* Results:
* None.
*
* Side effects:
* Does nothing. Can anything be done?
*
*----------------------------------------------------------------------
*/
void
TclpUnloadFile(loadHandle)
Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
* to TclpDlopen(). The loadHandle is
* a token that represents the loaded
* file. */
{
TclMacLoadInfo *loadInfo = (TclMacLoadInfo *)loadHandle;
if (loadInfo->loaded) {
CloseConnection((CFragConnectionID*) &(loadInfo->connID));
}
ckfree((char*)loadInfo);
}
/*
*----------------------------------------------------------------------
*
* TclGuessPackageName --
*
* If the "load" command is invoked without providing a package
* name, this procedure is invoked to try to figure it out.
*
* Results:
* Always returns 0 to indicate that we couldn't figure out a
* package name; generic code will then try to guess the package
* from the file name. A return value of 1 would have meant that
* we figured out the package name and put it in bufPtr.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
TclGuessPackageName(
CONST char *fileName, /* Name of file containing package (already
* translated to local form if needed). */
Tcl_DString *bufPtr) /* Initialized empty dstring. Append
* package name to this if possible. */
{
return 0;
}
syntax highlighted by Code2HTML, v. 0.9.1