/*

  * 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-1997 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.16 2002/10/09 11:54:26 das 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;

 /*

  * On MacOS, old shared libraries which contain many code fragments

  * cannot, it seems, be loaded in one go.  We need to look provide

  * the name of a code fragment while we load.  Since with the

  * separation of the 'load' and 'findsymbol' be do not necessarily

  * know a symbol name at load time, we have to store some further

  * information in a structure like this so we can ensure we load

  * properly in 'findsymbol' if the first attempts didn't work.

  */

 typedef struct TclMacLoadInfo {

     int loaded;

     CFragConnectionID connID;

     FSSpec fileSpec;

 } TclMacLoadInfo;

 static int TryToLoad(Tcl_Interp *interp, TclMacLoadInfo *loadInfo, Tcl_Obj *pathPtr, 

 		     CONST char *sym /* native */);

 /*

  *----------------------------------------------------------------------

  *

  * TclpDlopen --

  *

  *	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

  *	the interp's result.

  *

  * Side effects:

  *	New binary code is loaded.

  *

  *----------------------------------------------------------------------

  */

 int

 TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)

     Tcl_Interp *interp;		/* Used for error reporting. */

     Tcl_Obj *pathPtr;		/* Name of the file containing the desired

 				 * code (UTF-8). */

     Tcl_LoadHandle *loadHandle;	/* Filled with token for dynamically loaded

 				 * file which will be passed back to 

 				 * (*unloadProcPtr)() to unload the file. */

     Tcl_FSUnloadFileProc **unloadProcPtr;

 				/* Filled with address of Tcl_FSUnloadFileProc

 				 * function which should be used for

 				 * this file. */

 {

     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;

 }

 /* 

  * See the comments about 'struct TclMacLoadInfo' above. This

  * function ensures the appropriate library or symbol is

  * loaded.

  */

 static int

 TryToLoad(Tcl_Interp *interp, TclMacLoadInfo *loadInfo, Tcl_Obj *pathPtr,

 	  CONST char *sym /* native */) 

 {

     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;

     }

     /*

      * See if this fragment has a 'cfrg' resource.  It will tell us where

      * 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(&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;

 		    }

 		}

 	    }

 	}

 	/*

 	 * 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);

 	if (sym == NULL) {

 	    /* We just return */

 	    return TCL_OK;

 	}

     }

     /*

      * Now we can attempt to load the fragment 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.

      */

     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;

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclpFindSymbol --

  *

  *	Looks up a symbol, by name, through a handle associated with

  *	a previously loaded piece of code (shared library).

  *

  * Results:

  *	Returns a pointer to the function associated with 'symbol' if

  *	it is found.  Otherwise returns NULL and may leave an error

  *	message in the interp's result.

  *

  *----------------------------------------------------------------------

  */

 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;

 	/*

 	 * First thing we must do is infer the package name from the

 	 * sym variable.  We do this by removing the '_Init'.

 	 */

 	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;

 }

 /*

  *----------------------------------------------------------------------

  *

  * TclpUnloadFile --

  *

  *	Unloads a dynamically loaded binary code file from memory.

  *	Code pointers in the formerly loaded file are no longer valid

  *	after calling this function.

  *

  * Results:

  *	None.

  *

  * Side effects:

  *	Does nothing.  Can anything be done?

  *

  *----------------------------------------------------------------------

  */

 void

 TclpUnloadFile(loadHandle)

     Tcl_LoadHandle loadHandle;	/* loadHandle returned by a previous call

 				 * to TclpDlopen().  The loadHandle is 

 				 * a token that represents the loaded 

 				 * file. */

 {

     TclMacLoadInfo *loadInfo = (TclMacLoadInfo *)loadHandle;

     if (loadInfo->loaded) {

 	CloseConnection((CFragConnectionID*) &(loadInfo->connID));

     }

     ckfree((char*)loadInfo);

 }

 /*

  *----------------------------------------------------------------------

  *

  * 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(

     CONST 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;

 }