1/*
2 * tclLoadDyld.c --
3 *
4 *	This procedure provides a version of the TclLoadFile that works with
5 *	Apple's dyld dynamic loading.
6 *	Original version of his file (superseded long ago) provided by
7 *	Wilfredo Sanchez (wsanchez@apple.com).
8 *
9 * Copyright (c) 1995 Apple Computer, Inc.
10 * Copyright (c) 2001-2007 Daniel A. Steffen <das@users.sourceforge.net>
11 *
12 * See the file "license.terms" for information on usage and redistribution of
13 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
14 *
15 * RCS: @(#) $Id: tclLoadDyld.c,v 1.14.2.11 2007/09/05 01:38:55 das Exp $
16 */
17
18#include "tclInt.h"
19#include "tclPort.h"
20
21#ifndef MODULE_SCOPE
22#define MODULE_SCOPE extern
23#endif
24
25#ifndef TCL_DYLD_USE_DLFCN
26/*
27 * Use preferred dlfcn API on 10.4 and later
28 */
29#   if !defined(NO_DLFCN_H) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1040
30#	define TCL_DYLD_USE_DLFCN 1
31#   else
32#	define TCL_DYLD_USE_DLFCN 0
33#   endif
34#endif
35#ifndef TCL_DYLD_USE_NSMODULE
36/*
37 * Use deprecated NSModule API only to support 10.3 and earlier:
38 */
39#   if MAC_OS_X_VERSION_MIN_REQUIRED < 1040
40#	define TCL_DYLD_USE_NSMODULE 1
41#   else
42#	define TCL_DYLD_USE_NSMODULE 0
43#   endif
44#endif
45
46#if TCL_DYLD_USE_DLFCN
47#include <dlfcn.h>
48#if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040
49/*
50 * Support for weakly importing dlfcn API.
51 */
52extern void *dlopen(const char *path, int mode) WEAK_IMPORT_ATTRIBUTE;
53extern void *dlsym(void *handle, const char *symbol) WEAK_IMPORT_ATTRIBUTE;
54extern int dlclose(void *handle) WEAK_IMPORT_ATTRIBUTE;
55extern char *dlerror(void) WEAK_IMPORT_ATTRIBUTE;
56#endif
57#endif
58
59#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
60#include <mach-o/dyld.h>
61#include <mach-o/fat.h>
62#include <mach-o/swap.h>
63#include <mach-o/arch.h>
64#include <libkern/OSByteOrder.h>
65#undef panic
66#include <mach/mach.h>
67#include <stdbool.h>
68
69typedef struct Tcl_DyldModuleHandle {
70    struct Tcl_DyldModuleHandle *nextPtr;
71    NSModule module;
72} Tcl_DyldModuleHandle;
73#endif /* TCL_DYLD_USE_NSMODULE */
74
75typedef struct Tcl_DyldLoadHandle {
76#if TCL_DYLD_USE_DLFCN
77    void *dlHandle;
78#endif
79#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
80    const struct mach_header *dyldLibHeader;
81    Tcl_DyldModuleHandle *modulePtr;
82#endif
83} Tcl_DyldLoadHandle;
84
85#if (TCL_DYLD_USE_DLFCN && MAC_OS_X_VERSION_MIN_REQUIRED < 1040) || \
86	defined(TCL_LOAD_FROM_MEMORY)
87MODULE_SCOPE long tclMacOSXDarwinRelease;
88#endif
89
90#ifdef TCL_DEBUG_LOAD
91#define TclLoadDbgMsg(m, ...) do { \
92	    fprintf(stderr, "%s:%d: %s(): " m ".\n", \
93	    strrchr(__FILE__, '/')+1, __LINE__, __func__, ##__VA_ARGS__); \
94	} while (0)
95#else
96#define TclLoadDbgMsg(m, ...)
97#endif
98
99#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
100/*
101 *----------------------------------------------------------------------
102 *
103 * DyldOFIErrorMsg --
104 *
105 *	Converts a numerical NSObjectFileImage error into an error message
106 *	string.
107 *
108 * Results:
109 *	Error message string.
110 *
111 * Side effects:
112 *	None.
113 *
114 *----------------------------------------------------------------------
115 */
116
117static CONST char*
118DyldOFIErrorMsg(
119    int err)
120{
121    switch(err) {
122    case NSObjectFileImageSuccess:
123	return NULL;
124    case NSObjectFileImageFailure:
125	return "object file setup failure";
126    case NSObjectFileImageInappropriateFile:
127	return "not a Mach-O MH_BUNDLE file";
128    case NSObjectFileImageArch:
129	return "no object for this architecture";
130    case NSObjectFileImageFormat:
131	return "bad object file format";
132    case NSObjectFileImageAccess:
133	return "can't read object file";
134    default:
135	return "unknown error";
136    }
137}
138#endif /* TCL_DYLD_USE_NSMODULE */
139
140/*
141 *----------------------------------------------------------------------
142 *
143 * TclpDlopen --
144 *
145 *	Dynamically loads a binary code file into memory and returns a handle
146 *	to the new code.
147 *
148 * Results:
149 *	A standard Tcl completion code. If an error occurs, an error message
150 *	is left in the interpreter's result.
151 *
152 * Side effects:
153 *	New code suddenly appears in memory.
154 *
155 *----------------------------------------------------------------------
156 */
157
158MODULE_SCOPE int
159TclpDlopen(
160    Tcl_Interp *interp,		/* Used for error reporting. */
161    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
162				 * code (UTF-8). */
163    Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
164				 * file which will be passed back to
165				 * (*unloadProcPtr)() to unload the file. */
166    Tcl_FSUnloadFileProc **unloadProcPtr)
167				/* Filled with address of Tcl_FSUnloadFileProc
168				 * function which should be used for this
169				 * file. */
170{
171    Tcl_DyldLoadHandle *dyldLoadHandle;
172#if TCL_DYLD_USE_DLFCN
173    void *dlHandle = NULL;
174#endif
175#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
176    const struct mach_header *dyldLibHeader = NULL;
177    Tcl_DyldModuleHandle *modulePtr = NULL;
178#endif
179#if TCL_DYLD_USE_NSMODULE
180    NSLinkEditErrors editError;
181    int errorNumber;
182    const char *errorName, *objFileImageErrMsg = NULL;
183#endif
184    const char *errMsg = NULL;
185    int result;
186    Tcl_DString ds;
187    char *fileName = NULL;
188    const char *nativePath, *nativeFileName = NULL;
189
190    /*
191     * First try the full path the user gave us. This is particularly
192     * important if the cwd is inside a vfs, and we are trying to load using a
193     * relative path.
194     */
195
196    nativePath = Tcl_FSGetNativePath(pathPtr);
197
198#if TCL_DYLD_USE_DLFCN
199#if MAC_OS_X_VERSION_MIN_REQUIRED < 1040
200    if (tclMacOSXDarwinRelease >= 8)
201#endif
202    {
203	dlHandle = dlopen(nativePath, RTLD_NOW | RTLD_LOCAL);
204	if (!dlHandle) {
205	    /*
206	     * Let the OS loader examine the binary search path for whatever
207	     * string the user gave us which hopefully refers to a file on the
208	     * binary path.
209	     */
210
211	    fileName = Tcl_GetString(pathPtr);
212	    nativeFileName = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
213	    dlHandle = dlopen(nativeFileName, RTLD_NOW | RTLD_LOCAL);
214	}
215	if (dlHandle) {
216	    TclLoadDbgMsg("dlopen() successful");
217	} else {
218	    errMsg = dlerror();
219	    TclLoadDbgMsg("dlopen() failed: %s", errMsg);
220	}
221    }
222    if (!dlHandle)
223#endif /* TCL_DYLD_USE_DLFCN */
224    {
225#if TCL_DYLD_USE_NSMODULE
226	dyldLibHeader = NSAddImage(nativePath,
227		NSADDIMAGE_OPTION_RETURN_ON_ERROR);
228	if (dyldLibHeader) {
229	    TclLoadDbgMsg("NSAddImage() successful");
230	} else {
231	    NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg);
232	    if (editError == NSLinkEditFileAccessError) {
233		/*
234		 * The requested file was not found. Let the OS loader examine
235		 * the binary search path for whatever string the user gave us
236		 * which hopefully refers to a file on the binary path.
237		 */
238
239		if (!fileName) {
240		    fileName = Tcl_GetString(pathPtr);
241		    nativeFileName = Tcl_UtfToExternalDString(NULL, fileName,
242			    -1, &ds);
243		}
244		dyldLibHeader = NSAddImage(nativeFileName,
245			NSADDIMAGE_OPTION_WITH_SEARCHING |
246			NSADDIMAGE_OPTION_RETURN_ON_ERROR);
247		if (dyldLibHeader) {
248		    TclLoadDbgMsg("NSAddImage() successful");
249		} else {
250		    NSLinkEditError(&editError, &errorNumber, &errorName,
251			    &errMsg);
252		    TclLoadDbgMsg("NSAddImage() failed: %s", errMsg);
253		}
254	    } else if ((editError == NSLinkEditFileFormatError
255		    && errorNumber == EBADMACHO)
256		    || editError == NSLinkEditOtherError){
257		NSObjectFileImageReturnCode err;
258		NSObjectFileImage dyldObjFileImage;
259		NSModule module;
260
261		/*
262		 * The requested file was found but was not of type MH_DYLIB,
263		 * attempt to load it as a MH_BUNDLE.
264		 */
265
266		err = NSCreateObjectFileImageFromFile(nativePath,
267			&dyldObjFileImage);
268		if (err == NSObjectFileImageSuccess && dyldObjFileImage) {
269		    TclLoadDbgMsg("NSCreateObjectFileImageFromFile() "
270			    "successful");
271		    module = NSLinkModule(dyldObjFileImage, nativePath,
272			    NSLINKMODULE_OPTION_BINDNOW
273			    | NSLINKMODULE_OPTION_RETURN_ON_ERROR);
274		    NSDestroyObjectFileImage(dyldObjFileImage);
275		    if (module) {
276			modulePtr = (Tcl_DyldModuleHandle *)
277				ckalloc(sizeof(Tcl_DyldModuleHandle));
278			modulePtr->module = module;
279			modulePtr->nextPtr = NULL;
280			TclLoadDbgMsg("NSLinkModule() successful");
281		    } else {
282			NSLinkEditError(&editError, &errorNumber, &errorName,
283				&errMsg);
284			TclLoadDbgMsg("NSLinkModule() failed: %s", errMsg);
285		    }
286		} else {
287		    objFileImageErrMsg = DyldOFIErrorMsg(err);
288		    TclLoadDbgMsg("NSCreateObjectFileImageFromFile() failed: "
289			    "%s", objFileImageErrMsg);
290		}
291	    }
292	}
293#endif /* TCL_DYLD_USE_NSMODULE */
294    }
295    if (0
296#if TCL_DYLD_USE_DLFCN
297	    || dlHandle
298#endif
299#if TCL_DYLD_USE_NSMODULE
300	    || dyldLibHeader || modulePtr
301#endif
302    ) {
303	dyldLoadHandle = (Tcl_DyldLoadHandle *)
304		ckalloc(sizeof(Tcl_DyldLoadHandle));
305#if TCL_DYLD_USE_DLFCN
306	dyldLoadHandle->dlHandle = dlHandle;
307#endif
308#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
309	dyldLoadHandle->dyldLibHeader = dyldLibHeader;
310	dyldLoadHandle->modulePtr = modulePtr;
311#endif
312	*loadHandle = (Tcl_LoadHandle) dyldLoadHandle;
313	*unloadProcPtr = &TclpUnloadFile;
314	result = TCL_OK;
315    } else {
316	Tcl_AppendResult(interp, errMsg, NULL);
317#if TCL_DYLD_USE_NSMODULE
318	if (objFileImageErrMsg) {
319	    Tcl_AppendResult(interp, "\nNSCreateObjectFileImageFromFile() "
320		    "error: ", objFileImageErrMsg, NULL);
321	}
322#endif
323	result = TCL_ERROR;
324    }
325    if(fileName) {
326	Tcl_DStringFree(&ds);
327    }
328    return result;
329}
330
331/*
332 *----------------------------------------------------------------------
333 *
334 * TclpFindSymbol --
335 *
336 *	Looks up a symbol, by name, through a handle associated with a
337 *	previously loaded piece of code (shared library).
338 *
339 * Results:
340 *	Returns a pointer to the function associated with 'symbol' if it is
341 *	found. Otherwise returns NULL and may leave an error message in the
342 *	interp's result.
343 *
344 *----------------------------------------------------------------------
345 */
346
347MODULE_SCOPE Tcl_PackageInitProc *
348TclpFindSymbol(
349    Tcl_Interp *interp,		/* For error reporting. */
350    Tcl_LoadHandle loadHandle,	/* Handle from TclpDlopen. */
351    CONST char *symbol)		/* Symbol name to look up. */
352{
353    Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *) loadHandle;
354    Tcl_PackageInitProc *proc = NULL;
355    const char *errMsg = NULL;
356    Tcl_DString ds;
357    const char *native;
358
359    native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
360#if TCL_DYLD_USE_DLFCN
361    if (dyldLoadHandle->dlHandle) {
362	proc = dlsym(dyldLoadHandle->dlHandle, native);
363	if (proc) {
364	    TclLoadDbgMsg("dlsym() successful");
365	} else {
366	    errMsg = dlerror();
367	    TclLoadDbgMsg("dlsym() failed: %s", errMsg);
368	}
369    } else
370#endif /* TCL_DYLD_USE_DLFCN */
371    {
372#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
373	NSSymbol nsSymbol = NULL;
374	Tcl_DString newName;
375
376	/*
377	 * dyld adds an underscore to the beginning of symbol names.
378	 */
379
380	Tcl_DStringInit(&newName);
381	Tcl_DStringAppend(&newName, "_", 1);
382	native = Tcl_DStringAppend(&newName, native, -1);
383	if (dyldLoadHandle->dyldLibHeader) {
384	    nsSymbol = NSLookupSymbolInImage(dyldLoadHandle->dyldLibHeader,
385		    native, NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_NOW |
386		    NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR);
387	    if (nsSymbol) {
388		TclLoadDbgMsg("NSLookupSymbolInImage() successful");
389#ifdef DYLD_SUPPORTS_DYLIB_UNLOADING
390		/*
391		 * Until dyld supports unloading of MY_DYLIB binaries, the
392		 * following is not needed.
393		 */
394
395		NSModule module = NSModuleForSymbol(nsSymbol);
396		Tcl_DyldModuleHandle *modulePtr = dyldLoadHandle->modulePtr;
397
398		while (modulePtr != NULL) {
399		    if (module == modulePtr->module) {
400			break;
401		    }
402		    modulePtr = modulePtr->nextPtr;
403		}
404		if (modulePtr == NULL) {
405		    modulePtr = (Tcl_DyldModuleHandle *)
406			    ckalloc(sizeof(Tcl_DyldModuleHandle));
407		    modulePtr->module = module;
408		    modulePtr->nextPtr = dyldLoadHandle->modulePtr;
409		    dyldLoadHandle->modulePtr = modulePtr;
410		}
411#endif /* DYLD_SUPPORTS_DYLIB_UNLOADING */
412	    } else {
413		NSLinkEditErrors editError;
414		int errorNumber;
415		const char *errorName;
416
417		NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg);
418		TclLoadDbgMsg("NSLookupSymbolInImage() failed: %s", errMsg);
419	    }
420	} else if (dyldLoadHandle->modulePtr) {
421	    nsSymbol = NSLookupSymbolInModule(
422		    dyldLoadHandle->modulePtr->module, native);
423	    if (nsSymbol) {
424		TclLoadDbgMsg("NSLookupSymbolInModule() successful");
425	    } else {
426		TclLoadDbgMsg("NSLookupSymbolInModule() failed");
427	    }
428	}
429	if (nsSymbol) {
430	    proc = NSAddressOfSymbol(nsSymbol);
431	    if (proc) {
432		TclLoadDbgMsg("NSAddressOfSymbol() successful");
433	    } else {
434		TclLoadDbgMsg("NSAddressOfSymbol() failed");
435	    }
436	}
437	Tcl_DStringFree(&newName);
438#endif /* TCL_DYLD_USE_NSMODULE */
439    }
440    Tcl_DStringFree(&ds);
441    if (errMsg) {
442	Tcl_AppendResult(interp, errMsg, NULL);
443    }
444    return proc;
445}
446
447/*
448 *----------------------------------------------------------------------
449 *
450 * TclpUnloadFile --
451 *
452 *	Unloads a dynamically loaded binary code file from memory. Code
453 *	pointers in the formerly loaded file are no longer valid after calling
454 *	this function.
455 *
456 * Results:
457 *	None.
458 *
459 * Side effects:
460 *	Code dissapears from memory. Note that dyld currently only supports
461 *	unloading of binaries of type MH_BUNDLE loaded with NSLinkModule() in
462 *	TclpDlopen() above.
463 *
464 *----------------------------------------------------------------------
465 */
466
467MODULE_SCOPE void
468TclpUnloadFile(
469    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
470				 * TclpDlopen(). The loadHandle is a token
471				 * that represents the loaded file. */
472{
473    Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *) loadHandle;
474
475#if TCL_DYLD_USE_DLFCN
476    if (dyldLoadHandle->dlHandle) {
477	int result;
478
479	result = dlclose(dyldLoadHandle->dlHandle);
480	if (!result) {
481	    TclLoadDbgMsg("dlclose() successful");
482	} else {
483	    TclLoadDbgMsg("dlclose() failed: %s", dlerror());
484	}
485    } else
486#endif /* TCL_DYLD_USE_DLFCN */
487    {
488#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
489	Tcl_DyldModuleHandle *modulePtr = dyldLoadHandle->modulePtr;
490
491	while (modulePtr != NULL) {
492	    void *ptr;
493	    bool result;
494
495	    result = NSUnLinkModule(modulePtr->module,
496		    NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES);
497	    if (result) {
498		TclLoadDbgMsg("NSUnLinkModule() successful");
499	    } else {
500		TclLoadDbgMsg("NSUnLinkModule() failed");
501	    }
502	    ptr = modulePtr;
503	    modulePtr = modulePtr->nextPtr;
504	    ckfree(ptr);
505	}
506#endif /* TCL_DYLD_USE_NSMODULE */
507    }
508    ckfree((char*) dyldLoadHandle);
509}
510
511/*
512 *----------------------------------------------------------------------
513 *
514 * TclGuessPackageName --
515 *
516 *	If the "load" command is invoked without providing a package name,
517 *	this procedure is invoked to try to figure it out.
518 *
519 * Results:
520 *	Always returns 0 to indicate that we couldn't figure out a package
521 *	name; generic code will then try to guess the package from the file
522 *	name. A return value of 1 would have meant that we figured out the
523 *	package name and put it in bufPtr.
524 *
525 * Side effects:
526 *	None.
527 *
528 *----------------------------------------------------------------------
529 */
530
531int
532TclGuessPackageName(
533    CONST char *fileName,	/* Name of file containing package (already
534				 * translated to local form if needed). */
535    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
536				 * name to this if possible. */
537{
538    return 0;
539}
540
541#ifdef TCL_LOAD_FROM_MEMORY
542/*
543 *----------------------------------------------------------------------
544 *
545 * TclpLoadMemoryGetBuffer --
546 *
547 *	Allocate a buffer that can be used with TclpLoadMemory() below.
548 *
549 * Results:
550 *	Pointer to allocated buffer or NULL if an error occurs.
551 *
552 * Side effects:
553 *	Buffer is allocated.
554 *
555 *----------------------------------------------------------------------
556 */
557
558MODULE_SCOPE void *
559TclpLoadMemoryGetBuffer(
560    Tcl_Interp *interp,		/* Used for error reporting. */
561    int size)			/* Size of desired buffer. */
562{
563    void *buffer = NULL;
564
565    /*
566     * NSCreateObjectFileImageFromMemory is available but always fails
567     * prior to Darwin 7.
568     */
569    if (tclMacOSXDarwinRelease >= 7) {
570	/*
571	 * We must allocate the buffer using vm_allocate, because
572	 * NSCreateObjectFileImageFromMemory will dispose of it using
573	 * vm_deallocate.
574	 */
575
576	if (vm_allocate(mach_task_self(), (vm_address_t *) &buffer, size, 1)) {
577	    buffer = NULL;
578	}
579    }
580    return buffer;
581}
582
583/*
584 *----------------------------------------------------------------------
585 *
586 * TclpLoadMemory --
587 *
588 *	Dynamically loads binary code file from memory and returns a handle to
589 *	the new code.
590 *
591 * Results:
592 *	A standard Tcl completion code. If an error occurs, an error message
593 *	is left in the interpreter's result.
594 *
595 * Side effects:
596 *	New code is loaded from memory.
597 *
598 *----------------------------------------------------------------------
599 */
600
601MODULE_SCOPE int
602TclpLoadMemory(
603    Tcl_Interp *interp,		/* Used for error reporting. */
604    void *buffer,		/* Buffer containing the desired code
605				 * (allocated with TclpLoadMemoryGetBuffer). */
606    int size,			/* Allocation size of buffer. */
607    int codeSize,		/* Size of code data read into buffer or -1 if
608				 * an error occurred and the buffer should
609				 * just be freed. */
610    Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
611				 * file which will be passed back to
612				 * (*unloadProcPtr)() to unload the file. */
613    Tcl_FSUnloadFileProc **unloadProcPtr)
614				/* Filled with address of Tcl_FSUnloadFileProc
615				 * function which should be used for this
616				 * file. */
617{
618    Tcl_DyldLoadHandle *dyldLoadHandle;
619    NSObjectFileImage dyldObjFileImage = NULL;
620    Tcl_DyldModuleHandle *modulePtr;
621    NSModule module;
622    const char *objFileImageErrMsg = NULL;
623
624    /*
625     * Try to create an object file image that we can load from.
626     */
627
628    if (codeSize >= 0) {
629	NSObjectFileImageReturnCode err = NSObjectFileImageSuccess;
630	const struct fat_header *fh = buffer;
631	uint32_t ms = 0;
632#ifndef __LP64__
633	const struct mach_header *mh = NULL;
634	#define mh_size  sizeof(struct mach_header)
635	#define mh_magic MH_MAGIC
636	#define arch_abi 0
637#else
638	const struct mach_header_64 *mh = NULL;
639	#define mh_size  sizeof(struct mach_header_64)
640	#define mh_magic MH_MAGIC_64
641	#define arch_abi CPU_ARCH_ABI64
642#endif
643
644	if ((size_t) codeSize >= sizeof(struct fat_header)
645		&& fh->magic == OSSwapHostToBigInt32(FAT_MAGIC)) {
646	    uint32_t fh_nfat_arch = OSSwapBigToHostInt32(fh->nfat_arch);
647
648	    /*
649	     * Fat binary, try to find mach_header for our architecture
650	     */
651
652	    TclLoadDbgMsg("Fat binary, %d archs", fh_nfat_arch);
653	    if ((size_t) codeSize >= sizeof(struct fat_header) +
654		    fh_nfat_arch * sizeof(struct fat_arch)) {
655		void *fatarchs = (char*)buffer + sizeof(struct fat_header);
656		const NXArchInfo *arch = NXGetLocalArchInfo();
657		struct fat_arch *fa;
658
659		if (fh->magic != FAT_MAGIC) {
660		    swap_fat_arch(fatarchs, fh_nfat_arch, arch->byteorder);
661		}
662		fa = NXFindBestFatArch(arch->cputype | arch_abi,
663			arch->cpusubtype, fatarchs, fh_nfat_arch);
664		if (fa) {
665		    TclLoadDbgMsg("NXFindBestFatArch() successful: "
666			    "local cputype %d subtype %d, "
667			    "fat cputype %d subtype %d",
668			    arch->cputype | arch_abi, arch->cpusubtype,
669			    fa->cputype, fa->cpusubtype);
670		    mh = (void*)((char*)buffer + fa->offset);
671		    ms = fa->size;
672		} else {
673		    TclLoadDbgMsg("NXFindBestFatArch() failed");
674		    err = NSObjectFileImageInappropriateFile;
675		}
676		if (fh->magic != FAT_MAGIC) {
677		    swap_fat_arch(fatarchs, fh_nfat_arch, arch->byteorder);
678		}
679	    } else {
680		TclLoadDbgMsg("Fat binary header failure");
681		err = NSObjectFileImageInappropriateFile;
682	    }
683	} else {
684	    /*
685	     * Thin binary
686	     */
687
688	    TclLoadDbgMsg("Thin binary");
689	    mh = buffer;
690	    ms = codeSize;
691	}
692	if (ms && !(ms >= mh_size && mh->magic == mh_magic &&
693		 mh->filetype == MH_BUNDLE)) {
694	    TclLoadDbgMsg("Inappropriate file: magic %x filetype %d",
695		    mh->magic, mh->filetype);
696	    err = NSObjectFileImageInappropriateFile;
697	}
698	if (err == NSObjectFileImageSuccess) {
699	    err = NSCreateObjectFileImageFromMemory(buffer, codeSize,
700		    &dyldObjFileImage);
701	    if (err == NSObjectFileImageSuccess) {
702		TclLoadDbgMsg("NSCreateObjectFileImageFromMemory() "
703			"successful");
704	    } else {
705		objFileImageErrMsg = DyldOFIErrorMsg(err);
706		TclLoadDbgMsg("NSCreateObjectFileImageFromMemory() failed: %s",
707			objFileImageErrMsg);
708	    }
709	} else {
710	    objFileImageErrMsg = DyldOFIErrorMsg(err);
711	}
712    }
713
714    /*
715     * If it went wrong (or we were asked to just deallocate), get rid of the
716     * memory block and create an error message.
717     */
718
719    if (dyldObjFileImage == NULL) {
720	vm_deallocate(mach_task_self(), (vm_address_t) buffer, size);
721	if (objFileImageErrMsg != NULL) {
722	    Tcl_AppendResult(interp, "NSCreateObjectFileImageFromMemory() "
723		    "error: ", objFileImageErrMsg, NULL);
724	}
725	return TCL_ERROR;
726    }
727
728    /*
729     * Extract the module we want from the image of the object file.
730     */
731
732    module = NSLinkModule(dyldObjFileImage, "[Memory Based Bundle]",
733	    NSLINKMODULE_OPTION_BINDNOW | NSLINKMODULE_OPTION_RETURN_ON_ERROR);
734    NSDestroyObjectFileImage(dyldObjFileImage);
735    if (module) {
736	TclLoadDbgMsg("NSLinkModule() successful");
737    } else {
738	NSLinkEditErrors editError;
739	int errorNumber;
740	const char *errorName, *errMsg;
741
742	NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg);
743	TclLoadDbgMsg("NSLinkModule() failed: %s", errMsg);
744	Tcl_AppendResult(interp, errMsg, NULL);
745	return TCL_ERROR;
746    }
747
748    /*
749     * Stash the module reference within the load handle we create and return.
750     */
751
752    modulePtr = (Tcl_DyldModuleHandle *) ckalloc(sizeof(Tcl_DyldModuleHandle));
753    modulePtr->module = module;
754    modulePtr->nextPtr = NULL;
755    dyldLoadHandle = (Tcl_DyldLoadHandle *)
756	    ckalloc(sizeof(Tcl_DyldLoadHandle));
757#if TCL_DYLD_USE_DLFCN
758    dyldLoadHandle->dlHandle = NULL;
759#endif
760    dyldLoadHandle->dyldLibHeader = NULL;
761    dyldLoadHandle->modulePtr = modulePtr;
762    *loadHandle = (Tcl_LoadHandle) dyldLoadHandle;
763    *unloadProcPtr = &TclpUnloadFile;
764    return TCL_OK;
765}
766#endif /* TCL_LOAD_FROM_MEMORY */
767
768/*
769 * Local Variables:
770 * mode: c
771 * c-basic-offset: 4
772 * fill-column: 79
773 * End:
774 */
775