/* * 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. * * RCS: @(#) $Id: tclMacLoad.c,v 1.2 2001/09/14 01:43:23 zlaski 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; /* *---------------------------------------------------------------------- * * 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; }