Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
blib	[ DIR ]	drwxr-xr-x	2016-10-10 17:38
hints	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
t	[ DIR ]	drwxr-xr-x	2015-02-14 16:56
DynaLoader.c	15.51 KB	-rw-r--r--	2016-10-10 17:38
DynaLoader.o	9.58 KB	-rw-r--r--	2016-10-10 17:38
DynaLoader.pm	24.99 KB	-rw-r--r--	2016-10-10 17:38
DynaLoader.xs	7.56 KB	-r--r--r--	2016-10-10 17:38
DynaLoader_pm.PL	31.78 KB	-r--r--r--	2014-12-27 11:49
Makefile	29.67 KB	-rw-r--r--	2016-10-10 17:38
Makefile.PL	1.6 KB	-r--r--r--	2014-12-27 11:49
README	2 KB	-r--r--r--	2014-12-27 11:48
dl_aix.xs	18.29 KB	-r--r--r--	2014-12-27 11:49
dl_dllload.xs	5.89 KB	-r--r--r--	2014-12-27 11:49
dl_dlopen.xs	7.56 KB	-r--r--r--	2014-12-27 11:49
dl_dyld.xs	5.47 KB	-r--r--r--	2014-12-27 11:49
dl_freemint.xs	5.9 KB	-r--r--r--	2014-12-27 11:49
dl_hpux.xs	4.97 KB	-r--r--r--	2014-12-27 11:49
dl_next.xs	7.61 KB	-r--r--r--	2014-12-27 11:49
dl_none.xs	272 B	-r--r--r--	2014-12-27 11:48
dl_symbian.xs	5.2 KB	-r--r--r--	2014-12-27 11:49
dl_vms.xs	12.85 KB	-r--r--r--	2014-12-27 11:49
dl_win32.xs	4.68 KB	-r--r--r--	2014-12-27 11:49
dlutils.c	3.63 KB	-r--r--r--	2014-12-27 11:49
pm_to_blib	0 B	-rw-r--r--	2016-10-10 17:38

Rename

/* dl_dyld.xs
 *
 * Platform:	Darwin (Mac OS)
 * Author:	Wilfredo Sanchez <wsanchez@apple.com>
 * Based on:	dl_next.xs by Paul Marquess
 * Based on:	dl_dlopen.xs by Anno Siegel
 * Created:	Aug 15th, 1994
 *
 */

/*
 *  And Gandalf said: 'Many folk like to know beforehand what is to
 *  be set on the table; but those who have laboured to prepare the
 *  feast like to keep their secret; for wonder makes the words of
 *  praise louder.'
 *
 *     [p.970 of _The Lord of the Rings_, VI/v: "The Steward and the King"]
 */

/* Porting notes:

dl_dyld.xs is based on dl_next.xs by Anno Siegel.

dl_next.xs is in turn a port from dl_dlopen.xs by Paul Marquess.  It
should not be used as a base for further ports though it may be used
as an example for how dl_dlopen.xs can be ported to other platforms.

The method used here is just to supply the sun style dlopen etc.
functions in terms of NeXT's/Apple's dyld.  The xs code proper is
unchanged from Paul's original.

The port could use some streamlining.  For one, error handling could
be simplified.

This should be useable as a replacement for dl_next.xs, but it has not
been tested on NeXT platforms.

Wilfredo Sanchez

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "dlutils.c"	/* for SaveError() etc */

#undef environ
#undef bool
#import <mach-o/dyld.h>

static char *dlerror()
{
    dTHX;
    dMY_CXT;
    return dl_last_error;
}

static int dlclose(void *handle) /* stub only */
{
    return 0;
}

enum dyldErrorSource
{
    OFImage,
};

static void TranslateError
    (const char *path, enum dyldErrorSource type, int number)
{
    dTHX;
    dMY_CXT;
    char *error;
    unsigned int index;
    static char *OFIErrorStrings[] =
    {
	"%s(%d): Object Image Load Failure\n",
	"%s(%d): Object Image Load Success\n",
	"%s(%d): Not a recognisable object file\n",
	"%s(%d): No valid architecture\n",
	"%s(%d): Object image has an invalid format\n",
	"%s(%d): Invalid access (permissions?)\n",
	"%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n",
    };
#define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0]))

switch (type)
    {
    case OFImage:
	index = number;
	if (index > NUM_OFI_ERRORS - 1)
	    index = NUM_OFI_ERRORS - 1;
	error = Perl_form_nocontext(OFIErrorStrings[index], path, number);
	break;

default:
	error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n",
		     path, number, type);
	break;
    }
    sv_setpv(MY_CXT.x_dl_last_error, error);
}

static char *dlopen(char *path, int mode /* mode is ignored */)
{
    int dyld_result;
    NSObjectFileImage ofile;
    NSModule handle = NULL;

dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
    if (dyld_result != NSObjectFileImageSuccess)
	TranslateError(path, OFImage, dyld_result);
    else
    {
    	// NSLinkModule will cause the run to abort on any link errors
	// not very friendly but the error recovery functionality is limited.
	handle = NSLinkModule(ofile, path, TRUE);
	NSDestroyObjectFileImage(ofile);
    }

return handle;
}

static void *
dlsym(void *handle, char *symbol)
{
    void *addr;

if (NSIsSymbolNameDefined(symbol))
	addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
    else
    	addr = NULL;

return addr;
}

/* ----- code from dl_dlopen.xs below here ----- */

static void
dl_private_init(pTHX)
{
    (void)dl_generic_private_init(aTHX);
}

MODULE = DynaLoader     PACKAGE = DynaLoader

BOOT:
    (void)dl_private_init(aTHX);

void *
dl_load_file(filename, flags=0)
    char *	filename
    int		flags
    PREINIT:
    int mode = 1;
    CODE:
    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
    if (flags & 0x01)
	Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
    RETVAL = dlopen(filename, mode) ;
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
    ST(0) = sv_newmortal() ;
    if (RETVAL == NULL)
	SaveError(aTHX_ "%s",dlerror()) ;
    else
	sv_setiv( ST(0), PTR2IV(RETVAL) );

void *
dl_find_symbol(libhandle, symbolname)
    void *		libhandle
    char *		symbolname
    CODE:
    symbolname = Perl_form_nocontext("_%s", symbolname);
    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
			     "dl_find_symbol(handle=%lx, symbol=%s)\n",
			     (unsigned long) libhandle, symbolname));
    RETVAL = dlsym(libhandle, symbolname);
    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
			     "  symbolref = %lx\n", (unsigned long) RETVAL));
    ST(0) = sv_newmortal() ;
    if (RETVAL == NULL)
	SaveError(aTHX_ "%s",dlerror()) ;
    else
	sv_setiv( ST(0), PTR2IV(RETVAL) );

void
dl_undef_symbols()
    PPCODE:

# These functions should not need changing on any platform:

void
dl_install_xsub(perl_name, symref, filename="$Package")
    char *	perl_name
    void *	symref
    const char *	filename
    CODE:
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
	    perl_name, symref));
    ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
					      (void(*)(pTHX_ CV *))symref,
					      filename, NULL,
					      XS_DYNAMIC_FILENAME)));

char *
dl_error()
    CODE:
    dMY_CXT;
    RETVAL = dl_last_error ;
    OUTPUT:
    RETVAL

#if defined(USE_ITHREADS)

void
CLONE(...)
    CODE:
    MY_CXT_CLONE;

PERL_UNUSED_VAR(items);

/* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
     * using Perl variables that belong to another thread, we create our 
     * own for this thread.
     */
    MY_CXT.x_dl_last_error = newSVpvn("", 0);

#endif

# end.