#include <CodeFragments.h>
#include <Errors.h>
#include <Resources.h>
#include <Strings.h>
#include <FSpCompat.h>
#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
struct CfrgHeader {
long res1;
long res2;
long version;
long res3;
long res4;
long filler1;
long filler2;
long itemCount;
char arrayStart;
};
typedef struct CfrgHeader CfrgHeader, *CfrgHeaderPtr, **CfrgHeaderPtrHand;
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;
};
typedef struct CfrgItem CfrgItem;
typedef struct TclMacLoadInfo {
int loaded;
CFragConnectionID connID;
FSSpec fileSpec;
} TclMacLoadInfo;
static int TryToLoad(Tcl_Interp *interp, TclMacLoadInfo *loadInfo, Tcl_Obj *pathPtr,
CONST char *sym );
int
TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
Tcl_Interp *interp;
Tcl_Obj *pathPtr;
Tcl_LoadHandle *loadHandle;
Tcl_FSUnloadFileProc **unloadProcPtr;
{
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;
}
static int
TryToLoad(Tcl_Interp *interp, TclMacLoadInfo *loadInfo, Tcl_Obj *pathPtr,
CONST char *sym )
{
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;
}
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;
}
}
}
}
HUnlock(fragResource);
ReleaseResource(fragResource);
CloseResFile(fragFileRef);
UseResFile(saveFileRef);
if (sym == NULL) {
return TCL_OK;
}
}
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;
}
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;
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;
}
void
TclpUnloadFile(loadHandle)
Tcl_LoadHandle loadHandle;
{
TclMacLoadInfo *loadInfo = (TclMacLoadInfo *)loadHandle;
if (loadInfo->loaded) {
CloseConnection((CFragConnectionID*) &(loadInfo->connID));
}
ckfree((char*)loadInfo);
}
int
TclGuessPackageName(
CONST char *fileName,
Tcl_DString *bufPtr)
{
return 0;
}