dslinux/user/perl/ext/DynaLoader DynaLoader_pm.PL Makefile.PL README XSLoader_pm.PL dl_aix.xs dl_beos.xs dl_dld.xs dl_dllload.xs dl_dlopen.xs dl_dyld.xs dl_hpux.xs dl_mac.xs dl_mpeix.xs dl_next.xs dl_none.xs dl_vmesa.xs dl_vms.xs dlutils.c

cayenne dslinux_cayenne at user.in-berlin.de
Mon Dec 4 17:59:22 CET 2006


Update of /cvsroot/dslinux/dslinux/user/perl/ext/DynaLoader
In directory antilope:/tmp/cvs-serv17422/ext/DynaLoader

Added Files:
	DynaLoader_pm.PL Makefile.PL README XSLoader_pm.PL dl_aix.xs 
	dl_beos.xs dl_dld.xs dl_dllload.xs dl_dlopen.xs dl_dyld.xs 
	dl_hpux.xs dl_mac.xs dl_mpeix.xs dl_next.xs dl_none.xs 
	dl_vmesa.xs dl_vms.xs dlutils.c 
Log Message:
Adding fresh perl source to HEAD to branch from

--- NEW FILE: dl_mpeix.xs ---
/*
 * Author:  Mark Klein (mklein at dis.com)
 * Version: 2.1, 1996/07/25
 * Version: 2.2, 1997/09/25 Mark Bixby (markb at cccd.edu)
 * Version: 2.3, 1998/11/19 Mark Bixby (markb at cccd.edu)
 * Version: 2.4, 2002/03/24 Mark Bixby (mark at bixby.org)
 */

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

#ifdef __GNUC__
extern void HPGETPROCPLABEL(    int    parms,
                                char * procname,
                                void * plabel,
                                int  * status,
                                char * firstfile,
                                int    casesensitive,
                                int    symboltype,
                                int  * datasize,
                                int    position,
                                int    searchpath,
                                int    binding);
#else
#pragma intrinsic HPGETPROCPLABEL
#endif
#include "dlutils.c"    /* for SaveError() etc */

typedef struct {
  char  filename[PATH_MAX + 3];
  } t_mpe_dld, *p_mpe_dld;

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:
    char                buf[PATH_MAX + 3];
    p_mpe_dld           obj = NULL;

    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);
    obj = (p_mpe_dld) safemalloc(sizeof(t_mpe_dld));
    memzero(obj, sizeof(t_mpe_dld));
    if (filename[0] != '/')
        {
        getcwd(buf,sizeof(buf));
        sprintf(obj->filename," %s/%s ",buf,filename);
        }
    else
        sprintf(obj->filename," %s ",filename);

    DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", obj));

    ST(0) = sv_newmortal() ;
    if (obj == NULL)
        SaveError(aTHX_"%s",Strerror(errno));
    else
        sv_setiv( ST(0), PTR2IV(obj) );

void *
dl_find_symbol(libhandle, symbolname)
    void *      libhandle
    char *      symbolname
    CODE:
    int       datalen;
    p_mpe_dld obj = (p_mpe_dld) libhandle;
    char      symname[PATH_MAX + 3];
    void *    symaddr = NULL;
    int       status;
    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n",
                libhandle, symbolname));
    ST(0) = sv_newmortal() ;
    errno = 0;

    sprintf(symname, " %s ", symbolname);
    HPGETPROCPLABEL(8, symname, &symaddr, &status, obj->filename, 1,
                    0, &datalen, 1, 0, 0);

    DLDEBUG(2,PerlIO_printf(Perl_debug_log,"  symbolref(PROCEDURE) = %x, status=%x\n", symaddr, status));

    if (status != 0) {
        SaveError(aTHX_"%s",(errno) ? Strerror(errno) : "Symbol not found") ;
    } else {
        sv_setiv( ST(0), PTR2IV(symaddr) );
    }

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(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n",
            perl_name, symref));
    ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
					(void(*)(pTHX_ CV *))symref,
					filename)));

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

# end.

--- NEW FILE: dl_dyld.xs ---
/* dl_dyld.xs
 *
 * Platform:	Darwin (Mac OS)
 * Author:	Wilfredo Sanchez <wsanchez at 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.'
*/

/* 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
    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(perl_name,
					(void(*)(pTHX_ CV *))symref,
					filename)));


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

# end.

--- NEW FILE: dlutils.c ---
/* dlutils.c - handy functions and definitions for dl_*.xs files
 *
 * Currently this file is simply #included into dl_*.xs/.c files.
 * It should really be split into a dlutils.h and dlutils.c
 *
 * Modified:
 * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
 *                      files when the interpreter exits
 */

#ifndef XS_VERSION
#  define XS_VERSION "0"
#endif
#define MY_CXT_KEY "DynaLoader::_guts" XS_VERSION

typedef struct {
    SV*		x_dl_last_error;	/* pointer to allocated memory for
					   last error message */
    int		x_dl_nonlazy;		/* flag for immediate rather than lazy
					   linking (spots unresolved symbol) */
#ifdef DL_LOADONCEONLY
    HV *	x_dl_loaded_files;	/* only needed on a few systems */
#endif
#ifdef DL_CXT_EXTRA
    my_cxtx_t	x_dl_cxtx;		/* extra platform-specific data */
#endif
#ifdef DEBUGGING
    int		x_dl_debug;	/* value copied from $DynaLoader::dl_debug */
#endif
} my_cxt_t;

START_MY_CXT

#define dl_last_error	(SvPVX(MY_CXT.x_dl_last_error))
#define dl_nonlazy	(MY_CXT.x_dl_nonlazy)
#ifdef DL_LOADONCEONLY
#define dl_loaded_files	(MY_CXT.x_dl_loaded_files)
#endif
#ifdef DL_CXT_EXTRA
#define dl_cxtx		(MY_CXT.x_dl_cxtx)
#endif
#ifdef DEBUGGING
#define dl_debug	(MY_CXT.x_dl_debug)
#endif

#ifdef DEBUGGING
#define DLDEBUG(level,code) \
    STMT_START {					\
	dMY_CXT;					\
	if (dl_debug>=level) { code; }			\
    } STMT_END
#else
#define DLDEBUG(level,code)	NOOP
#endif

#ifdef DL_UNLOAD_ALL_AT_EXIT
/* Close all dlopen'd files */
static void
dl_unload_all_files(pTHX_ void *unused)
{
    CV *sub;
    AV *dl_librefs;
    SV *dl_libref;

    if ((sub = get_cv("DynaLoader::dl_unload_file", FALSE)) != NULL) {
        dl_librefs = get_av("DynaLoader::dl_librefs", FALSE);
        while ((dl_libref = av_pop(dl_librefs)) != &PL_sv_undef) {
           dSP;
           ENTER;
           SAVETMPS;
           PUSHMARK(SP);
           XPUSHs(sv_2mortal(dl_libref));
           PUTBACK;
           call_sv((SV*)sub, G_DISCARD | G_NODEBUG);
           FREETMPS;
           LEAVE;
        }
    }
}
#endif

static void
dl_generic_private_init(pTHX)	/* called by dl_*.xs dl_private_init() */
{
    char *perl_dl_nonlazy;
    MY_CXT_INIT;

    MY_CXT.x_dl_last_error = newSVpvn("", 0);
    dl_nonlazy = 0;
#ifdef DL_LOADONCEONLY
    dl_loaded_files = Nullhv;
#endif
#ifdef DEBUGGING
    {
	SV *sv = get_sv("DynaLoader::dl_debug", 0);
	dl_debug = sv ? SvIV(sv) : 0;
    }
#endif
    if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL )
	dl_nonlazy = atoi(perl_dl_nonlazy);
    if (dl_nonlazy)
	DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n"));
#ifdef DL_LOADONCEONLY
    if (!dl_loaded_files)
	dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */
#endif
#ifdef DL_UNLOAD_ALL_AT_EXIT
    call_atexit(&dl_unload_all_files, (void*)0);
#endif
}


/* SaveError() takes printf style args and saves the result in dl_last_error */
static void
SaveError(pTHX_ const char* pat, ...)
{
    dMY_CXT;
    va_list args;
    SV *msv;
    const char *message;
    STRLEN len;

    /* This code is based on croak/warn, see mess() in util.c */

    va_start(args, pat);
    msv = vmess(pat, &args);
    va_end(args);

    message = SvPV(msv,len);
    len++;		/* include terminating null char */

    /* Copy message into dl_last_error (including terminating null char) */
    sv_setpvn(MY_CXT.x_dl_last_error, message, len) ;
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error));
}


--- NEW FILE: dl_none.xs ---
/* dl_none.xs
 * 
 * Stubs for platforms that do not support dynamic linking
 */

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

MODULE = DynaLoader	PACKAGE = DynaLoader

char *
dl_error()
    CODE:
    RETVAL = "Not implemented";
    OUTPUT:
    RETVAL

# end.

--- NEW FILE: Makefile.PL ---
use ExtUtils::MakeMaker;

WriteMakefile(
    NAME => 'DynaLoader',
    LINKTYPE	=> 'static',
    DEFINE	=> '-DPERL_CORE -DLIBC="$(LIBC)"',
    MAN3PODS 	=> {}, 	# Pods will be built by installman.
    SKIP	=> [qw(dynamic dynamic_lib dynamic_bs)],
    XSPROTOARG => '-noprototypes', 		# XXX remove later?
    VERSION_FROM => 'DynaLoader_pm.PL',
    PL_FILES	=> {'DynaLoader_pm.PL'=>'DynaLoader.pm',
		    'XSLoader_pm.PL'=>'XSLoader.pm'},
    PM		=> {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm',
		    'XSLoader.pm' => '$(INST_LIBDIR)/XSLoader.pm'},
    depend      => {'DynaLoader.o' => 'dlutils.c'},
    clean	=> {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm ' .
			     'XSLoader.pm'},
);

sub MY::postamble {
	'
DynaLoader.xs: $(DLSRC)
	$(RM_F) $@
	$(CP) $? $@

# Perform very simple tests just to check for major gaffs.
# We can\'t do much more for platforms we are not executing on.
test-xs:
	for i in dl_*xs; \
	    do $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSUBPPARGS) $$i > /dev/null; \
	done
';
}


--- NEW FILE: dl_dlopen.xs ---
/* dl_dlopen.xs
 * 
 * Platform:	SunOS/Solaris, possibly others which use dlopen.
 * Author:	Paul Marquess (Paul.Marquess at btinternet.com)
 * Created:	10th July 1994
 *
 * Modified:
 * 15th July 1994     - Added code to explicitly save any error messages.
 * 3rd August 1994    - Upgraded to v3 spec.
 * 9th August 1994    - Changed to use IV
 * 10th August 1994   - Tim Bunce: Added RTLD_LAZY, switchable debugging,
 *                      basic FreeBSD support, removed ClearError
 * 29th Feburary 2000 - Alan Burlison: Added functionality to close dlopen'd
 *                      files when the interpreter exits
 *
 */

/* Porting notes:


   Definition of Sunos dynamic Linking functions
   =============================================
   In order to make this implementation easier to understand here is a
   quick definition of the SunOS Dynamic Linking functions which are
   used here.

   dlopen
   ------
     void *
     dlopen(path, mode)
     char * path; 
     int    mode;

     This function takes the name of a dynamic object file and returns
     a descriptor which can be used by dlsym later. It returns NULL on
     error.

     The mode parameter must be set to 1 for Solaris 1 and to
     RTLD_LAZY (==2) on Solaris 2.


   dlclose
   -------
     int
     dlclose(handle)
     void * handle;

     This function takes the handle returned by a previous invocation of
     dlopen and closes the associated dynamic object file.  It returns zero
     on success, and non-zero on failure.


   dlsym
   ------
     void *
     dlsym(handle, symbol)
     void * handle; 
     char * symbol;

     Takes the handle returned from dlopen and the name of a symbol to
     get the address of. If the symbol was found a pointer is
     returned.  It returns NULL on error. If DL_PREPEND_UNDERSCORE is
     defined an underscore will be added to the start of symbol. This
     is required on some platforms (freebsd).

   dlerror
   ------
     char * dlerror()

     Returns a null-terminated string which describes the last error
     that occurred with either dlopen or dlsym. After each call to
     dlerror the error message will be reset to a null pointer. The
     SaveError function is used to save the error as soon as it happens.


   Return Types
   ============
   In this implementation the two functions, dl_load_file &
   dl_find_symbol, return void *. This is because the underlying SunOS
   dynamic linker calls also return void *.  This is not necessarily
   the case for all architectures. For example, some implementation
   will want to return a char * for dl_load_file.

   If void * is not appropriate for your architecture, you will have to
   change the void * to whatever you require. If you are not certain of
   how Perl handles C data types, I suggest you start by consulting	
   Dean Roerich's Perl 5 API document. Also, have a look in the typemap 
   file (in the ext directory) for a fairly comprehensive list of types 
   that are already supported. If you are completely stuck, I suggest you
   post a message to perl5-porters, comp.lang.perl.misc or if you are really 
   desperate to me.

   Remember when you are making any changes that the return value from 
   dl_load_file is used as a parameter in the dl_find_symbol 
   function. Also the return value from find_symbol is used as a parameter 
   to install_xsub.


   Dealing with Error Messages
   ============================
   In order to make the handling of dynamic linking errors as generic as
   possible you should store any error messages associated with your
   implementation with the StoreError function.

   In the case of SunOS the function dlerror returns the error message 
   associated with the last dynamic link error. As the SunOS dynamic 
   linker functions dlopen & dlsym both return NULL on error every call 
   to a SunOS dynamic link routine is coded like this

	RETVAL = dlopen(filename, 1) ;
	if (RETVAL == NULL)
	    SaveError("%s",dlerror()) ;

   Note that SaveError() takes a printf format string. Use a "%s" as
   the first parameter if the error may contain any % characters.

*/

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

#ifdef I_DLFCN
#include <dlfcn.h>	/* the dynamic linker include file for Sunos/Solaris */
#else
#include <nlist.h>
#include <link.h>
#endif

#ifndef RTLD_LAZY
# define RTLD_LAZY 1	/* Solaris 1 */
#endif

#ifndef HAS_DLERROR
# ifdef __NetBSD__
#  define dlerror() strerror(errno)
# else
#  define dlerror() "Unknown error - dlerror() not implemented"
# endif
#endif


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


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 = RTLD_LAZY;
    void *handle;
  CODE:
{
#if defined(DLOPEN_WONT_DO_RELATIVE_PATHS)
    char pathbuf[PATH_MAX + 2];
    if (*filename != '/' && strchr(filename, '/')) {
	if (getcwd(pathbuf, PATH_MAX - strlen(filename))) {
	    strcat(pathbuf, "/");
	    strcat(pathbuf, filename);
	    filename = pathbuf;
	}
    }
#endif
#ifdef RTLD_NOW
    {
	dMY_CXT;
	if (dl_nonlazy)
	    mode = RTLD_NOW;
    }
#endif
    if (flags & 0x01)
#ifdef RTLD_GLOBAL
	mode |= RTLD_GLOBAL;
#else
	Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
#endif
    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
    handle = dlopen(filename, mode) ;
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) handle));
    ST(0) = sv_newmortal() ;
    if (handle == NULL)
	SaveError(aTHX_ "%s",dlerror()) ;
    else
	sv_setiv( ST(0), PTR2IV(handle));
}


int
dl_unload_file(libref)
    void *	libref
  CODE:
    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
    RETVAL = (dlclose(libref) == 0 ? 1 : 0);
    if (!RETVAL)
        SaveError(aTHX_ "%s", dlerror()) ;
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
  OUTPUT:
    RETVAL


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


void
dl_undef_symbols()
    CODE:



# 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(Perl_debug_log, "dl_install_xsub(name=%s, symref=%"UVxf")\n",
		perl_name, PTR2UV(symref)));
    ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
					DPTR2FPTR(XSUBADDR_t, symref),
					filename)));


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

# end.

--- NEW FILE: dl_aix.xs ---
/* dl_aix.xs
 *
 * Written: 8/31/94 by Wayne Scott (wscott at ichips.intel.com)
 *
 *  All I did was take Jens-Uwe Mager's libdl emulation library for
 *  AIX and merged it with the dl_dlopen.xs file to create a dynamic library
 *  package that works for AIX.
 *
 *  I did change all malloc's, free's, strdup's, calloc's to use the perl
 *  equilvant.  I also removed some stuff we will not need.  Call fini()
 *  on statup...   It can probably be trimmed more.
 */

#define PERLIO_NOT_STDIO 0

/*
 * On AIX 4.3 and above the emulation layer is not needed any more, and
 * indeed if perl uses its emulation and perl is linked into apache
 * which is supposed to use the native dlopen conflicts arise.
 * Jens-Uwe Mager jum at helios.de
 */
#ifdef USE_NATIVE_DLOPEN

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <dlfcn.h>

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

#else

/*
 * @(#)dlfcn.c	1.5 revision of 93/02/14  20:14:17
 * This is an unpublished work copyright (c) 1992 Helios Software GmbH
 * 3000 Hannover 1, Germany
 */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

/* When building as a 64-bit binary on AIX, define this to get the
 * correct structure definitions.  Also determines the field-name
 * macros and gates some logic in readEntries().  -- Steven N. Hirsch
 * <hirschs at btv.ibm.com> */
#ifdef USE_64_BIT_ALL
#   define __XCOFF64__
#   define __XCOFF32__
#endif

#include <stdio.h>
#include <errno.h>
#include <string.h>
#include <stdlib.h>
#include <sys/types.h>
#include <sys/ldr.h>
#include <a.out.h>
#undef FREAD
#undef FWRITE
#include <ldfcn.h>

#ifdef USE_64_BIT_ALL
#   define AIX_SCNHDR SCNHDR_64
#   define AIX_LDHDR LDHDR_64
#   define AIX_LDSYM LDSYM_64
#   define AIX_LDHDRSZ LDHDRSZ_64
#else
#   define AIX_SCNHDR SCNHDR
#   define AIX_LDHDR LDHDR
#   define AIX_LDSYM LDSYM
#   define AIX_LDHDRSZ LDHDRSZ
#endif

/* When using Perl extensions written in C++ the longer versions
 * of load() and unload() from libC and libC_r need to be used,
 * otherwise statics in the extensions won't get initialized right.
 * -- Stephanie Beals <bealzy at us.ibm.com> */

/* Older AIX C compilers cannot deal with C++ double-slash comments in
   the ibmcxx and/or xlC includes.  Since we only need a single file,
   be more fine-grained about what's included <hirschs at btv.ibm.com> */

#ifdef USE_libC /* The define comes, when it comes, from hints/aix.pl. */
#   define LOAD   loadAndInit
#   define UNLOAD terminateAndUnload
#   if defined(USE_vacpp_load_h)
#       include "/usr/vacpp/include/load.h"
#   elif defined(USE_ibmcxx_load_h)
#       include "/usr/ibmcxx/include/load.h"
#   elif defined(USE_xlC_load_h)
#       include "/usr/lpp/xlC/include/load.h"
#   elif defined(USE_load_h)
#       include "/usr/include/load.h"
#   endif
#else
#   define LOAD   load
#   define UNLOAD unload
#endif

/*
 * AIX 4.3 does remove some useful definitions from ldfcn.h. Define
 * these here to compensate for that lossage.
 */
#ifndef BEGINNING
# define BEGINNING SEEK_SET
#endif
#ifndef FSEEK
# define FSEEK(ldptr,o,p)	fseek(IOPTR(ldptr),(p==BEGINNING)?(OFFSET(ldptr) +o):o,p)
#endif
#ifndef FREAD
# define FREAD(p,s,n,ldptr)	fread(p,s,n,IOPTR(ldptr))
#endif

#ifndef RTLD_LAZY
# define RTLD_LAZY 0
#endif
#ifndef RTLD_GLOBAL
# define RTLD_GLOBAL 0
#endif

/*
 * We simulate dlopen() et al. through a call to load. Because AIX has
 * no call to find an exported symbol we read the loader section of the
 * loaded module and build a list of exported symbols and their virtual
 * address.
 */

typedef struct {
	char		*name;		/* the symbols's name */
	void		*addr;		/* its relocated virtual address */
} Export, *ExportPtr;

/*
 * The void * handle returned from dlopen is actually a ModulePtr.
 */
typedef struct Module {
	struct Module	*next;
	char		*name;		/* module name for refcounting */
	int		refCnt;		/* the number of references */
	void		*entry;		/* entry point from load */
	int		nExports;	/* the number of exports found */
	ExportPtr	exports;	/* the array of exports */
} Module, *ModulePtr;

typedef struct {
    /*
     * We keep a list of all loaded modules to be able to reference count
     * duplicate dlopen's.
     */
    ModulePtr	x_modList;

    /*
     * The last error from one of the dl* routines is kept in static
     * variables here. Each error is returned only once to the caller.
     */
    char	x_errbuf[BUFSIZ];
    int		x_errvalid;
    void *	x_mainModule;
} my_cxtx_t;		/* this *must* be named my_cxtx_t */

#define DL_CXT_EXTRA	/* ask for dl_cxtx to be defined in dlutils.c */
#include "dlutils.c"	/* SaveError() etc	*/

#define dl_modList	(dl_cxtx.x_modList)
#define dl_errbuf	(dl_cxtx.x_errbuf)
#define dl_errvalid	(dl_cxtx.x_errvalid)
#define dl_mainModule	(dl_cxtx.x_mainModule)

static void caterr(char *);
static int readExports(ModulePtr);
static void *findMain(void);

/* these statics are ok because they're constants */
static char *strerror_failed   = "(strerror failed)";
static char *strerror_r_failed = "(strerror_r failed)";

char *strerrorcat(char *str, int err) {
    int strsiz = strlen(str);
    int msgsiz;
    char *msg;

#ifdef USE_5005THREADS
    char *buf = malloc(BUFSIZ);

    if (buf == 0)
      return 0;
    if (strerror_r(err, buf, BUFSIZ) == 0)
      msg = buf;
    else
      msg = strerror_r_failed;
    msgsiz = strlen(msg);
    if (strsiz + msgsiz < BUFSIZ)
      strcat(str, msg);
    free(buf);
#else
    dTHX;

    if ((msg = strerror(err)) == 0)
      msg = strerror_failed;
    msgsiz = strlen(msg);		/* Note msg = buf and free() above. */
    if (strsiz + msgsiz < BUFSIZ)	/* Do not move this after #endif. */
      strcat(str, msg);
#endif

    return str;
}

char *strerrorcpy(char *str, int err) {
    int msgsiz;
    char *msg;

#ifdef USE_5005THREADS
    char *buf = malloc(BUFSIZ);

    if (buf == 0)
      return 0;
    if (strerror_r(err, buf, BUFSIZ) == 0)
      msg = buf;
    else
      msg = strerror_r_failed;
    msgsiz = strlen(msg);
    if (msgsiz < BUFSIZ)
      strcpy(str, msg);
    free(buf);
#else
    dTHX;

    if ((msg = strerror(err)) == 0)
      msg = strerror_failed;
    msgsiz = strlen(msg);	/* Note msg = buf and free() above. */
    if (msgsiz < BUFSIZ)	/* Do not move this after #endif. */
      strcpy(str, msg);
#endif

    return str;
}
  
/* ARGSUSED */
void *dlopen(char *path, int mode)
{
	dTHX;
	dMY_CXT;
	register ModulePtr mp;

	/*
	 * Upon the first call register a terminate handler that will
	 * close all libraries.
	 */
	if (dl_mainModule == NULL) {
		if ((dl_mainModule = findMain()) == NULL)
			return NULL;
	}
	/*
	 * Scan the list of modules if have the module already loaded.
	 */
	for (mp = dl_modList; mp; mp = mp->next)
		if (strcmp(mp->name, path) == 0) {
			mp->refCnt++;
			return mp;
		}
	Newxz(mp,1,Module);
	if (mp == NULL) {
		dl_errvalid++;
		strcpy(dl_errbuf, "Newz: ");
		strerrorcat(dl_errbuf, errno);
		return NULL;
	}
	
	if ((mp->name = savepv(path)) == NULL) {
		dl_errvalid++;
		strcpy(dl_errbuf, "savepv: ");
		strerrorcat(dl_errbuf, errno);
		safefree(mp);
		return NULL;
	}

	/*
	 * load should be declared load(const char *...). Thus we
	 * cast the path to a normal char *. Ugly.
	 */
	if ((mp->entry = (void *)LOAD((char *)path,
#ifdef L_LIBPATH_EXEC
				      L_LIBPATH_EXEC |
#endif
				      L_NOAUTODEFER,
				      NULL)) == NULL) {
	        int saverrno = errno;
		
		safefree(mp->name);
		safefree(mp);
		dl_errvalid++;
		strcpy(dl_errbuf, "dlopen: ");
		strcat(dl_errbuf, path);
		strcat(dl_errbuf, ": ");
		/*
		 * If AIX says the file is not executable, the error
		 * can be further described by querying the loader about
		 * the last error.
		 */
		if (saverrno == ENOEXEC) {
			char *moreinfo[BUFSIZ/sizeof(char *)];
			if (loadquery(L_GETMESSAGES, moreinfo, sizeof(moreinfo)) == -1)
				strerrorcpy(dl_errbuf, saverrno);
			else {
				char **p;
				for (p = moreinfo; *p; p++)
					caterr(*p);
			}
		} else
			strerrorcat(dl_errbuf, saverrno);
		return NULL;
	}
	mp->refCnt = 1;
	mp->next = dl_modList;
	dl_modList = mp;
	/*
	 * Assume anonymous exports come from the module this dlopen
	 * is linked into, that holds true as long as dlopen and all
	 * of the perl core are in the same shared object. Also bind
	 * against the main part, in the case a perl is not the main
	 * part, e.g mod_perl as DSO in Apache so perl modules can
	 * also reference Apache symbols.
	 */
	if (loadbind(0, (void *)dlopen, mp->entry) == -1 ||
	    loadbind(0, dl_mainModule, mp->entry)) {
	        int saverrno = errno;

		dlclose(mp);
		dl_errvalid++;
		strcpy(dl_errbuf, "loadbind: ");
		strerrorcat(dl_errbuf, saverrno);
		return NULL;
	}
	if (readExports(mp) == -1) {
		dlclose(mp);
		return NULL;
	}
	return mp;
}

/*
 * Attempt to decipher an AIX loader error message and append it
 * to our static error message buffer.
 */
static void caterr(char *s)
{
	dTHX;
	dMY_CXT;
	register char *p = s;

	while (*p >= '0' && *p <= '9')
		p++;
	switch(atoi(s)) {
	case L_ERROR_TOOMANY:
		strcat(dl_errbuf, "too many errors");
		break;
	case L_ERROR_NOLIB:
		strcat(dl_errbuf, "can't load library");
		strcat(dl_errbuf, p);
		break;
	case L_ERROR_UNDEF:
		strcat(dl_errbuf, "can't find symbol");
		strcat(dl_errbuf, p);
		break;
	case L_ERROR_RLDBAD:
		strcat(dl_errbuf, "bad RLD");
		strcat(dl_errbuf, p);
		break;
	case L_ERROR_FORMAT:
		strcat(dl_errbuf, "bad exec format in");
		strcat(dl_errbuf, p);
		break;
	case L_ERROR_ERRNO:
		strerrorcat(dl_errbuf, atoi(++p));
		break;
	default:
		strcat(dl_errbuf, s);
		break;
	}
}

void *dlsym(void *handle, const char *symbol)
{
	dTHX;
	dMY_CXT;
	register ModulePtr mp = (ModulePtr)handle;
	register ExportPtr ep;
	register int i;

	/*
	 * Could speed up search, but I assume that one assigns
	 * the result to function pointers anyways.
	 */
	for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
		if (strcmp(ep->name, symbol) == 0)
			return ep->addr;
	dl_errvalid++;
	strcpy(dl_errbuf, "dlsym: undefined symbol ");
	strcat(dl_errbuf, symbol);
	return NULL;
}

char *dlerror(void)
{
	dTHX;
	dMY_CXT;
	if (dl_errvalid) {
		dl_errvalid = 0;
		return dl_errbuf;
	}
	return NULL;
}

int dlclose(void *handle)
{
	dTHX;
	dMY_CXT;
	register ModulePtr mp = (ModulePtr)handle;
	int result;
	register ModulePtr mp1;

	if (--mp->refCnt > 0)
		return 0;
	result = UNLOAD(mp->entry);
	if (result == -1) {
		dl_errvalid++;
		strerrorcpy(dl_errbuf, errno);
	}
	if (mp->exports) {
		register ExportPtr ep;
		register int i;
		for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
			if (ep->name)
				safefree(ep->name);
		safefree(mp->exports);
	}
	if (mp == dl_modList)
		dl_modList = mp->next;
	else {
		for (mp1 = dl_modList; mp1; mp1 = mp1->next)
			if (mp1->next == mp) {
				mp1->next = mp->next;
				break;
			}
	}
	safefree(mp->name);
	safefree(mp);
	return result;
}

/* Added by Wayne Scott 
 * This is needed because the ldopen system call calls
 * calloc to allocated a block of date.  The ldclose call calls free.
 * Without this we get this system calloc and perl's free, resulting
 * in a "Bad free" message.  This way we always use perl's malloc.
 */
void *calloc(size_t ne, size_t sz) 
{
  void *out;

  out = (void *) safemalloc(ne*sz);
  memzero(out, ne*sz);
  return(out);
}
 
/*
 * Build the export table from the XCOFF .loader section.
 */
static int readExports(ModulePtr mp)
{
	dTHX;
	dMY_CXT;
	LDFILE *ldp = NULL;
	AIX_SCNHDR sh;
	AIX_LDHDR *lhp;
	char *ldbuf;
	AIX_LDSYM *ls;
	int i;
	ExportPtr ep;

	if ((ldp = ldopen(mp->name, ldp)) == NULL) {
		struct ld_info *lp;
		char *buf;
		int size = 4*1024;
		if (errno != ENOENT) {
			dl_errvalid++;
			strcpy(dl_errbuf, "readExports: ");
			strerrorcat(dl_errbuf, errno);
			return -1;
		}
		/*
		 * The module might be loaded due to the LIBPATH
		 * environment variable. Search for the loaded
		 * module using L_GETINFO.
		 */
		if ((buf = safemalloc(size)) == NULL) {
			dl_errvalid++;
			strcpy(dl_errbuf, "readExports: ");
			strerrorcat(dl_errbuf, errno);
			return -1;
		}
		while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
			safefree(buf);
			size += 4*1024;
			if ((buf = safemalloc(size)) == NULL) {
				dl_errvalid++;
				strcpy(dl_errbuf, "readExports: ");
				strerrorcat(dl_errbuf, errno);
				return -1;
			}
		}
		if (i == -1) {
			dl_errvalid++;
			strcpy(dl_errbuf, "readExports: ");
			strerrorcat(dl_errbuf, errno);
			safefree(buf);
			return -1;
		}
		/*
		 * Traverse the list of loaded modules. The entry point
		 * returned by LOAD() does actually point to the data
		 * segment origin.
		 */
		lp = (struct ld_info *)buf;
		while (lp) {
			if (lp->ldinfo_dataorg == mp->entry) {
				ldp = ldopen(lp->ldinfo_filename, ldp);
				break;
			}
			if (lp->ldinfo_next == 0)
				lp = NULL;
			else
				lp = (struct ld_info *)((char *)lp + lp->ldinfo_next);
		}
		safefree(buf);
		if (!ldp) {
			dl_errvalid++;
			strcpy(dl_errbuf, "readExports: ");
			strerrorcat(dl_errbuf, errno);
			return -1;
		}
	}
#ifdef USE_64_BIT_ALL
	if (TYPE(ldp) != U803XTOCMAGIC) {
#else
	if (TYPE(ldp) != U802TOCMAGIC) {
#endif
		dl_errvalid++;
		strcpy(dl_errbuf, "readExports: bad magic");
		while(ldclose(ldp) == FAILURE)
			;
		return -1;
	}
	if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) {
		dl_errvalid++;
		strcpy(dl_errbuf, "readExports: cannot read loader section header");
		while(ldclose(ldp) == FAILURE)
			;
		return -1;
	}
	/*
	 * We read the complete loader section in one chunk, this makes
	 * finding long symbol names residing in the string table easier.
	 */
	if ((ldbuf = (char *)safemalloc(sh.s_size)) == NULL) {
		dl_errvalid++;
		strcpy(dl_errbuf, "readExports: ");
		strerrorcat(dl_errbuf, errno);
		while(ldclose(ldp) == FAILURE)
			;
		return -1;
	}
	if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) {
		dl_errvalid++;
		strcpy(dl_errbuf, "readExports: cannot seek to loader section");
		safefree(ldbuf);
		while(ldclose(ldp) == FAILURE)
			;
		return -1;
	}
/* This first case is a hack, since it assumes that the 3rd parameter to
   FREAD is 1. See the redefinition of FREAD above to see how this works. */
	if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) {
		dl_errvalid++;
		strcpy(dl_errbuf, "readExports: cannot read loader section");
		safefree(ldbuf);
		while(ldclose(ldp) == FAILURE)
			;
		return -1;
	}
	lhp = (AIX_LDHDR *)ldbuf;
	ls = (AIX_LDSYM *)(ldbuf+AIX_LDHDRSZ);
	/*
	 * Count the number of exports to include in our export table.
	 */
	for (i = lhp->l_nsyms; i; i--, ls++) {
		if (!LDR_EXPORT(*ls))
			continue;
		mp->nExports++;
	}
	Newxz(mp->exports, mp->nExports, Export);
	if (mp->exports == NULL) {
		dl_errvalid++;
		strcpy(dl_errbuf, "readExports: ");
		strerrorcat(dl_errbuf, errno);
		safefree(ldbuf);
		while(ldclose(ldp) == FAILURE)
			;
		return -1;
	}
	/*
	 * Fill in the export table. All entries are relative to
	 * the entry point we got from load.
	 */
	ep = mp->exports;
	ls = (AIX_LDSYM *)(ldbuf+AIX_LDHDRSZ);
	for (i = lhp->l_nsyms; i; i--, ls++) {
		char *symname;
		if (!LDR_EXPORT(*ls))
			continue;
#ifndef USE_64_BIT_ALL
		if (ls->l_zeroes == 0)
#endif
			symname = ls->l_offset+lhp->l_stoff+ldbuf;
#ifndef USE_64_BIT_ALL
		else
			symname = ls->l_name;
#endif
		ep->name = savepv(symname);
		ep->addr = (void *)((unsigned long)mp->entry + ls->l_value);
		ep++;
	}
	safefree(ldbuf);
	while(ldclose(ldp) == FAILURE)
		;
	return 0;
}

/*
 * Find the main modules entry point. This is used as export pointer
 * for loadbind() to be able to resolve references to the main part.
 */
static void * findMain(void)
{
	dTHX;
	dMY_CXT;
	struct ld_info *lp;
	char *buf;
	int size = 4*1024;
	int i;
	void *ret;

	if ((buf = safemalloc(size)) == NULL) {
		dl_errvalid++;
		strcpy(dl_errbuf, "findMain: ");
		strerrorcat(dl_errbuf, errno);
		return NULL;
	}
	while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
		safefree(buf);
		size += 4*1024;
		if ((buf = safemalloc(size)) == NULL) {
			dl_errvalid++;
			strcpy(dl_errbuf, "findMain: ");
			strerrorcat(dl_errbuf, errno);
			return NULL;
		}
	}
	if (i == -1) {
		dl_errvalid++;
		strcpy(dl_errbuf, "findMain: ");
		strerrorcat(dl_errbuf, errno);
		safefree(buf);
		return NULL;
	}
	/*
	 * The first entry is the main module. The entry point
	 * returned by load() does actually point to the data
	 * segment origin.
	 */
	lp = (struct ld_info *)buf;
	ret = lp->ldinfo_dataorg;
	safefree(buf);
	return ret;
}
#endif /* USE_NATIVE_DLOPEN */

/* dl_dlopen.xs
 * 
 * Platform:	SunOS/Solaris, possibly others which use dlopen.
 * Author:	Paul Marquess (Paul.Marquess at btinternet.com)
 * Created:	10th July 1994
 *
 * Modified:
 * 15th July 1994   - Added code to explicitly save any error messages.
 * 3rd August 1994  - Upgraded to v3 spec.
 * 9th August 1994  - Changed to use IV
 * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging,
 *                    basic FreeBSD support, removed ClearError
 *
 */

/* Porting notes:

	see dl_dlopen.xs

*/

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
	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, RTLD_GLOBAL|RTLD_LAZY) ;
	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) );

int
dl_unload_file(libref)
    void *	libref
  CODE:
    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", libref));
    RETVAL = (dlclose(libref) == 0 ? 1 : 0);
    if (!RETVAL)
        SaveError(aTHX_ "%s", dlerror()) ;
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
  OUTPUT:
    RETVAL

void *
dl_find_symbol(libhandle, symbolname)
	void *		libhandle
	char *		symbolname
	CODE:
	DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n",
		libhandle, symbolname));
	RETVAL = dlsym(libhandle, symbolname);
	DLDEBUG(2,PerlIO_printf(Perl_debug_log, "  symbolref = %x\n", 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 
    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(perl_name,
					(void(*)(pTHX_ CV *))symref,
					filename)));


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

# end.

--- NEW FILE: dl_dllload.xs ---
/* dl_dllload.xs
 *
 * Platform:	OS/390, possibly others that use dllload(),dllfree() (VM/ESA?).
 * Authors:	John Goodyear && Peter Prymmer
 * Created:     28 October 2000
 * Modified:
 * 16 January 2001 - based loosely on dl_dlopen.xs.
 */
 
/* Porting notes:

   OS/390 Dynamic Loading functions: 

   dllload
   -------
     dllhandle * dllload(const char *dllName)

     This function takes the name of a dynamic object file and returns
     a descriptor which can be used by dlllqueryfn() and/or dllqueryvar() 
     later.  If dllName contains a slash, it is used to locate the dll.
     If not then the LIBPATH environment variable is used to
     search for the requested dll (at least within the HFS).
     It returns NULL on error and sets errno.

   dllfree
   -------
     int dllfree(dllhandle *handle);

     dllfree() decrements the load count for the dll and frees
     it if the count is 0.  It returns zero on success, and 
     non-zero on failure.

   dllqueryfn && dllqueryvar
   -------------------------
     void (* dllqueryfn(dllhandle *handle, const char *function))();
     void * dllqueryvar(dllhandle *handle, const char *symbol);

     dllqueryfn() takes the handle returned from dllload() and the name 
     of a function to get the address of.  If the function was found 
     a pointer is returned, otherwise NULL is returned.

     dllqueryvar() takes the handle returned from dllload() and the name 
     of a symbol to get the address of.  If the variable was found a 
     pointer is returned, otherwise NULL is returned.

     The XS dl_find_symbol() first calls dllqueryfn().  If it fails
     dlqueryvar() is then called.

   strerror
   --------
     char * strerror(int errno)

     Returns a null-terminated string which describes the last error
     that occurred with other functions (not necessarily unique to
     dll loading).

   Return Types
   ============
   In this implementation the two functions, dl_load_file() &&
   dl_find_symbol(), return (void *).  This is primarily because the 
   dlopen() && dlsym() style dynamic linker calls return (void *).
   We suspect that casting to (void *) may be easier than teaching XS
   typemaps about the (dllhandle *) type.

   Dealing with Error Messages
   ===========================
   In order to make the handling of dynamic linking errors as generic as
   possible you should store any error messages associated with your
   implementation with the StoreError function.

   In the case of OS/390 the function strerror(errno) returns the error 
   message associated with the last dynamic link error.  As the S/390 
   dynamic linker functions dllload() && dllqueryvar() both return NULL 
   on error every call to an S/390 dynamic link routine is coded 
   like this:

	RETVAL = dllload(filename) ;
	if (RETVAL == NULL)
	    SaveError("%s",strerror(errno)) ;

   Note that SaveError() takes a printf format string. Use a "%s" as
   the first parameter if the error may contain any % characters.

   Other comments within the dl_dlopen.xs file may be helpful as well.
*/

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

#include <dll.h>	/* the dynamic linker include file for S/390 */
#include <errno.h>	/* strerror() and friends */

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

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 = 0;
  CODE:
{
    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
    /* add a (void *) dllload(filename) ; cast if needed */
    RETVAL = dllload(filename) ;
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
    ST(0) = sv_newmortal() ;
    if (RETVAL == NULL)
	SaveError(aTHX_ "%s",strerror(errno)) ;
    else
	sv_setiv( ST(0), PTR2IV(RETVAL));
}


int
dl_unload_file(libref)
    void *	libref
  CODE:
    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
    /* RETVAL = (dllfree((dllhandle *)libref) == 0 ? 1 : 0); */
    RETVAL = (dllfree(libref) == 0 ? 1 : 0);
    if (!RETVAL)
        SaveError(aTHX_ "%s", strerror(errno)) ;
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
  OUTPUT:
    RETVAL


void *
dl_find_symbol(libhandle, symbolname)
    void *	libhandle
    char *	symbolname
    CODE:
    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
			     "dl_find_symbol(handle=%lx, symbol=%s)\n",
			     (unsigned long) libhandle, symbolname));
    if((RETVAL = (void*)dllqueryfn(libhandle, symbolname)) == NULL)
    RETVAL = dllqueryvar(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",strerror(errno)) ;
    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 
    char *		filename
    CODE:
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
		perl_name, (unsigned long) symref));
    ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
					(void(*)(pTHX_ CV *))symref,
					filename)));


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

# end.

--- NEW FILE: dl_vms.xs ---
/* dl_vms.xs
 * 
 * Platform:  OpenVMS, VAX or AXP
 * Author:    Charles Bailey  bailey at newman.upenn.edu
 * Revised:   12-Dec-1994
 *
 *                           Implementation Note
 *     This section is added as an aid to users and DynaLoader developers, in
 * order to clarify the process of dynamic linking under VMS.
 *     dl_vms.xs uses the supported VMS dynamic linking call, which allows
 * a running program to map an arbitrary file of executable code and call
 * routines within that file.  This is done via the VMS RTL routine
 * lib$find_image_symbol, whose calling sequence is as follows:
 *   status = lib$find_image_symbol(imgname,symname,symval,defspec);
 *   where
 *     status  = a standard VMS status value (unsigned long int)
 *     imgname = a fixed-length string descriptor, passed by
 *               reference, containing the NAME ONLY of the image
 *               file to be mapped.  An attempt will be made to
 *               translate this string as a logical name, so it may
 *               not contain any characters which are not allowed in
 *               logical names.  If no translation is found, imgname
 *               is used directly as the name of the image file.
 *     symname = a fixed-length string descriptor, passed by
 *               reference, containing the name of the routine
 *               to be located.
 *     symval  = an unsigned long int, passed by reference, into
 *               which is written the entry point address of the
 *               routine whose name is specified in symname.
 *     defspec = a fixed-length string descriptor, passed by
 *               reference, containing a default file specification
 *               whichis used to fill in any missing parts of the
 *               image file specification after the imgname argument
 *               is processed.
 * In order to accommodate the handling of the imgname argument, the routine
 * dl_expandspec() is provided for use by perl code (e.g. dl_findfile)
 * which wants to see what image file lib$find_image_symbol would use if
 * it were passed a given file specification.  The file specification passed
 * to dl_expandspec() and dl_load_file() can be partial or complete, and can
 * use VMS or Unix syntax; these routines perform the necessary conversions.
 *    In general, writers of perl extensions need only conform to the
 * procedures set out in the DynaLoader documentation, and let the details
 * be taken care of by the routines here and in DynaLoader.pm.  If anyone
 * comes across any incompatibilities, please let me know.  Thanks.
 *
 */

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

/* N.B.:
 * dl_debug and dl_last_error are static vars; you'll need to deal
 * with them appropriately if you need context independence
 */

#include <descrip.h>
#include <fscndef.h>
#include <lib$routines.h>
#include <rms.h>
#include <ssdef.h>
#include <starlet.h>

#if defined(VMS_WE_ARE_CASE_SENSITIVE)
#define DL_CASE_SENSITIVE 1<<4
#else
#define DL_CASE_SENSITIVE 0
#endif

typedef unsigned long int vmssts;

struct libref {
  struct dsc$descriptor_s name;
  struct dsc$descriptor_s defspec;
};

typedef struct {
    AV *	x_require_symbols;
/* "Static" data for dl_expand_filespec() - This is static to save
 * initialization on each call; if you need context-independence,
 * just make these auto variables in dl_expandspec() and dl_load_file()
 */
    char	x_esa[NAM$C_MAXRSS];
    char	x_rsa[NAM$C_MAXRSS];
    struct FAB	x_fab;
    struct NAM	x_nam;
} my_cxtx_t;		/* this *must* be named my_cxtx_t */

#define DL_CXT_EXTRA	/* ask for dl_cxtx to be defined in dlutils.c */
#include "dlutils.c"    /* dl_debug, dl_last_error; SaveError not used  */

#define dl_require_symbols	(dl_cxtx.x_require_symbols)
#define dl_esa			(dl_cxtx.x_esa)
#define dl_rsa			(dl_cxtx.x_rsa)
#define dl_fab			(dl_cxtx.x_fab)
#define dl_nam			(dl_cxtx.x_nam)

/* $PutMsg action routine - records error message in dl_last_error */
static vmssts
copy_errmsg(msg,unused)
    struct dsc$descriptor_s *   msg;
    vmssts  unused;
{
    dTHX;
    dMY_CXT;
    if (*(msg->dsc$a_pointer) == '%') { /* first line */
      if (dl_last_error)
        strncpy((dl_last_error = saferealloc(dl_last_error,msg->dsc$w_length+1)),
                 msg->dsc$a_pointer, msg->dsc$w_length);
      else
        strncpy((dl_last_error = safemalloc(msg->dsc$w_length+1)),
                 msg->dsc$a_pointer, msg->dsc$w_length);
      dl_last_error[msg->dsc$w_length] = '\0';
    }
    else { /* continuation line */
      int errlen = strlen(dl_last_error);
      dl_last_error = saferealloc(dl_last_error, errlen + msg->dsc$w_length + 2);
      dl_last_error[errlen] = '\n';  dl_last_error[errlen+1] = '\0';
      strncat(dl_last_error, msg->dsc$a_pointer, msg->dsc$w_length);
      dl_last_error[errlen+msg->dsc$w_length+1] = '\0';
    }
    return 0;
}

/* Use $PutMsg to retrieve error message for failure status code */
static void
dl_set_error(sts,stv)
    vmssts  sts;
    vmssts  stv;
{
    vmssts vec[3];
    dTHX;

    vec[0] = stv ? 2 : 1;
    vec[1] = sts;  vec[2] = stv;
    _ckvmssts(sys$putmsg(vec,copy_errmsg,0,0));
}

static unsigned int
findsym_handler(void *sig, void *mech)
{
    dTHX;
    unsigned long int myvec[8],args, *usig = (unsigned long int *) sig;
    /* Be paranoid and assume signal vector passed in might be readonly */
    myvec[0] = args = usig[0] > 10 ? 9 : usig[0] - 1;
    while (--args) myvec[args] = usig[args];
    _ckvmssts(sys$putmsg(myvec,copy_errmsg,0,0));
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "findsym_handler: received\n\t%s\n",dl_last_error));
    return SS$_CONTINUE;
}

/* wrapper for lib$find_image_symbol, so signalled errors can be saved
 * for dl_error and then returned */
static unsigned long int
my_find_image_symbol(struct dsc$descriptor_s *imgname,
                     struct dsc$descriptor_s *symname,
                     void (**entry)(),
                     struct dsc$descriptor_s *defspec)
{
  unsigned long int retsts;
  VAXC$ESTABLISH(findsym_handler);
  retsts = lib$find_image_symbol(imgname,symname,entry,defspec,DL_CASE_SENSITIVE);
  return retsts;
}


static void
dl_private_init(pTHX)
{
    dl_generic_private_init(aTHX);
    {
	dMY_CXT;
	dl_require_symbols = get_av("DynaLoader::dl_require_symbols", 0x4);
	/* Set up the static control blocks for dl_expand_filespec() */
	dl_fab = cc$rms_fab;
	dl_nam = cc$rms_nam;
	dl_fab.fab$l_nam = &dl_nam;
	dl_nam.nam$l_esa = dl_esa;
	dl_nam.nam$b_ess = sizeof dl_esa;
	dl_nam.nam$l_rsa = dl_rsa;
	dl_nam.nam$b_rss = sizeof dl_rsa;
    }
}
MODULE = DynaLoader PACKAGE = DynaLoader

BOOT:
    (void)dl_private_init(aTHX);

void
dl_expandspec(filespec)
    char *	filespec
    CODE:
    char vmsspec[NAM$C_MAXRSS], defspec[NAM$C_MAXRSS];
    size_t deflen;
    vmssts sts;
    dMY_CXT;

    tovmsspec(filespec,vmsspec);
    dl_fab.fab$l_fna = vmsspec;
    dl_fab.fab$b_fns = strlen(vmsspec);
    dl_fab.fab$l_dna = 0;
    dl_fab.fab$b_dns = 0;
    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_expand_filespec(%s):\n",vmsspec));
    /* On the first pass, just parse the specification string */
    dl_nam.nam$b_nop = NAM$M_SYNCHK;
    sts = sys$parse(&dl_fab);
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tSYNCHK sys$parse = %d\n",sts));
    if (!(sts & 1)) {
      dl_set_error(dl_fab.fab$l_sts,dl_fab.fab$l_stv);
      ST(0) = &PL_sv_undef;
    }
    else {
      /* Now set up a default spec - everything but the name */
      deflen = dl_nam.nam$l_name - dl_esa;
      memcpy(defspec,dl_esa,deflen);
      memcpy(defspec+deflen,dl_nam.nam$l_type,
             dl_nam.nam$b_type + dl_nam.nam$b_ver);
      deflen += dl_nam.nam$b_type + dl_nam.nam$b_ver;
      memcpy(vmsspec,dl_nam.nam$l_name,dl_nam.nam$b_name);
      DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsplit filespec: name = %.*s, default = %.*s\n",
                        dl_nam.nam$b_name,vmsspec,deflen,defspec));
      /* . . . and go back to expand it */
      dl_nam.nam$b_nop = 0;
      dl_fab.fab$l_dna = defspec;
      dl_fab.fab$b_dns = deflen;
      dl_fab.fab$b_fns = dl_nam.nam$b_name;
      sts = sys$parse(&dl_fab);
      DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tname/default sys$parse = %d\n",sts));
      if (!(sts & 1)) {
        dl_set_error(dl_fab.fab$l_sts,dl_fab.fab$l_stv);
        ST(0) = &PL_sv_undef;
      }
      else {
        /* Now find the actual file */
        sts = sys$search(&dl_fab);
        DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsys$search = %d\n",sts));
        if (!(sts & 1)) {
          dl_set_error(dl_fab.fab$l_sts,dl_fab.fab$l_stv);
          ST(0) = &PL_sv_undef;
        }
        else {
          ST(0) = sv_2mortal(newSVpvn(dl_nam.nam$l_rsa,dl_nam.nam$b_rsl));
          DLDEBUG(1,PerlIO_printf(Perl_debug_log, "\tresult = \\%.*s\\\n",
                            dl_nam.nam$b_rsl,dl_nam.nam$l_rsa));
        }
      }
    }

void
dl_load_file(filespec, flags)
    char *	filespec
    int		flags
    PREINIT:
    dTHX;
    dMY_CXT;
    char vmsspec[NAM$C_MAXRSS];
    SV *reqSV, **reqSVhndl;
    STRLEN deflen;
    struct dsc$descriptor_s
      specdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0},
      symdsc  = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
    struct fscnlst {
      unsigned short int len;
      unsigned short int code;
      char *string;
    }  namlst[2] = {{0,FSCN$_NAME,0},{0,0,0}};
    struct libref *dlptr;
    vmssts sts, failed = 0;
    void (*entry)();
    CODE:

    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filespec,flags));
    specdsc.dsc$a_pointer = tovmsspec(filespec,vmsspec);
    specdsc.dsc$w_length = strlen(specdsc.dsc$a_pointer);
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tVMS-ified filespec is %s\n",
                      specdsc.dsc$a_pointer));
    Newx(dlptr,1,struct libref);
    dlptr->name.dsc$b_dtype = dlptr->defspec.dsc$b_dtype = DSC$K_DTYPE_T;
    dlptr->name.dsc$b_class = dlptr->defspec.dsc$b_class = DSC$K_CLASS_S;
    sts = sys$filescan(&specdsc,namlst,0);
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsys$filescan: returns %d, name is %.*s\n",
                      sts,namlst[0].len,namlst[0].string));
    if (!(sts & 1)) {
      failed = 1;
      dl_set_error(sts,0);
    }
    else {
      dlptr->name.dsc$w_length = namlst[0].len;
      dlptr->name.dsc$a_pointer = savepvn(namlst[0].string,namlst[0].len);
      dlptr->defspec.dsc$w_length = specdsc.dsc$w_length - namlst[0].len;
      Newx(dlptr->defspec.dsc$a_pointer, dlptr->defspec.dsc$w_length + 1, char);
      deflen = namlst[0].string - specdsc.dsc$a_pointer; 
      memcpy(dlptr->defspec.dsc$a_pointer,specdsc.dsc$a_pointer,deflen);
      memcpy(dlptr->defspec.dsc$a_pointer + deflen,
             namlst[0].string + namlst[0].len,
             dlptr->defspec.dsc$w_length - deflen);
      DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tlibref = name: %s, defspec: %.*s\n",
                        dlptr->name.dsc$a_pointer,
                        dlptr->defspec.dsc$w_length,
                        dlptr->defspec.dsc$a_pointer));
      if (!(reqSVhndl = av_fetch(dl_require_symbols,0,FALSE)) || !(reqSV = *reqSVhndl)) {
        DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\t at dl_require_symbols empty, returning untested libref\n"));
      }
      else {
        symdsc.dsc$w_length = SvCUR(reqSV);
        symdsc.dsc$a_pointer = SvPVX(reqSV);
        DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\t$dl_require_symbols[0] = %.*s\n",
                          symdsc.dsc$w_length, symdsc.dsc$a_pointer));
        sts = my_find_image_symbol(&(dlptr->name),&symdsc,
                                    &entry,&(dlptr->defspec));
        DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tlib$find_image_symbol returns %d\n",sts));
        if (!(sts&1)) {
          failed = 1;
          dl_set_error(sts,0);
        }
      }
    }

    if (failed) {
      Safefree(dlptr->name.dsc$a_pointer);
      Safefree(dlptr->defspec.dsc$a_pointer);
      Safefree(dlptr);
      ST(0) = &PL_sv_undef;
    }
    else {
      ST(0) = sv_2mortal(newSViv(PTR2IV(dlptr)));
    }


void
dl_find_symbol(librefptr,symname)
    void *	librefptr
    SV *	symname
    CODE:
    struct libref thislib = *((struct libref *)librefptr);
    struct dsc$descriptor_s
      symdsc = {SvCUR(symname),DSC$K_DTYPE_T,DSC$K_CLASS_S,SvPVX(symname)};
    void (*entry)();
    vmssts sts;

    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_find_dymbol(%.*s,%.*s):\n",
                      thislib.name.dsc$w_length, thislib.name.dsc$a_pointer,
                      symdsc.dsc$w_length,symdsc.dsc$a_pointer));
    sts = my_find_image_symbol(&(thislib.name),&symdsc,
                               &entry,&(thislib.defspec));
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tlib$find_image_symbol returns %d\n",sts));
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tentry point is %d\n",
                      (unsigned long int) entry));
    if (!(sts & 1)) {
      /* error message already saved by findsym_handler */
      ST(0) = &PL_sv_undef;
    }
    else ST(0) = sv_2mortal(newSViv(PTR2IV(entry)));


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(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
        perl_name, symref));
    ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
				      (void(*)(pTHX_ CV *))symref,
				      filename)));


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

# end.

--- NEW FILE: DynaLoader_pm.PL ---
use Config;

sub to_string {
    my ($value) = @_;
    $value =~ s/\\/\\\\/g;
    $value =~ s/'/\\'/g;
    return "'$value'";
}

unlink "DynaLoader.pm" if -f "DynaLoader.pm";
open OUT, ">DynaLoader.pm" or die $!;
print OUT <<'EOT';

# Generated from DynaLoader.pm.PL

package DynaLoader;

#   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.'

#   (Quote from Tolkien suggested by Anno Siegel.)
#
# See pod text at end of file for documentation.
# See also ext/DynaLoader/README in source tree for other information.
#
# Tim.Bunce at ig.co.uk, August 1994

use vars qw($VERSION *AUTOLOAD);

$VERSION = '1.05';	# avoid typo warning

require AutoLoader;
*AUTOLOAD = \&AutoLoader::AUTOLOAD;

use Config;

# The following require can't be removed during maintenance
# releases, sadly, because of the risk of buggy code that does 
# require Carp; Carp::croak "..."; without brackets dying 
# if Carp hasn't been loaded in earlier compile time. :-( 
# We'll let those bugs get found on the development track.
require Carp if $] < 5.00450; 

# enable debug/trace messages from DynaLoader perl code
$dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;

#
# Flags to alter dl_load_file behaviour.  Assigned bits:
#   0x01  make symbols available for linking later dl_load_file's.
#         (only known to work on Solaris 2 using dlopen(RTLD_GLOBAL))
#         (ignored under VMS; effect is built-in to image linking)
#
# This is called as a class method $module->dl_load_flags.  The
# definition here will be inherited and result on "default" loading
# behaviour unless a sub-class of DynaLoader defines its own version.
#

sub dl_load_flags { 0x00 }

# ($dl_dlext, $dlsrc)
#         = @Config::Config{'dlext', 'dlsrc'};
EOT

print OUT "  (\$dl_dlext, \$dlsrc) = (",
          to_string($Config::Config{'dlext'}), ",",
          to_string($Config::Config{'dlsrc'}), ")\n;" ;

print OUT <<'EOT';

# Some systems need special handling to expand file specifications
# (VMS support by Charles Bailey <bailey at HMIVAX.HUMGEN.UPENN.EDU>)
# See dl_expandspec() for more details. Should be harmless but
# inefficient to define on systems that don't need it.
$Is_VMS    = $^O eq 'VMS';
$do_expand = $Is_VMS;
$Is_MacOS  = $^O eq 'MacOS';

my $Mac_FS;
$Mac_FS = eval { require Mac::FileSpec::Unixish } if $Is_MacOS;

@dl_require_symbols = ();       # names of symbols we need
@dl_resolve_using   = ();       # names of files to link with
@dl_library_path    = ();       # path to look for files

#XSLoader.pm may have added elements before we were required
#@dl_shared_objects  = ();       # shared objects for symbols we have 
#@dl_librefs         = ();       # things we have loaded
#@dl_modules         = ();       # Modules we have loaded

# This is a fix to support DLD's unfortunate desire to relink -lc
@dl_resolve_using = dl_findfile('-lc') if $dlsrc eq "dl_dld.xs";

EOT

my $cfg_dl_library_path = <<'EOT';
push(@dl_library_path, split(' ', $Config::Config{libpth}));
EOT

sub dquoted_comma_list {
    join(", ", map {qq("$_")} @_);
}

if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) {
    eval $cfg_dl_library_path;
    if (!$ENV{PERL_BUILD_EXPAND_ENV_VARS}) {
        my $dl_library_path = dquoted_comma_list(@dl_library_path);
        print OUT <<EOT;
# The below \@dl_library_path has been expanded (%Config) in Perl build time.

\@dl_library_path = ($dl_library_path);

EOT
    }
}
else {
    print OUT <<EOT;
# Initialise \@dl_library_path with the 'standard' library path
# for this platform as determined by Configure.

$cfg_dl_library_path

EOT
}

my $ldlibpthname;
my $ldlibpthname_defined;
my $pthsep;

if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS}) {
    $ldlibpthname         = $Config::Config{ldlibpthname};
    $ldlibpthname_defined = defined $Config::Config{ldlibpthname} ? 1 : 0;
    $pthsep               = $Config::Config{path_sep};
}
else {
    $ldlibpthname         = q($Config::Config{ldlibpthname});
    $ldlibpthname_defined = q(defined $Config::Config{ldlibpthname});
    $pthsep               = q($Config::Config{path_sep});
    print OUT <<EOT;
my \$ldlibpthname         = $ldlibpthname;
my \$ldlibpthname_defined = $ldlibpthname_defined;
my \$pthsep               = $pthsep;

EOT
}

my $env_dl_library_path = <<'EOT';
if ($ldlibpthname_defined &&
    exists $ENV{$ldlibpthname}) {
    push(@dl_library_path, split(/$pthsep/, $ENV{$ldlibpthname}));
}

# E.g. HP-UX supports both its native SHLIB_PATH *and* LD_LIBRARY_PATH.

if ($ldlibpthname_defined &&
    $ldlibpthname ne 'LD_LIBRARY_PATH' &&
    exists $ENV{LD_LIBRARY_PATH}) {
    push(@dl_library_path, split(/$pthsep/, $ENV{LD_LIBRARY_PATH}));
}
EOT

if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS} && $ENV{PERL_BUILD_EXPAND_ENV_VARS}) {
    eval $env_dl_library_path;
}
else {
    print OUT <<EOT;
# Add to \@dl_library_path any extra directories we can gather from environment
# during runtime.

$env_dl_library_path

EOT
}

if ($ENV{PERL_BUILD_EXPAND_CONFIG_VARS} && $ENV{PERL_BUILD_EXPAND_ENV_VARS}) {
    my $dl_library_path = dquoted_comma_list(@dl_library_path);
    print OUT <<EOT;
# The below \@dl_library_path has been expanded (%Config, %ENV)
# in Perl build time.

\@dl_library_path = ($dl_library_path);

EOT
}

print OUT <<'EOT';
# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
# NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB
boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
                                !defined(&dl_error);

if ($dl_debug) {
    print STDERR "DynaLoader.pm loaded (@INC, @dl_library_path)\n";
    print STDERR "DynaLoader not linked into this perl\n"
	    unless defined(&boot_DynaLoader);
}

1; # End of main code


sub croak   { require Carp; Carp::croak(@_)   }

sub bootstrap_inherit {
    my $module = $_[0];
    local *isa = *{"$module\::ISA"};
    local @isa = (@isa, 'DynaLoader');
    # Cannot goto due to delocalization.  Will report errors on a wrong line?
    bootstrap(@_);
}

# The bootstrap function cannot be autoloaded (without complications)
# so we define it here:

sub bootstrap {
    # use local vars to enable $module.bs script to edit values
    local(@args) = @_;
    local($module) = $args[0];
    local(@dirs, $file);

    unless ($module) {
	require Carp;
	Carp::confess("Usage: DynaLoader::bootstrap(module)");
    }

    # A common error on platforms which don't support dynamic loading.
    # Since it's fatal and potentially confusing we give a detailed message.
    croak("Can't load module $module, dynamic loading not available in this perl.\n".
	"  (You may need to build a new perl executable which either supports\n".
	"  dynamic loading or has the $module module statically linked into it.)\n")
	unless defined(&dl_load_file);

EOT

print OUT <<'EOT' if $^O eq 'os2';
    # Can dynaload, but cannot dynaload Perl modules...
    die 'Dynaloaded Perl modules are not available in this build of Perl' if $OS2::is_static;

EOT

print OUT <<'EOT';
    my @modparts = split(/::/,$module);
    my $modfname = $modparts[-1];

    # Some systems have restrictions on files names for DLL's etc.
    # mod2fname returns appropriate file base name (typically truncated)
    # It may also edit @modparts if required.
    $modfname = &mod2fname(\@modparts) if defined &mod2fname;

    # Truncate the module name to 8.3 format for NetWare
	if (($^O eq 'NetWare') && (length($modfname) > 8)) {
		$modfname = substr($modfname, 0, 8);
	}

    my $modpname = join(($Is_MacOS ? ':' : '/'), at modparts);

    print STDERR "DynaLoader::bootstrap for $module ",
		($Is_MacOS
		       ? "(:auto:$modpname:$modfname.$dl_dlext)\n" :
		       "(auto/$modpname/$modfname.$dl_dlext)\n")
	if $dl_debug;

    foreach (@INC) {
	chop($_ = VMS::Filespec::unixpath($_)) if $Is_VMS;
	my $dir;
	if ($Is_MacOS) {
	    my $path = $_;
	    if ($Mac_FS && ! -d $path) {
		$path = Mac::FileSpec::Unixish::nativize($path);
	    }
	    $path .= ":"  unless /:$/;
	    $dir = "${path}auto:$modpname";
	} else {
	    $dir = "$_/auto/$modpname";
	}
	
	next unless -d $dir; # skip over uninteresting directories
	
	# check for common cases to avoid autoload of dl_findfile
	my $try = $Is_MacOS ? "$dir:$modfname.$dl_dlext" : "$dir/$modfname.$dl_dlext";
	last if $file = ($do_expand) ? dl_expandspec($try) : ((-f $try) && $try);
	
	# no luck here, save dir for possible later dl_findfile search
	push @dirs, $dir;
    }
    # last resort, let dl_findfile have a go in all known locations
    $file = dl_findfile(map("-L$_", at dirs, at INC), $modfname) unless $file;

    croak("Can't locate loadable object for module $module in \@INC (\@INC contains: @INC)")
	unless $file;	# wording similar to error from 'require'

    $file = uc($file) if $Is_VMS && $Config::Config{d_vms_case_sensitive_symbols};
    my $bootname = "boot_$module";
    $bootname =~ s/\W/_/g;
    @dl_require_symbols = ($bootname);

    # Execute optional '.bootstrap' perl script for this module.
    # The .bs file can be used to configure @dl_resolve_using etc to
    # match the needs of the individual module on this architecture.
    my $bs = $file;
    $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library
    if (-s $bs) { # only read file if it's not empty
        print STDERR "BS: $bs ($^O, $dlsrc)\n" if $dl_debug;
        eval { do $bs; };
        warn "$bs: $@\n" if $@;
    }

    my $boot_symbol_ref;

    if ($^O eq 'darwin') {
        if ($boot_symbol_ref = dl_find_symbol(0, $bootname)) {
            goto boot; #extension library has already been loaded, e.g. darwin
        }
    }

    # Many dynamic extension loading problems will appear to come from
    # this section of code: XYZ failed at line 123 of DynaLoader.pm.
    # Often these errors are actually occurring in the initialisation
    # C code of the extension XS file. Perl reports the error as being
    # in this perl code simply because this was the last perl code
    # it executed.

    my $libref = dl_load_file($file, $module->dl_load_flags) or
	croak("Can't load '$file' for module $module: ".dl_error());

    push(@dl_librefs,$libref);  # record loaded object

    my @unresolved = dl_undef_symbols();
    if (@unresolved) {
	require Carp;
	Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
    }

    $boot_symbol_ref = dl_find_symbol($libref, $bootname) or
         croak("Can't find '$bootname' symbol in $file\n");

    push(@dl_modules, $module); # record loaded module

  boot:
    my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);

    # See comment block above

	push(@dl_shared_objects, $file); # record files loaded

    &$xs(@args);
}


#sub _check_file {   # private utility to handle dl_expandspec vs -f tests
#    my($file) = @_;
#    return $file if (!$do_expand && -f $file); # the common case
#    return $file if ( $do_expand && ($file=dl_expandspec($file)));
#    return undef;
#}


# Let autosplit and the autoloader deal with these functions:
__END__


sub dl_findfile {
    # Read ext/DynaLoader/DynaLoader.doc for detailed information.
    # This function does not automatically consider the architecture
    # or the perl library auto directories.
    my (@args) = @_;
    my (@dirs,  $dir);   # which directories to search
    my (@found);         # full paths to real files we have found
EOT

print OUT '    my $dl_ext= ' . to_string($Config::Config{'dlext'}) .
          "; # \$Config::Config{'dlext'} suffix for perl extensions\n";
print OUT '    my $dl_so = ' . to_string($Config::Config{'so'}) .
          "; # \$Config::Config{'so'} suffix for shared libraries\n";

print OUT <<'EOT';

    print STDERR "dl_findfile(@args)\n" if $dl_debug;

    # accumulate directories but process files as they appear
    arg: foreach(@args) {
        #  Special fast case: full filepath requires no search
        if ($Is_VMS && m%[:>/\]]% && -f $_) {
	    push(@found,dl_expandspec(VMS::Filespec::vmsify($_)));
	    last arg unless wantarray;
	    next;
        }
	elsif ($Is_MacOS) {
	    if (m/:/ && -f $_) {
	    	push(@found,$_);
	    	last arg unless wantarray;
	    }
	}
        elsif (m:/: && -f $_ && !$do_expand) {
	    push(@found,$_);
	    last arg unless wantarray;
	    next;
	}

        # Deal with directories first:
        #  Using a -L prefix is the preferred option (faster and more robust)
        if (m:^-L:) { s/^-L//; push(@dirs, $_); next; }

	if ($Is_MacOS) {
            #  Otherwise we try to try to spot directories by a heuristic
            #  (this is a more complicated issue than it first appears)
	    if (m/:/ && -d $_) {   push(@dirs, $_); next; }
            #  Only files should get this far...
            my(@names, $name);    # what filenames to look for
	    s/^-l//;
	    push(@names, $_);
            foreach $dir (@dirs, @dl_library_path) {
            	next unless -d $dir;
		$dir =~ s/^([^:]+)$/:$1/;
		$dir =~ s/:$//;
            	foreach $name (@names) {
	    	    my($file) = "$dir:$name";
                    print STDERR " checking in $dir for $name\n" if $dl_debug;
		    if (-f $file) {
                    	push(@found, $file);
                    	next arg; # no need to look any further
                    }
                }
	    }
	    next;
	}
	
        #  Otherwise we try to try to spot directories by a heuristic
        #  (this is a more complicated issue than it first appears)
        if (m:/: && -d $_) {   push(@dirs, $_); next; }

        # VMS: we may be using native VMS directory syntax instead of
        # Unix emulation, so check this as well
        if ($Is_VMS && /[:>\]]/ && -d $_) {   push(@dirs, $_); next; }

        #  Only files should get this far...
        my(@names, $name);    # what filenames to look for
        if (m:-l: ) {          # convert -lname to appropriate library name
            s/-l//;
            push(@names,"lib$_.$dl_so");
            push(@names,"lib$_.a");
        } else {                # Umm, a bare name. Try various alternatives:
            # these should be ordered with the most likely first
            push(@names,"$_.$dl_ext")    unless m/\.$dl_ext$/o;
            push(@names,"$_.$dl_so")     unless m/\.$dl_so$/o;
            push(@names,"lib$_.$dl_so")  unless m:/:;
            push(@names,"$_.a")          if !m/\.a$/ and $dlsrc eq "dl_dld.xs";
            push(@names, $_);
        }
        foreach $dir (@dirs, @dl_library_path) {
            next unless -d $dir;
            chop($dir = VMS::Filespec::unixpath($dir)) if $Is_VMS;
            foreach $name (@names) {
		my($file) = "$dir/$name";
                print STDERR " checking in $dir for $name\n" if $dl_debug;
		$file = ($do_expand) ? dl_expandspec($file) : (-f $file && $file);
		#$file = _check_file($file);
		if ($file) {
                    push(@found, $file);
                    next arg; # no need to look any further
                }
            }
        }
    }
    if ($dl_debug) {
        foreach(@dirs) {
            print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_;
        }
        print STDERR "dl_findfile found: @found\n";
    }
    return $found[0] unless wantarray;
    @found;
}


sub dl_expandspec {
    my($spec) = @_;
    # Optional function invoked if DynaLoader.pm sets $do_expand.
    # Most systems do not require or use this function.
    # Some systems may implement it in the dl_*.xs file in which case
    # this autoload version will not be called but is harmless.

    # This function is designed to deal with systems which treat some
    # 'filenames' in a special way. For example VMS 'Logical Names'
    # (something like unix environment variables - but different).
    # This function should recognise such names and expand them into
    # full file paths.
    # Must return undef if $spec is invalid or file does not exist.

    my $file = $spec; # default output to input

    if ($Is_VMS) { # dl_expandspec should be defined in dl_vms.xs
	require Carp;
	Carp::croak("dl_expandspec: should be defined in XS file!\n");
    } else {
	return undef unless -f $file;
    }
    print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug;
    $file;
}

sub dl_find_symbol_anywhere
{
    my $sym = shift;
    my $libref;
    foreach $libref (@dl_librefs) {
	my $symref = dl_find_symbol($libref,$sym);
	return $symref if $symref;
    }
    return undef;
}

=head1 NAME

DynaLoader - Dynamically load C libraries into Perl code

=head1 SYNOPSIS

    package YourPackage;
    require DynaLoader;
    @ISA = qw(... DynaLoader ...);
    bootstrap YourPackage;

    # optional method for 'global' loading
    sub dl_load_flags { 0x01 }     


=head1 DESCRIPTION

This document defines a standard generic interface to the dynamic
linking mechanisms available on many platforms.  Its primary purpose is
to implement automatic dynamic loading of Perl modules.

This document serves as both a specification for anyone wishing to
implement the DynaLoader for a new platform and as a guide for
anyone wishing to use the DynaLoader directly in an application.

The DynaLoader is designed to be a very simple high-level
interface that is sufficiently general to cover the requirements
of SunOS, HP-UX, NeXT, Linux, VMS and other platforms.

It is also hoped that the interface will cover the needs of OS/2, NT
etc and also allow pseudo-dynamic linking (using C<ld -A> at runtime).

It must be stressed that the DynaLoader, by itself, is practically
useless for accessing non-Perl libraries because it provides almost no
Perl-to-C 'glue'.  There is, for example, no mechanism for calling a C
library function or supplying arguments.  A C::DynaLib module
is available from CPAN sites which performs that function for some
common system types.  And since the year 2000, there's also Inline::C,
a module that allows you to write Perl subroutines in C.  Also available
from your local CPAN site.

DynaLoader Interface Summary

  @dl_library_path
  @dl_resolve_using
  @dl_require_symbols
  $dl_debug
  @dl_librefs
  @dl_modules
  @dl_shared_objects
                                                  Implemented in:
  bootstrap($modulename)                               Perl
  @filepaths = dl_findfile(@names)                     Perl
  $flags = $modulename->dl_load_flags                  Perl
  $symref  = dl_find_symbol_anywhere($symbol)          Perl

  $libref  = dl_load_file($filename, $flags)           C
  $status  = dl_unload_file($libref)                   C
  $symref  = dl_find_symbol($libref, $symbol)          C
  @symbols = dl_undef_symbols()                        C
  dl_install_xsub($name, $symref [, $filename])        C
  $message = dl_error                                  C

=over 4

=item @dl_library_path

The standard/default list of directories in which dl_findfile() will
search for libraries etc.  Directories are searched in order:
$dl_library_path[0], [1], ... etc

@dl_library_path is initialised to hold the list of 'normal' directories
(F</usr/lib>, etc) determined by B<Configure> (C<$Config{'libpth'}>).  This should
ensure portability across a wide range of platforms.

@dl_library_path should also be initialised with any other directories
that can be determined from the environment at runtime (such as
LD_LIBRARY_PATH for SunOS).

After initialisation @dl_library_path can be manipulated by an
application using push and unshift before calling dl_findfile().
Unshift can be used to add directories to the front of the search order
either to save search time or to override libraries with the same name
in the 'normal' directories.

The load function that dl_load_file() calls may require an absolute
pathname.  The dl_findfile() function and @dl_library_path can be
used to search for and return the absolute pathname for the
library/object that you wish to load.

=item @dl_resolve_using

A list of additional libraries or other shared objects which can be
used to resolve any undefined symbols that might be generated by a
later call to load_file().

This is only required on some platforms which do not handle dependent
libraries automatically.  For example the Socket Perl extension
library (F<auto/Socket/Socket.so>) contains references to many socket
functions which need to be resolved when it's loaded.  Most platforms
will automatically know where to find the 'dependent' library (e.g.,
F</usr/lib/libsocket.so>).  A few platforms need to be told the
location of the dependent library explicitly.  Use @dl_resolve_using
for this.

Example usage:

    @dl_resolve_using = dl_findfile('-lsocket');

=item @dl_require_symbols

A list of one or more symbol names that are in the library/object file
to be dynamically loaded.  This is only required on some platforms.

=item @dl_librefs

An array of the handles returned by successful calls to dl_load_file(),
made by bootstrap, in the order in which they were loaded.
Can be used with dl_find_symbol() to look for a symbol in any of
the loaded files.

=item @dl_modules

An array of module (package) names that have been bootstrap'ed.

=item @dl_shared_objects

An array of file names for the shared objects that were loaded.

=item dl_error()

Syntax:

    $message = dl_error();

Error message text from the last failed DynaLoader function.  Note
that, similar to errno in unix, a successful function call does not
reset this message.

Implementations should detect the error as soon as it occurs in any of
the other functions and save the corresponding message for later
retrieval.  This will avoid problems on some platforms (such as SunOS)
where the error message is very temporary (e.g., dlerror()).

=item $dl_debug

Internal debugging messages are enabled when $dl_debug is set true.
Currently setting $dl_debug only affects the Perl side of the
DynaLoader.  These messages should help an application developer to
resolve any DynaLoader usage problems.

$dl_debug is set to C<$ENV{'PERL_DL_DEBUG'}> if defined.

For the DynaLoader developer/porter there is a similar debugging
variable added to the C code (see dlutils.c) and enabled if Perl was
built with the B<-DDEBUGGING> flag.  This can also be set via the
PERL_DL_DEBUG environment variable.  Set to 1 for minimal information or
higher for more.

=item dl_findfile()

Syntax:

    @filepaths = dl_findfile(@names)

Determine the full paths (including file suffix) of one or more
loadable files given their generic names and optionally one or more
directories.  Searches directories in @dl_library_path by default and
returns an empty list if no files were found.

Names can be specified in a variety of platform independent forms.  Any
names in the form B<-lname> are converted into F<libname.*>, where F<.*> is
an appropriate suffix for the platform.

If a name does not already have a suitable prefix and/or suffix then
the corresponding file will be searched for by trying combinations of
prefix and suffix appropriate to the platform: "$name.o", "lib$name.*"
and "$name".

If any directories are included in @names they are searched before
@dl_library_path.  Directories may be specified as B<-Ldir>.  Any other
names are treated as filenames to be searched for.

Using arguments of the form C<-Ldir> and C<-lname> is recommended.

Example: 

    @dl_resolve_using = dl_findfile(qw(-L/usr/5lib -lposix));


=item dl_expandspec()

Syntax:

    $filepath = dl_expandspec($spec)

Some unusual systems, such as VMS, require special filename handling in
order to deal with symbolic names for files (i.e., VMS's Logical Names).

To support these systems a dl_expandspec() function can be implemented
either in the F<dl_*.xs> file or code can be added to the autoloadable
dl_expandspec() function in F<DynaLoader.pm>.  See F<DynaLoader.pm> for
more information.

=item dl_load_file()

Syntax:

    $libref = dl_load_file($filename, $flags)

Dynamically load $filename, which must be the path to a shared object
or library.  An opaque 'library reference' is returned as a handle for
the loaded object.  Returns undef on error.

The $flags argument to alters dl_load_file behaviour.  
Assigned bits:

 0x01  make symbols available for linking later dl_load_file's.
       (only known to work on Solaris 2 using dlopen(RTLD_GLOBAL))
       (ignored under VMS; this is a normal part of image linking)

(On systems that provide a handle for the loaded object such as SunOS
and HPUX, $libref will be that handle.  On other systems $libref will
typically be $filename or a pointer to a buffer containing $filename.
The application should not examine or alter $libref in any way.)

This is the function that does the real work.  It should use the
current values of @dl_require_symbols and @dl_resolve_using if required.

    SunOS: dlopen($filename)
    HP-UX: shl_load($filename)
    Linux: dld_create_reference(@dl_require_symbols); dld_link($filename)
    NeXT:  rld_load($filename, @dl_resolve_using)
    VMS:   lib$find_image_symbol($filename,$dl_require_symbols[0])

(The dlopen() function is also used by Solaris and some versions of
Linux, and is a common choice when providing a "wrapper" on other
mechanisms as is done in the OS/2 port.)

=item dl_unload_file()

Syntax:

    $status = dl_unload_file($libref)

Dynamically unload $libref, which must be an opaque 'library reference' as
returned from dl_load_file.  Returns one on success and zero on failure.

This function is optional and may not necessarily be provided on all platforms.
If it is defined, it is called automatically when the interpreter exits for
every shared object or library loaded by DynaLoader::bootstrap.  All such
library references are stored in @dl_librefs by DynaLoader::Bootstrap as it
loads the libraries.  The files are unloaded in last-in, first-out order.

This unloading is usually necessary when embedding a shared-object perl (e.g.
one configured with -Duseshrplib) within a larger application, and the perl
interpreter is created and destroyed several times within the lifetime of the
application.  In this case it is possible that the system dynamic linker will
unload and then subsequently reload the shared libperl without relocating any
references to it from any files DynaLoaded by the previous incarnation of the
interpreter.  As a result, any shared objects opened by DynaLoader may point to
a now invalid 'ghost' of the libperl shared object, causing apparently random
memory corruption and crashes.  This behaviour is most commonly seen when using
Apache and mod_perl built with the APXS mechanism.

    SunOS: dlclose($libref)
    HP-UX: ???
    Linux: ???
    NeXT:  ???
    VMS:   ???

(The dlclose() function is also used by Solaris and some versions of
Linux, and is a common choice when providing a "wrapper" on other
mechanisms as is done in the OS/2 port.)

=item dl_load_flags()

Syntax:

    $flags = dl_load_flags $modulename;

Designed to be a method call, and to be overridden by a derived class
(i.e. a class which has DynaLoader in its @ISA).  The definition in
DynaLoader itself returns 0, which produces standard behavior from
dl_load_file().

=item dl_find_symbol()

Syntax:

    $symref = dl_find_symbol($libref, $symbol)

Return the address of the symbol $symbol or C<undef> if not found.  If the
target system has separate functions to search for symbols of different
types then dl_find_symbol() should search for function symbols first and
then other types.

The exact manner in which the address is returned in $symref is not
currently defined.  The only initial requirement is that $symref can
be passed to, and understood by, dl_install_xsub().

    SunOS: dlsym($libref, $symbol)
    HP-UX: shl_findsym($libref, $symbol)
    Linux: dld_get_func($symbol) and/or dld_get_symbol($symbol)
    NeXT:  rld_lookup("_$symbol")
    VMS:   lib$find_image_symbol($libref,$symbol)


=item dl_find_symbol_anywhere()

Syntax:

    $symref = dl_find_symbol_anywhere($symbol)

Applies dl_find_symbol() to the members of @dl_librefs and returns
the first match found.

=item dl_undef_symbols()

Example

    @symbols = dl_undef_symbols()

Return a list of symbol names which remain undefined after load_file().
Returns C<()> if not known.  Don't worry if your platform does not provide
a mechanism for this.  Most do not need it and hence do not provide it,
they just return an empty list.


=item dl_install_xsub()

Syntax:

    dl_install_xsub($perl_name, $symref [, $filename])

Create a new Perl external subroutine named $perl_name using $symref as
a pointer to the function which implements the routine.  This is simply
a direct call to newXSUB().  Returns a reference to the installed
function.

The $filename parameter is used by Perl to identify the source file for
the function if required by die(), caller() or the debugger.  If
$filename is not defined then "DynaLoader" will be used.


=item bootstrap()

Syntax:

bootstrap($module)

This is the normal entry point for automatic dynamic loading in Perl.

It performs the following actions:

=over 8

=item *

locates an auto/$module directory by searching @INC

=item *

uses dl_findfile() to determine the filename to load

=item *

sets @dl_require_symbols to C<("boot_$module")>

=item *

executes an F<auto/$module/$module.bs> file if it exists
(typically used to add to @dl_resolve_using any files which
are required to load the module on the current platform)

=item *

calls dl_load_flags() to determine how to load the file.

=item *

calls dl_load_file() to load the file

=item *

calls dl_undef_symbols() and warns if any symbols are undefined

=item *

calls dl_find_symbol() for "boot_$module"

=item *

calls dl_install_xsub() to install it as "${module}::bootstrap"

=item *

calls &{"${module}::bootstrap"} to bootstrap the module (actually
it uses the function reference returned by dl_install_xsub for speed)

=back

=back


=head1 AUTHOR

Tim Bunce, 11 August 1994.

This interface is based on the work and comments of (in no particular
order): Larry Wall, Robert Sanders, Dean Roehrich, Jeff Okamoto, Anno
Siegel, Thomas Neumann, Paul Marquess, Charles Bailey, myself and others.

Larry Wall designed the elegant inherited bootstrap mechanism and
implemented the first Perl 5 dynamic loader using it.

Solaris global loading added by Nick Ing-Simmons with design/coding
assistance from Tim Bunce, January 1996.

=cut
EOT

close OUT or die $!;


--- NEW FILE: dl_vmesa.xs ---
/* dl_vmesa.xs
 *
 * Platform:	VM/ESA, possibly others which use dllload etc.
 * Author:	Neale Ferguson (neale at mailbox.tabnsw.com.au)
 * Created:	23rd Septemer, 1998
 *
 *
 */
 
/* Porting notes:
 
 
   Definition of VM/ESA dynamic Linking functions
   ==============================================
   In order to make this implementation easier to understand here is a
   quick definition of the VM/ESA Dynamic Linking functions which are
   used here.
 
   dlopen
   ------
     void *
     dlopen(const char *path)
 
     This function takes the name of a dynamic object file and returns
     a descriptor which can be used by dlsym later. It returns NULL on
     error.
 
 
   dllsym
   ------
     void *
     dlsym(void *handle, char *symbol)
 
     Takes the handle returned from dlopen and the name of a symbol to
     get the address of. If the symbol was found a pointer is
     returned.  It returns NULL on error.
 
   dlerror
   -------
     char * dlerror()
 
     Returns a null-terminated string which describes the last error
     that occurred with the other dll functions. After each call to
     dlerror the error message will be reset to a null pointer. The
     SaveError function is used to save the error as soo as it happens.
 
 
   Return Types
   ============
   In this implementation the two functions, dl_load_file &
   dl_find_symbol, return void *. This is because the underlying SunOS
   dynamic linker calls also return void *.  This is not necessarily
   the case for all architectures. For example, some implementation
   will want to return a char * for dl_load_file.
 
   If void * is not appropriate for your architecture, you will have to
   change the void * to whatever you require. If you are not certain of
   how Perl handles C data types, I suggest you start by consulting	
   Dean Roerich's Perl 5 API document. Also, have a look in the typemap
   file (in the ext directory) for a fairly comprehensive list of types
   that are already supported. If you are completely stuck, I suggest you
   post a message to perl5-porters, comp.lang.perl.misc or if you are really
   desperate to me.
 
   Remember when you are making any changes that the return value from
   dl_load_file is used as a parameter in the dl_find_symbol
   function. Also the return value from find_symbol is used as a parameter
   to install_xsub.
 
 
   Dealing with Error Messages
   ============================
   In order to make the handling of dynamic linking errors as generic as
   possible you should store any error messages associated with your
   implementation with the StoreError function.
 
   In the case of VM/ESA the function dlerror returns the error message
   associated with the last dynamic link error. As the VM/ESA dynamic
   linker functions return NULL on error every call to a VM/ESA dynamic
   dynamic link routine is coded like this
 
	RETVAL = dlopen(filename) ;
	if (RETVAL == NULL)
	    SaveError(aTHX_ "%s",dlerror()) ;
 
   Note that SaveError() takes a printf format string. Use a "%s" as
   the first parameter if the error may contain and % characters.
 
*/
 
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <dll.h>
 
 
#include "dlutils.c"	/* SaveError() etc	*/
 
 
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
    CODE:
    if (flags & 0x01)
	Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
    RETVAL = dlopen(filename) ;
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%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_find_symbol(libhandle, symbolname)
    void *	libhandle
    char *	symbolname
    CODE:
    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
    char *		filename
    CODE:
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
		perl_name, (unsigned long) symref));
    ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
					(void(*)(pTHX_ CV *))symref,
					filename)));
 
 
char *
dl_error()
    CODE:
    dMY_CXT;
    RETVAL = dl_last_error ;
    OUTPUT:
    RETVAL
 
# end.

--- NEW FILE: XSLoader_pm.PL ---
use strict;
use Config;

sub to_string {
    my ($value) = @_;
    $value =~ s/\\/\\\\/g;
    $value =~ s/'/\\'/g;
    return "'$value'";
}

1 while unlink "XSLoader.pm";
open OUT, ">XSLoader.pm" or die $!;
print OUT <<'EOT';
# Generated from XSLoader.pm.PL (resolved %Config::Config value)

package XSLoader;

$VERSION = "0.06";

#use strict;

# enable debug/trace messages from DynaLoader perl code
# $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug;

EOT

print OUT '  my $dl_dlext = ', to_string($Config::Config{'dlext'}), ";\n" ;

print OUT <<'EOT';

package DynaLoader;

# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here.
# NOTE: All dl_*.xs (including dl_none.xs) define a dl_error() XSUB
boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) &&
                                !defined(&dl_error);
package XSLoader;

sub load {
    package DynaLoader;

    die q{XSLoader::load('Your::Module', $Your::Module::VERSION)} unless @_;

    my($module) = $_[0];

    # work with static linking too
    my $b = "$module\::bootstrap";
    goto &$b if defined &$b;

    goto retry unless $module and defined &dl_load_file;

    my @modparts = split(/::/,$module);
    my $modfname = $modparts[-1];

EOT

print OUT <<'EOT' if defined &DynaLoader::mod2fname;
    # Some systems have restrictions on files names for DLL's etc.
    # mod2fname returns appropriate file base name (typically truncated)
    # It may also edit @modparts if required.
    $modfname = &mod2fname(\@modparts) if defined &mod2fname;

EOT

print OUT <<'EOT';
    my $modpname = join('/', at modparts);
    my $modlibname = (caller())[1];
    my $c = @modparts;
    $modlibname =~ s,[\\/][^\\/]+$,, while $c--;	# Q&D basename
    my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext";

#   print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug;

    my $bs = $file;
    $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library

    goto retry if not -f $file or -s $bs;

    my $bootname = "boot_$module";
    $bootname =~ s/\W/_/g;
    @DynaLoader::dl_require_symbols = ($bootname);

    my $boot_symbol_ref;

    if ($^O eq 'darwin') {
        if ($boot_symbol_ref = dl_find_symbol(0, $bootname)) {
            goto boot; #extension library has already been loaded, e.g. darwin
        }
    }

    # Many dynamic extension loading problems will appear to come from
    # this section of code: XYZ failed at line 123 of DynaLoader.pm.
    # Often these errors are actually occurring in the initialisation
    # C code of the extension XS file. Perl reports the error as being
    # in this perl code simply because this was the last perl code
    # it executed.

    my $libref = dl_load_file($file, 0) or do { 
        require Carp;
        Carp::croak("Can't load '$file' for module $module: " . dl_error());
    };
    push(@DynaLoader::dl_librefs,$libref);  # record loaded object

    my @unresolved = dl_undef_symbols();
    if (@unresolved) {
        require Carp;
        Carp::carp("Undefined symbols present after loading $file: @unresolved\n");
    }

    $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do {
        require Carp;
        Carp::croak("Can't find '$bootname' symbol in $file\n");
    };

    push(@DynaLoader::dl_modules, $module); # record loaded module

  boot:
    my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file);

    # See comment block above
    push(@DynaLoader::dl_shared_objects, $file); # record files loaded
    return &$xs(@_);

  retry:
    my $bootstrap_inherit = DynaLoader->can('bootstrap_inherit') || 
                            XSLoader->can('bootstrap_inherit');
    goto &$bootstrap_inherit;
}

# Versions of DynaLoader prior to 5.6.0 don't have this function.
sub bootstrap_inherit {
    package DynaLoader;

    my $module = $_[0];
    local *DynaLoader::isa = *{"$module\::ISA"};
    local @DynaLoader::isa = (@DynaLoader::isa, 'DynaLoader');
    # Cannot goto due to delocalization.  Will report errors on a wrong line?
    require DynaLoader;
    DynaLoader::bootstrap(@_);
}

1;


__END__

=head1 NAME

XSLoader - Dynamically load C libraries into Perl code

=head1 VERSION

Version 0.06

=head1 SYNOPSIS

    package YourPackage;
    use XSLoader;

    XSLoader::load 'YourPackage', $YourPackage::VERSION;

=head1 DESCRIPTION

This module defines a standard I<simplified> interface to the dynamic
linking mechanisms available on many platforms.  Its primary purpose is
to implement cheap automatic dynamic loading of Perl modules.

For a more complicated interface, see L<DynaLoader>.  Many (most)
features of C<DynaLoader> are not implemented in C<XSLoader>, like for
example the C<dl_load_flags>, not honored by C<XSLoader>.

=head2 Migration from C<DynaLoader>

A typical module using L<DynaLoader|DynaLoader> starts like this:

    package YourPackage;
    require DynaLoader;

    our @ISA = qw( OnePackage OtherPackage DynaLoader );
    our $VERSION = '0.01';
    bootstrap YourPackage $VERSION;

Change this to

    package YourPackage;
    use XSLoader;

    our @ISA = qw( OnePackage OtherPackage );
    our $VERSION = '0.01';
    XSLoader::load 'YourPackage', $VERSION;

In other words: replace C<require DynaLoader> by C<use XSLoader>, remove
C<DynaLoader> from C<@ISA>, change C<bootstrap> by C<XSLoader::load>.  Do not
forget to quote the name of your package on the C<XSLoader::load> line,
and add comma (C<,>) before the arguments (C<$VERSION> above).

Of course, if C<@ISA> contained only C<DynaLoader>, there is no need to have
the C<@ISA> assignment at all; moreover, if instead of C<our> one uses the
more backward-compatible

    use vars qw($VERSION @ISA);

one can remove this reference to C<@ISA> together with the C<@ISA> assignment.

If no C<$VERSION> was specified on the C<bootstrap> line, the last line becomes

    XSLoader::load 'YourPackage';

=head2 Backward compatible boilerplate

If you want to have your cake and eat it too, you need a more complicated
boilerplate.

    package YourPackage;
    use vars qw($VERSION @ISA);

    @ISA = qw( OnePackage OtherPackage );
    $VERSION = '0.01';
    eval {
       require XSLoader;
       XSLoader::load('YourPackage', $VERSION);
       1;
    } or do {
       require DynaLoader;
       push @ISA, 'DynaLoader';
       bootstrap YourPackage $VERSION;
    };

The parentheses about C<XSLoader::load()> arguments are needed since we replaced
C<use XSLoader> by C<require>, so the compiler does not know that a function
C<XSLoader::load()> is present.

This boilerplate uses the low-overhead C<XSLoader> if present; if used with
an antic Perl which has no C<XSLoader>, it falls back to using C<DynaLoader>.

=head1 Order of initialization: early load()

I<Skip this section if the XSUB functions are supposed to be called from other
modules only; read it only if you call your XSUBs from the code in your module,
or have a C<BOOT:> section in your XS file (see L<perlxs/"The BOOT: Keyword">).
What is described here is equally applicable to the L<DynaLoader|DynaLoader>
interface.>

A sufficiently complicated module using XS would have both Perl code (defined
in F<YourPackage.pm>) and XS code (defined in F<YourPackage.xs>).  If this
Perl code makes calls into this XS code, and/or this XS code makes calls to
the Perl code, one should be careful with the order of initialization.

The call to C<XSLoader::load()> (or C<bootstrap()>) has three side effects:

=over

=item *

if C<$VERSION> was specified, a sanity check is done to ensure that the
versions of the F<.pm> and the (compiled) F<.xs> parts are compatible;

=item *

the XSUBs are made accessible from Perl;

=item *

if a C<BOOT:> section was present in the F<.xs> file, the code there is called.

=back

Consequently, if the code in the F<.pm> file makes calls to these XSUBs, it is
convenient to have XSUBs installed before the Perl code is defined; for
example, this makes prototypes for XSUBs visible to this Perl code.
Alternatively, if the C<BOOT:> section makes calls to Perl functions (or
uses Perl variables) defined in the F<.pm> file, they must be defined prior to
the call to C<XSLoader::load()> (or C<bootstrap()>).

The first situation being much more frequent, it makes sense to rewrite the
boilerplate as

    package YourPackage;
    use XSLoader;
    use vars qw($VERSION @ISA);

    BEGIN {
       @ISA = qw( OnePackage OtherPackage );
       $VERSION = '0.01';

       # Put Perl code used in the BOOT: section here

       XSLoader::load 'YourPackage', $VERSION;
    }

    # Put Perl code making calls into XSUBs here

=head2 The most hairy case

If the interdependence of your C<BOOT:> section and Perl code is
more complicated than this (e.g., the C<BOOT:> section makes calls to Perl
functions which make calls to XSUBs with prototypes), get rid of the C<BOOT:>
section altogether.  Replace it with a function C<onBOOT()>, and call it like
this:

    package YourPackage;
    use XSLoader;
    use vars qw($VERSION @ISA);

    BEGIN {
       @ISA = qw( OnePackage OtherPackage );
       $VERSION = '0.01';
       XSLoader::load 'YourPackage', $VERSION;
    }

    # Put Perl code used in onBOOT() function here; calls to XSUBs are
    # prototype-checked.

    onBOOT;

    # Put Perl initialization code assuming that XS is initialized here


=head1 DIAGNOSTICS

=over 4

=item Can't find '%s' symbol in %s

B<(F)> The bootstrap symbol could not be found in the extension module.

=item Can't load '%s' for module %s: %s

B<(F)> The loading or initialisation of the extension module failed.
The detailed error follows.

=item Undefined symbols present after loading %s: %s

B<(W)> As the message says, some symbols stay undefined although the
extension module was correctly loaded and initialised. The list of undefined
symbols follows.

=item XSLoader::load('Your::Module', $Your::Module::VERSION)

B<(F)> You tried to invoke C<load()> without any argument. You must supply
a module name, and optionally its version.

=back


=head1 LIMITATIONS

To reduce the overhead as much as possible, only one possible location
is checked to find the extension DLL (this location is where C<make install>
would put the DLL).  If not found, the search for the DLL is transparently
delegated to C<DynaLoader>, which looks for the DLL along the C<@INC> list.

In particular, this is applicable to the structure of C<@INC> used for testing
not-yet-installed extensions.  This means that running uninstalled extensions
may have much more overhead than running the same extensions after
C<make install>.


=head1 BUGS

Please report any bugs or feature requests via the perlbug(1) utility.


=head1 SEE ALSO

L<DynaLoader>


=head1 AUTHORS

Ilya Zakharevich originally extracted C<XSLoader> from C<DynaLoader>.

CPAN version is currently maintained by SE<eacute>bastien Aperghis-Tramoni
E<lt>sebastien at aperghis.netE<gt>

Previous maintainer was Michael G Schwern <schwern at pobox.com>


=head1 COPYRIGHT

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
EOT

close OUT or die $!;

--- NEW FILE: dl_dld.xs ---
/*
 *    Written 3/1/94, Robert Sanders <Robert.Sanders at linux.org>
 *
 * based upon the file "dl.c", which is
 *    Copyright (c) 1994, Larry Wall
 *
 *    You may distribute under the terms of either the GNU General Public
 *    License or the Artistic License, as specified in the README file.
 *
 * $Date: 2006-12-04 16:59:19 $
 * $Source: /cvsroot/dslinux/dslinux/user/perl/ext/DynaLoader/dl_dld.xs,v $
 * $Revision: 1.2 $
 * $State: Exp $
 *
 * $Log: dl_dld.xs,v $
 * Revision 1.2  2006-12-04 16:59:19  dslinux_cayenne
 * Adding fresh perl source to HEAD to branch from
 *
 * Removed implicit link against libc.  1994/09/14 William Setzer.
 *
 * Integrated other DynaLoader changes. 1994/06/08 Tim Bunce.
 *
 * rewrote dl_load_file, misc updates.  1994/09/03 William Setzer.
 *
 * Revision 1.4  1994/03/07  00:21:43  rsanders
 * added min symbol count for load_libs and switched order so system libs
 * are loaded after app-specified libs.
 *
 * Revision 1.3  1994/03/05  01:17:26  rsanders
 * added path searching.
 *
 * Revision 1.2  1994/03/05  00:52:39  rsanders
 * added package-specified libraries.
 *
 * Revision 1.1  1994/03/05  00:33:40  rsanders
 * Initial revision
 *
 *
 */

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

#include <dld.h>	/* GNU DLD header file */
#include <unistd.h>

typedef struct {
    AV *	x_resolve_using;
    AV *	x_require_symbols;
} my_cxtx_t;		/* this *must* be named my_cxtx_t */

#define DL_CXT_EXTRA	/* ask for dl_cxtx to be defined in dlutils.c */
#include "dlutils.c"	/* for SaveError() etc */

#define dl_resolve_using	(dl_cxtx.x_resolve_using)
#define dl_require_symbols	(dl_cxtx.x_require_symbols)

static void
dl_private_init(pTHX)
{
    dl_generic_private_init(aTHX);
    {
	int dlderr;
	dMY_CXT;

	dl_resolve_using   = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
	dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI);
#ifdef __linux__
	dlderr = dld_init("/proc/self/exe");
	if (dlderr) {
#endif
	    dlderr = dld_init(dld_find_executable(PL_origargv[0]));
	    if (dlderr) {
		char *msg = dld_strerror(dlderr);
		SaveError(aTHX_ "dld_init(%s) failed: %s", PL_origargv[0], msg);
		DLDEBUG(1,PerlIO_printf(Perl_debug_log, "%s", dl_last_error));
	    }
#ifdef __linux__
	}
#endif
    }
}


MODULE = DynaLoader     PACKAGE = DynaLoader

BOOT:
    (void)dl_private_init();


char *
dl_load_file(filename, flags=0)
    char *	filename
    int		flags
    PREINIT:
    int dlderr,x,max;
    GV *gv;
    dMY_CXT;
    CODE:
    RETVAL = filename;
    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
    if (flags & 0x01)
	Perl_croak(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
    max = AvFILL(dl_require_symbols);
    for (x = 0; x <= max; x++) {
	char *sym = SvPVX(*av_fetch(dl_require_symbols, x, 0));
	DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_create_ref(%s)\n", sym));
	if (dlderr = dld_create_reference(sym)) {
	    SaveError(aTHX_ "dld_create_reference(%s): %s", sym,
		      dld_strerror(dlderr));
	    goto haverror;
	}
    }

    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", filename));
    if (dlderr = dld_link(filename)) {
	SaveError(aTHX_ "dld_link(%s): %s", filename, dld_strerror(dlderr));
	goto haverror;
    }

    max = AvFILL(dl_resolve_using);
    for (x = 0; x <= max; x++) {
	char *sym = SvPVX(*av_fetch(dl_resolve_using, x, 0));
	DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", sym));
	if (dlderr = dld_link(sym)) {
	    SaveError(aTHX_ "dld_link(%s): %s", sym, dld_strerror(dlderr));
	    goto haverror;
	}
    }
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "libref=%s\n", RETVAL));
haverror:
    ST(0) = sv_newmortal() ;
    if (dlderr == 0)
	sv_setiv(ST(0), PTR2IV(RETVAL));


void *
dl_find_symbol(libhandle, symbolname)
    void *	libhandle
    char *	symbolname
    CODE:
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n",
	    libhandle, symbolname));
    RETVAL = (void *)dld_get_func(symbolname);
    /* if RETVAL==NULL we should try looking for a non-function symbol */
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "  symbolref = %x\n", RETVAL));
    ST(0) = sv_newmortal() ;
    if (RETVAL == NULL)
	SaveError(aTHX_ "dl_find_symbol: Unable to find '%s' symbol", symbolname) ;
    else
	sv_setiv(ST(0), PTR2IV(RETVAL));


void
dl_undef_symbols()
    PPCODE:
    if (dld_undefined_sym_count) {
	int x;
	char **undef_syms = dld_list_undefined_sym();
	EXTEND(SP, dld_undefined_sym_count);
	for (x=0; x < dld_undefined_sym_count; x++)
	    PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0)));
	free(undef_syms);
    }



# 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(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
	    perl_name, symref));
    ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
					(void(*)(pTHX_ CV *))symref,
					filename)));


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

# end.

--- NEW FILE: README ---
Perl 5 DynaLoader

See DynaLoader.pm for detailed specification.

This module is very similar to the other Perl 5 modules except that
Configure selects which dl_*.xs file to use.

After Configure has been run the Makefile.PL will generate a Makefile
which will run xsubpp on a specific dl_*.xs file and write the output
to DynaLoader.c

After that the processing is the same as any other module.

Note that, to be effective, the DynaLoader module must be _statically_
linked into perl! Configure should arrange this.

This interface is based on the work and comments of (in no particular
order): Larry Wall, Robert Sanders, Dean Roehrich, Jeff Okamoto, Anno
Siegel, Thomas Neumann, Paul Marquess, Charles Bailey and others.

The dl_*.xs files should either be named after the dynamic linking
operating system interface used if that interface is available on more
than one type of system, e.g.:
	dlopen  for dlopen()/dlsym() type functions (SunOS, BSD)
	dld     for the GNU dld library functions (linux, ?)
or else the osname, e.g., hpux, next, vms etc.

Both are determined by Configure and so only those specific names that
Configure knows/uses will work.

If porting the DynaLoader to a platform that has a core dynamic linking
interface similar to an existing generic type, e.g., dlopen or dld,
please try to port the corresponding dl_*.xs file (using #ifdef's if
required).

Otherwise, or if that proves too messy, create a new dl_*.xs file named
after your osname. Configure will give preference to a dl_$osname.xs
file if one exists.

The file dl_dlopen.xs is a reference implementation by Paul Marquess
which is a good place to start if porting from scratch. For more complex
platforms take a look at dl_dld.xs. The dlutils.c file holds some
common definitions that are #included into the dl_*.xs files.

After the initial implementation of a new DynaLoader dl_*.xs file you
may need to edit or create ext/MODULE/MODULE.bs files (library bootstrap
files) to reflect the needs of your platform and linking software.

Refer to DynaLoader.pm, lib/ExtUtils/MakeMaker.pm and any existing
ext/MODULE/MODULE.bs files for more information.

Tim Bunce.
August 1994

--- NEW FILE: dl_hpux.xs ---
/*
 * Author: Jeff Okamoto (okamoto at corp.hp.com)
 * Version: 2.1, 1995/1/25
 */

/* o Added BIND_VERBOSE to dl_nonlazy condition to add names of missing
 *   symbols to stderr message on fatal error.
 *
 * o Added BIND_NONFATAL comment to default condition.
 *
 * Chuck Phillips (cdp at fc.hp.com)
 * Version: 2.2, 1997/5/4 */

#ifdef __hp9000s300
#define magic hpux_magic
#define MAGIC HPUX_MAGIC
#endif

#include <dl.h>
#ifdef __hp9000s300
#undef magic
#undef MAGIC
#endif

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

typedef struct {
    AV *	x_resolve_using;
} my_cxtx_t;		/* this *must* be named my_cxtx_t */

#define DL_CXT_EXTRA	/* ask for dl_cxtx to be defined in dlutils.c */
#include "dlutils.c"	/* for SaveError() etc */

#define dl_resolve_using	(dl_cxtx.x_resolve_using)

static void
dl_private_init(pTHX)
{
    (void)dl_generic_private_init(aTHX);
    {
	dMY_CXT;
	dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
    }
}

MODULE = DynaLoader     PACKAGE = DynaLoader

BOOT:
    (void)dl_private_init(aTHX);


void *
dl_load_file(filename, flags=0)
    char *	filename
    int		flags
    PREINIT:
    shl_t obj = NULL;
    int	i, max, bind_type;
    dMY_CXT;
    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);
    if (dl_nonlazy) {
      bind_type = BIND_IMMEDIATE|BIND_VERBOSE;
    } else {
      bind_type = BIND_DEFERRED;
      /* For certain libraries, like DCE, deferred binding often causes run
       * time problems.  Adding BIND_NONFATAL to BIND_IMMEDIATE still allows
       * unresolved references in situations like this.  */
      /* bind_type = BIND_IMMEDIATE|BIND_NONFATAL; */
    }
    /* BIND_NOSTART removed from bind_type because it causes the shared library's	*/
    /* initialisers not to be run.  This causes problems with all of the static objects */
    /* in the library.	   */
#ifdef DEBUGGING
    if (dl_debug)
	bind_type |= BIND_VERBOSE;
#endif /* DEBUGGING */

    max = AvFILL(dl_resolve_using);
    for (i = 0; i <= max; i++) {
	char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0));
	DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s) (dependent)\n", sym));
	obj = shl_load(sym, bind_type, 0L);
	if (obj == NULL) {
	    goto end;
	}
    }

    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s): ", filename));
    obj = shl_load(filename, bind_type, 0L);

    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", obj));
end:
    ST(0) = sv_newmortal() ;
    if (obj == NULL)
        SaveError(aTHX_ "%s",Strerror(errno));
    else
        sv_setiv( ST(0), PTR2IV(obj) );


int
dl_unload_file(libref)
    void *	libref
  CODE:
    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
    RETVAL = (shl_unload(libref) == 0 ? 1 : 0);
    if (!RETVAL)
	SaveError(aTHX_ "%s", Strerror(errno));
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
  OUTPUT:
    RETVAL


void *
dl_find_symbol(libhandle, symbolname)
    void *	libhandle
    char *	symbolname
    CODE:
    shl_t obj = (shl_t) libhandle;
    void *symaddr = NULL;
    int status;
#ifdef __hp9000s300
    symbolname = Perl_form_nocontext("_%s", symbolname);
#endif
    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
			     "dl_find_symbol(handle=%lx, symbol=%s)\n",
			     (unsigned long) libhandle, symbolname));

    ST(0) = sv_newmortal() ;
    errno = 0;

    status = shl_findsym(&obj, symbolname, TYPE_PROCEDURE, &symaddr);
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "  symbolref(PROCEDURE) = %x\n", symaddr));

    if (status == -1 && errno == 0) {	/* try TYPE_DATA instead */
	status = shl_findsym(&obj, symbolname, TYPE_DATA, &symaddr);
	DLDEBUG(2,PerlIO_printf(Perl_debug_log, "  symbolref(DATA) = %x\n", symaddr));
    }

    if (status == -1) {
	SaveError(aTHX_ "%s",(errno) ? Strerror(errno) : "Symbol not found") ;
    } else {
	sv_setiv( ST(0), PTR2IV(symaddr) );
    }


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(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
	    perl_name, symref));
    ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
					(void(*)(pTHX_ CV *))symref,
					filename)));


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

# end.

--- NEW FILE: dl_mac.xs ---
/* dl_mac.xs
 * 
 * Platform:	Macintosh CFM
 * Author:	Matthias Neeracher <neeri at iis.ee.ethz.ch>
 *		Adapted from dl_dlopen.xs reference implementation by
 *              Paul Marquess (pmarquess at bfsec.bt.co.uk)
 * $Log: dl_mac.xs,v $
 * Revision 1.2  2006-12-04 16:59:19  dslinux_cayenne
 * Adding fresh perl source to HEAD to branch from
 *
 * Revision 1.3  1998/04/07 01:47:24  neeri
 * MacPerl 5.2.0r4b1
 *
 * Revision 1.2  1997/08/08 16:39:18  neeri
 * MacPerl 5.1.4b1 + time() fix
 *
 * Revision 1.1  1997/04/07 20:48:23  neeri
 * Synchronized with MacPerl 5.1.4a1
 *
 */

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

#include <CodeFragments.h>

typedef CFragConnectionID ConnectionID;

typedef struct {
    ConnectionID **	x_connections;
} my_cxtx_t;		/* this *must* be named my_cxtx_t */

#define DL_CXT_EXTRA	/* ask for dl_cxtx to be defined in dlutils.c */
#include "dlutils.c"	/* SaveError() etc	*/

#define dl_connections	(dl_cxtx.x_connections)

static void terminate(pTHX_ void *ptr)
{
    dMY_CXT;
    int size = GetHandleSize((Handle) dl_connections) / sizeof(ConnectionID);
    HLock((Handle) dl_connections);
    while (size)
    	CloseConnection(*dl_connections + --size);
    DisposeHandle((Handle) dl_connections);
    dl_connections = nil;
}

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

MODULE = DynaLoader	PACKAGE = DynaLoader

BOOT:
    (void)dl_private_init(aTHX);


ConnectionID
dl_load_file(filename, flags=0)
    char *		filename
    int			flags
    PREINIT:
    OSErr		err;
    FSSpec		spec;
    ConnectionID	connID;
    Ptr			mainAddr;
    Str255		errName;
    CODE:
    DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename));
    err = GUSIPath2FSp(filename, &spec);
    if (!err)
    	err = 
	    GetDiskFragment(
	    	&spec, 0, 0, spec.name, kLoadCFrag, &connID, &mainAddr, errName);
    if (!err) {
	dMY_CXT;
    	if (!dl_connections) {
	    dl_connections = (ConnectionID **)NewHandle(0);
	    call_atexit(terminate, (void*)0);
    	}
        PtrAndHand((Ptr) &connID, (Handle) dl_connections, sizeof(ConnectionID));
    	RETVAL = connID;
    } else
    	RETVAL = (ConnectionID) 0;
    DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%d\n", RETVAL));
    ST(0) = sv_newmortal() ;
    if (err)
    	SaveError(aTHX_ "DynaLoader error [%d, %#s]", err, errName) ;
    else
    	sv_setiv( ST(0), (IV)RETVAL);

void *
dl_find_symbol(connID, symbol)
    ConnectionID	connID
    Str255		symbol
    CODE:
    {
    	OSErr		    err;
    	Ptr		    symAddr;
    	CFragSymbolClass    symClass;
    	DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%#s)\n",
	    connID, symbol));
   	err = FindSymbol(connID, symbol, &symAddr, &symClass);
    	if (err)
    	    symAddr = (Ptr) 0;
    	RETVAL = (void *) symAddr;
    	DLDEBUG(2,PerlIO_printf(Perl_debug_log,"  symbolref = %x\n", RETVAL));
    	ST(0) = sv_newmortal() ;
    	if (err)
	    SaveError(aTHX_ "DynaLoader error [%d]!", err) ;
    	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(Perl_debug_log,"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:
    dMY_CXT;
    RETVAL = dl_last_error ;
    OUTPUT:
    RETVAL

# end.

--- NEW FILE: dl_beos.xs ---
/*
 * dl_beos.xs, by Tom Spindler
 * based on dl_dlopen.xs, by Paul Marquess
 * $Id: dl_beos.xs,v 1.2 2006-12-04 16:59:19 dslinux_cayenne Exp $
 */

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

#include <be/kernel/image.h>
#include <OS.h>
#include <stdlib.h>
#include <limits.h>

#define dlerror() strerror(errno)

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

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
    CODE:
{   image_id bogo;
    char *path;
    path = malloc(PATH_MAX);
    if (*filename != '/') {
      getcwd(path, PATH_MAX);
      strcat(path, "/");
      strcat(path, filename);
    } else {
      strcpy(path, filename);
    }

    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", path, flags));
    bogo = load_add_on(path);
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
    ST(0) = sv_newmortal() ;
    if (bogo < 0) {
	SaveError(aTHX_ "%s", strerror(bogo));
	PerlIO_printf(Perl_debug_log, "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo));
    } else {
	RETVAL = (void *) bogo;
	sv_setiv( ST(0), PTR2IV(RETVAL) );
    }
    free(path);
}

void *
dl_find_symbol(libhandle, symbolname)
    void *	libhandle
    char *	symbolname
    CODE:
    status_t retcode;
    void *adr = 0;
#ifdef DLSYM_NEEDS_UNDERSCORE
    symbolname = Perl_form_nocontext("_%s", symbolname);
#endif
    RETVAL = NULL;
    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
			     "dl_find_symbol(handle=%lx, symbol=%s)\n",
			     (unsigned long) libhandle, symbolname));
    retcode = get_image_symbol((image_id) libhandle, symbolname,
                               B_SYMBOL_TYPE_TEXT, (void **) &adr);
    RETVAL = adr;
    DLDEBUG(2, PerlIO_printf(Perl_debug_log,
			     "  symbolref = %lx\n", (unsigned long) RETVAL));
    ST(0) = sv_newmortal() ;
    if (RETVAL == NULL) {
	SaveError(aTHX_ "%s", strerror(retcode)) ;
	PerlIO_printf(Perl_debug_log, "retcode = %p (%s)\n", retcode, strerror(retcode));
    } 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 
    char *		filename
    CODE:
    DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
		perl_name, (unsigned long) symref));
    ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
					(void(*)(pTHX_ CV *))symref,
					filename)));


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

# end.

--- NEW FILE: dl_next.xs ---
/* dl_next.xs
 * 
 * Platform:	NeXT NS 3.2
 * Author:	Anno Siegel (siegel at 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

typedef struct {
    AV *	x_resolve_using;
} my_cxtx_t;		/* this *must* be named my_cxtx_t */

#define DL_CXT_EXTRA	/* ask for dl_cxtx to be defined in dlutils.c */
#include "dlutils.c"	/* SaveError() etc	*/

#define dl_resolve_using	(dl_cxtx.x_resolve_using)

static char *dlerror()
{
    dTHX;
    dMY_CXT;
    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)
{
    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;
    }
    Safefree(dl_last_error);
    dl_last_error = savepv(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 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;
    dTHX;
    dMY_CXT;

    if ( dl_last_error ) {
        Safefree(dl_last_error);
    }
    NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
    Newx(dl_last_error, len, char);
    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;
    STRLEN n_a;
    dTHX;
    dMY_CXT;
	
    /* 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), n_a);
    }
    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), &PL_sv_yes, 0);
    } else {
	TransferError(nxerr);
	result = (char*) 0;
    }
    CloseError(nxerr);
    return result;
}

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

    if (!rld_lookup(nxerr, Perl_form_nocontext("_%s", symbol), &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(pTHX)
{
    (void)dl_generic_private_init(aTHX);
    {
	dMY_CXT;
	dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI);
    }
}
 
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:
#if NS_TARGET_MAJOR >= 4
    symbolname = Perl_form_nocontext("_%s", symbolname);
#endif
    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 
    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(perl_name,
					(void(*)(pTHX_ CV *))symref,
					filename)));


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

# end.




More information about the dslinux-commit mailing list