archie/tcl7.6/mac/tclMacLoad.c

235 lines
6.7 KiB
C
Raw Normal View History

2024-05-27 16:40:40 +02:00
/*
* 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-1996 Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* SCCS: @(#) tclMacLoad.c 1.17 96/10/06 14:30:47
*/
#include <CodeFragments.h>
#include <Errors.h>
#include <Resources.h>
#include <Strings.h>
#include <FSpCompat.h>
#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;
/*
*----------------------------------------------------------------------
*
* TclLoadFile --
*
* 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
* interp->result.
*
* Side effects:
* New binary code is loaded.
*
*----------------------------------------------------------------------
*/
int
TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
Tcl_Interp *interp; /* Used for error reporting. */
char *fileName; /* Name of the file containing the desired
* code. */
char *sym1, *sym2; /* Names of two procedures to look up in
* the file's symbol table. */
Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
/* Where to return the addresses corresponding
* to sym1 and sym2. */
{
ConnectionID connID;
Ptr dummy;
OSErr err;
SymClass symClass;
FSSpec fileSpec;
short fragFileRef, saveFileRef;
Handle fragResource;
UInt32 offset = 0;
UInt32 length = kWholeFork;
char packageName[255];
Str255 errName;
/*
* First thing we must do is infer the package name from the sym1
* variable. This is kind of dumb since the caller actually knows
* this value, it just doesn't give it to us.
*/
strcpy(packageName, sym1);
*packageName = (char) tolower(*packageName);
packageName[strlen(packageName) - 5] = NULL;
err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
if (err != noErr) {
interp->result = "could not locate shared library";
return TCL_ERROR;
}
/*
* See if this fragment has a 'cfrg' resource. It will tell us were
* 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(&fileSpec, fsRdPerm);
SetResLoad(true);
if (fragFileRef != -1) {
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(packageName, (char *) srcItem->name + 1,
srcItem->name[0])) {
offset = srcItem->codeOffset;
length = srcItem->codeLength;
}
}
}
/*
* 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);
}
/*
* Now we can attempt to load the fragement 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.
*/
c2pstr(packageName);
err = GetDiskFragment(&fileSpec, offset, length, (StringPtr) packageName,
kLoadLib, &connID, &dummy, errName);
if (err != fragNoErr) {
p2cstr(errName);
Tcl_AppendResult(interp, "couldn't load file \"", fileName,
"\": ", errName, (char *) NULL);
return TCL_ERROR;
}
c2pstr(sym1);
err = FindSymbol(connID, (StringPtr) sym1, (Ptr *) proc1Ptr, &symClass);
p2cstr((StringPtr) sym1);
if (err != fragNoErr || symClass == kDataCFragSymbol) {
interp->result =
"could not find Initialization routine in library";
return TCL_ERROR;
}
c2pstr(sym2);
err = FindSymbol(connID, (StringPtr) sym2, (Ptr *) proc2Ptr, &symClass);
p2cstr((StringPtr) sym2);
if (err != fragNoErr || symClass == kDataCFragSymbol) {
*proc2Ptr = NULL;
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* 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(fileName, bufPtr)
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;
}