Subversion Repositories or1k_old

/*

 * 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.1.1.1 2002-01-16 10:25:30 markom 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;

}