summaryrefslogtreecommitdiffstats
path: root/mac/tclMacLoad.c
diff options
context:
space:
mode:
authorrjohnson <rjohnson>1998-03-26 14:45:59 (GMT)
committerrjohnson <rjohnson>1998-03-26 14:45:59 (GMT)
commit2b5738da524e944cda39e24c0a87b745a43bd8c3 (patch)
tree6e8c9473978f6dab66c601e911721a7bd9d70b1b /mac/tclMacLoad.c
parentc6a259aeeca4814a97cf6694814c63e74e4e18fa (diff)
downloadtcl-2b5738da524e944cda39e24c0a87b745a43bd8c3.zip
tcl-2b5738da524e944cda39e24c0a87b745a43bd8c3.tar.gz
tcl-2b5738da524e944cda39e24c0a87b745a43bd8c3.tar.bz2
Initial revision
Diffstat (limited to 'mac/tclMacLoad.c')
-rw-r--r--mac/tclMacLoad.c245
1 files changed, 245 insertions, 0 deletions
diff --git a/mac/tclMacLoad.c b/mac/tclMacLoad.c
new file mode 100644
index 0000000..060a734
--- /dev/null
+++ b/mac/tclMacLoad.c
@@ -0,0 +1,245 @@
+/*
+ * 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.20 97/11/20 18:39:20
+ */
+
+#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;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ char *fileName, /* Name of the file containing the desired
+ * code. */
+ char *sym1, char *sym2, /* Names of two procedures to look up in
+ * the file's symbol table. */
+ Tcl_PackageInitProc **proc1Ptr,
+ Tcl_PackageInitProc **proc2Ptr)
+ /* Where to return the addresses corresponding
+ * to sym1 and sym2. */
+{
+ CFragConnectionID connID;
+ Ptr dummy;
+ OSErr err;
+ CFragSymbolClass symClass;
+ FSSpec fileSpec;
+ short fragFileRef, saveFileRef;
+ Handle fragResource;
+ UInt32 offset = 0;
+ UInt32 length = kCFragGoesToEOF;
+ 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,
+ kLoadCFrag, &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(
+ 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;
+}