[p5sagit/p5-mst-13.2.git] / ext / DynaLoader / dl_next.xs

/* dl_next.xs
 * 
 * Platform:	NeXT NS 3.2
 * Author:	Anno Siegel (siegel@zrz.TU-Berlin.DE)
 * Based on:	dl_dlopen.xs by Paul Marquess
 * 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.'
*/

/* Porting notes:

dl_next.xs is itself 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 NeXTs rld_*.  The xs code proper is unchanged
from Paul's original.

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

Anno Siegel

*/

#if NS_TARGET_MAJOR >= 4
#else
/* include these before perl headers */
#include <mach-o/rld.h>
#include <streams/streams.h>
#endif

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

#define DL_LOADONCEONLY

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


static char * dl_last_error = (char *) 0;
static AV *dl_resolve_using = Nullav;

static char *dlerror()
{
    return dl_last_error;
}

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

#if NS_TARGET_MAJOR >= 4
#import <mach-o/dyld.h>

enum dyldErrorSource
{
    OFImage,
};

static void TranslateError
    (const char *path, enum dyldErrorSource type, int number)
{
    char errorBuffer[128];
    unsigned int index;
    static char *OFIErrorStrings[] =
    {
	"%s(%d): Object Image Load Failure\n",
	"%s(%d): Object Image Load Success\n",
	"%s(%d): Not an 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]))

    if ( dl_last_error ) {
        safefree(dl_last_error);
    }
    switch (type)
    {
    case OFImage:
	index = number;
	if (index > NUM_OFI_ERRORS - 1)
	    index = NUM_OFI_ERRORS - 1;
	sprintf(errorBuffer, OFIErrorStrings[index], path, number);
	break;

    default:
	sprintf(errorBuffer, "%s(%d): Totally unknown error type %d\n",
	    path, number, type);
	break;
    }
    dl_last_error = safemalloc(strlen(errorBuffer)+1);
    strcpy(dl_last_error, errorBuffer);
}

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 error's
	// not very friendly but the error recovery functionality is limited.
	handle = NSLinkModule(ofile, path, TRUE);
    }
    
    return handle;
}

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

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

    return addr;
}

#else /* NS_TARGET_MAJOR <= 3 */

static NXStream *OpenError(void)
{
    return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
}

static void TransferError(NXStream *s)
{
    char *buffer;
    int len, maxlen;

    if ( dl_last_error ) {
        safefree(dl_last_error);
    }
    NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
    dl_last_error = safemalloc(len);
    strcpy(dl_last_error, buffer);
}

static void CloseError(NXStream *s)
{
    if ( s ) {
      NXCloseMemory( s, NX_FREEBUFFER);
    }
}

static char *dlopen(char *path, int mode /* mode is ignored */)
{
    int rld_success;
    NXStream *nxerr;
    I32 i, psize;
    char *result;
    char **p;
	
    /* Do not load what is already loaded into this process */
    if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
	return path;

    nxerr = OpenError();
    psize = AvFILL(dl_resolve_using) + 3;
    p = (char **) safemalloc(psize * sizeof(char*));
    p[0] = path;
    for(i=1; i<psize-1; i++) {
	p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), na);
    }
    p[psize-1] = 0;
    rld_success = rld_load(nxerr, (struct mach_header **)0, p,
			    (const char *) 0);
    safefree((char*) p);
    if (rld_success) {
	result = path;
	/* prevent multiple loads of same file into same process */
	hv_store(dl_loaded_files, path, strlen(path), &sv_yes, 0);
    } else {
	TransferError(nxerr);
	result = (char*) 0;
    }
    CloseError(nxerr);
    return result;
}

void *
dlsym(handle, symbol)
void *handle;
char *symbol;
{
    NXStream	*nxerr = OpenError();
    char	symbuf[1024];
    unsigned long	symref = 0;

    sprintf(symbuf, "_%s", symbol);
    if (!rld_lookup(nxerr, symbuf, &symref)) {
	TransferError(nxerr);
    }
    CloseError(nxerr);
    return (void*) symref;
}

#endif /* NS_TARGET_MAJOR >= 4 */


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


static void
dl_private_init()
{
    (void)dl_generic_private_init();
    dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
}
 
MODULE = DynaLoader     PACKAGE = DynaLoader

BOOT:
    (void)dl_private_init();


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


void *
dl_find_symbol(libhandle, symbolname)
    void *		libhandle
    char *		symbolname
    CODE:
#if NS_TARGET_MAJOR >= 4
    char symbolname_buf[1024];
    symbolname = dl_add_underscore(symbolname, symbolname_buf);
#endif
    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n",
	    libhandle, symbolname));
    RETVAL = dlsym(libhandle, symbolname);
    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "  symbolref = %x\n", RETVAL));
    ST(0) = sv_newmortal() ;
    if (RETVAL == NULL)
	SaveError("%s",dlerror()) ;
    else
	sv_setiv( ST(0), (IV)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 
    char *	filename
    CODE:
    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
	    perl_name, symref));
    ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));


char *
dl_error()
    CODE:
    RETVAL = LastError ;
    OUTPUT:
    RETVAL

# end.
Commit	Line	Data
a0d0e21e	1	/* dl_next.xs
	2	*
	3	* Platform: NeXT NS 3.2
	4	* Author: Anno Siegel (siegel@zrz.TU-Berlin.DE)
	5	* Based on: dl_dlopen.xs by Paul Marquess
	6	* Created: Aug 15th, 1994
	7	*
	8	*/
	9
	10	/*
	11	And Gandalf said: 'Many folk like to know beforehand what is to
	12	be set on the table; but those who have laboured to prepare the
	13	feast like to keep their secret; for wonder makes the words of
	14	praise louder.'
	15	*/
	16
	17	/* Porting notes:
	18
	19	dl_next.xs is itself a port from dl_dlopen.xs by Paul Marquess. It
	20	should not be used as a base for further ports though it may be used
	21	as an example for how dl_dlopen.xs can be ported to other platforms.
	22
	23	The method used here is just to supply the sun style dlopen etc.
	24	functions in terms of NeXTs rld_*. The xs code proper is unchanged
	25	from Paul's original.
	26
	27	The port could use some streamlining. For one, error handling could
	28	be simplified.
	29
	30	Anno Siegel
	31
	32	*/
	33
d6bcbf1c	34	#if NS_TARGET_MAJOR >= 4
d6bcbf1c	35	#else
8e07c86e	36	/* include these before perl headers */
	37	#include <mach-o/rld.h>
	38	#include <streams/streams.h>
d6bcbf1c	39	#endif
8e07c86e	40
a0d0e21e	41	#include "EXTERN.h"
	42	#include "perl.h"
	43	#include "XSUB.h"
	44
8e07c86e	45	#define DL_LOADONCEONLY
a0d0e21e	46
8e07c86e	47	#include "dlutils.c" /* SaveError() etc */
a0d0e21e	48
a0d0e21e	49
a0d0e21e	50	static char * dl_last_error = (char *) 0;
8e07c86e	51	static AV *dl_resolve_using = Nullav;
a0d0e21e	52
d6bcbf1c	53	static char *dlerror()
	54	{
	55	return dl_last_error;
	56	}
	57
	58	int dlclose(handle) /* stub only */
	59	void *handle;
	60	{
	61	return 0;
	62	}
	63
	64	#if NS_TARGET_MAJOR >= 4
	65	#import <mach-o/dyld.h>
	66
	67	enum dyldErrorSource
	68	{
	69	OFImage,
	70	};
	71
	72	static void TranslateError
	73	(const char *path, enum dyldErrorSource type, int number)
	74	{
	75	char errorBuffer[128];
	76	unsigned int index;
	77	static char *OFIErrorStrings[] =
	78	{
	79	"%s(%d): Object Image Load Failure\n",
	80	"%s(%d): Object Image Load Success\n",
	81	"%s(%d): Not an recognisable object file\n",
	82	"%s(%d): No valid architecture\n",
	83	"%s(%d): Object image has an invalid format\n",
	84	"%s(%d): Invalid access (permissions?)\n",
	85	"%s(%d): Unknown error code from NSCreateObjectFileImageFromFile\n",
	86	};
	87	#define NUM_OFI_ERRORS (sizeof(OFIErrorStrings) / sizeof(OFIErrorStrings[0]))
	88
	89	if ( dl_last_error ) {
	90	safefree(dl_last_error);
	91	}
	92	switch (type)
	93	{
	94	case OFImage:
	95	index = number;
	96	if (index > NUM_OFI_ERRORS - 1)
	97	index = NUM_OFI_ERRORS - 1;
	98	sprintf(errorBuffer, OFIErrorStrings[index], path, number);
	99	break;
	100
	101	default:
	102	sprintf(errorBuffer, "%s(%d): Totally unknown error type %d\n",
	103	path, number, type);
	104	break;
	105	}
	106	dl_last_error = safemalloc(strlen(errorBuffer)+1);
	107	strcpy(dl_last_error, errorBuffer);
	108	}
	109
	110	static char dlopen(char path, int mode /* mode is ignored */)
	111	{
	112	int dyld_result;
	113	NSObjectFileImage ofile;
	114	NSModule handle = NULL;
	115
	116	dyld_result = NSCreateObjectFileImageFromFile(path, &ofile);
117	if (dyld_result != NSObjectFileImageSuccess)
118	TranslateError(path, OFImage, dyld_result);
119	else
120	{
121	// NSLinkModule will cause the run to abort on any link error's
122	// not very friendly but the error recovery functionality is limited.
123	handle = NSLinkModule(ofile, path, TRUE);
124	}
125
126	return handle;
127	}
128
129	void *
130	dlsym(handle, symbol)
131	void *handle;
132	char *symbol;
133	{
134	void *addr;
135
136	if (NSIsSymbolNameDefined(symbol))
137	addr = NSAddressOfSymbol(NSLookupAndBindSymbol(symbol));
138	else
139	addr = NULL;
140
141	return addr;
142	}
143
144	#else /* NS_TARGET_MAJOR <= 3 */
145
146	static NXStream *OpenError(void)
a0d0e21e	147	{
	148	return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
	149	}
	150
d6bcbf1c	151	static void TransferError(NXStream *s)
a0d0e21e	152	{
	153	char *buffer;
	154	int len, maxlen;
	155
	156	if ( dl_last_error ) {
	157	safefree(dl_last_error);
	158	}
	159	NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
	160	dl_last_error = safemalloc(len);
	161	strcpy(dl_last_error, buffer);
	162	}
	163
d6bcbf1c	164	static void CloseError(NXStream *s)
a0d0e21e	165	{
	166	if ( s ) {
	167	NXCloseMemory( s, NX_FREEBUFFER);
	168	}
	169	}
	170
d6bcbf1c	171	static char dlopen(char path, int mode /* mode is ignored */)
a0d0e21e	172	{
a0d0e21e	173	int rld_success;
8e07c86e	174	NXStream *nxerr;
a0d0e21e	175	I32 i, psize;
	176	char *result;
	177	char **p;
8e07c86e	178
	179	/* Do not load what is already loaded into this process */
	180	if (hv_fetch(dl_loaded_files, path, strlen(path), 0))
	181	return path;
a0d0e21e	182
8e07c86e	183	nxerr = OpenError();
8e07c86e	184	psize = AvFILL(dl_resolve_using) + 3;
a0d0e21e	185	p = (char *) safemalloc(psize sizeof(char*));
	186	p[0] = path;
	187	for(i=1; i<psize-1; i++) {
8e07c86e	188	p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), na);
a0d0e21e	189	}
	190	p[psize-1] = 0;
	191	rld_success = rld_load(nxerr, (struct mach_header **)0, p,
	192	(const char *) 0);
	193	safefree((char*) p);
	194	if (rld_success) {
	195	result = path;
8e07c86e	196	/* prevent multiple loads of same file into same process */
8e07c86e	197	hv_store(dl_loaded_files, path, strlen(path), &sv_yes, 0);
a0d0e21e	198	} else {
	199	TransferError(nxerr);
	200	result = (char*) 0;
	201	}
	202	CloseError(nxerr);
	203	return result;
	204	}
	205
a0d0e21e	206	void *
	207	dlsym(handle, symbol)
	208	void *handle;
	209	char *symbol;
	210	{
	211	NXStream *nxerr = OpenError();
	212	char symbuf[1024];
	213	unsigned long symref = 0;
	214
	215	sprintf(symbuf, "_%s", symbol);
	216	if (!rld_lookup(nxerr, symbuf, &symref)) {
	217	TransferError(nxerr);
	218	}
	219	CloseError(nxerr);
	220	return (void*) symref;
	221	}
	222
d6bcbf1c	223	#endif /* NS_TARGET_MAJOR >= 4 */
d6bcbf1c	224
a0d0e21e	225
	226	/* ----- code from dl_dlopen.xs below here ----- */
	227
	228
	229	static void
	230	dl_private_init()
	231	{
	232	(void)dl_generic_private_init();
8e07c86e	233	dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
a0d0e21e	234	}
	235
	236	MODULE = DynaLoader PACKAGE = DynaLoader
	237
	238	BOOT:
	239	(void)dl_private_init();
	240
	241
	242
	243	void *
ff7f3c60	244	dl_load_file(filename, flags=0)
a0d0e21e	245	char * filename
ff7f3c60	246	int flags
ff7f3c60	247	PREINIT:
a0d0e21e	248	int mode = 1;
ff7f3c60	249	CODE:
	250	DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags));
	251	if (flags & 0x01)
	252	warn("Can't make loaded symbols global on this platform while loading %s",filename);
a0d0e21e	253	RETVAL = dlopen(filename, mode) ;
760ac839	254	DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL));
a0d0e21e	255	ST(0) = sv_newmortal() ;
	256	if (RETVAL == NULL)
	257	SaveError("%s",dlerror()) ;
	258	else
	259	sv_setiv( ST(0), (IV)RETVAL);
	260
	261
	262	void *
	263	dl_find_symbol(libhandle, symbolname)
	264	void * libhandle
	265	char * symbolname
	266	CODE:
d6bcbf1c	267	#if NS_TARGET_MAJOR >= 4
	268	char symbolname_buf[1024];
	269	symbolname = dl_add_underscore(symbolname, symbolname_buf);
	270	#endif
760ac839	271	DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n",
a0d0e21e	272	libhandle, symbolname));
a0d0e21e	273	RETVAL = dlsym(libhandle, symbolname);
760ac839	274	DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " symbolref = %x\n", RETVAL));
a0d0e21e	275	ST(0) = sv_newmortal() ;
	276	if (RETVAL == NULL)
	277	SaveError("%s",dlerror()) ;
	278	else
	279	sv_setiv( ST(0), (IV)RETVAL);
	280
	281
	282	void
	283	dl_undef_symbols()
	284	PPCODE:
	285
	286
	287
	288	# These functions should not need changing on any platform:
	289
	290	void
	291	dl_install_xsub(perl_name, symref, filename="$Package")
	292	char * perl_name
	293	void * symref
	294	char * filename
	295	CODE:
760ac839	296	DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
a0d0e21e	297	perl_name, symref));
	298	ST(0)=sv_2mortal(newRV((SV)newXS(perl_name, (void()())symref, filename)));
	299
	300
	301	char *
	302	dl_error()
	303	CODE:
	304	RETVAL = LastError ;
	305	OUTPUT:
	306	RETVAL
	307
	308	# end.