diff options
Diffstat (limited to 'contrib/perl5/ext/DynaLoader')
| -rw-r--r-- | contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL | 3 | ||||
| -rw-r--r-- | contrib/perl5/ext/DynaLoader/Makefile.PL | 2 | ||||
| -rw-r--r-- | contrib/perl5/ext/DynaLoader/dl_beos.xs | 115 | ||||
| -rw-r--r-- | contrib/perl5/ext/DynaLoader/dl_cygwin32.xs | 10 | ||||
| -rw-r--r-- | contrib/perl5/ext/DynaLoader/dl_mpeix.xs | 11 | ||||
| -rw-r--r-- | contrib/perl5/ext/DynaLoader/dl_next.xs | 3 | ||||
| -rw-r--r-- | contrib/perl5/ext/DynaLoader/dl_vms.xs | 2 |
7 files changed, 132 insertions, 14 deletions
diff --git a/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL b/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL index 4c41559..cf7d708 100644 --- a/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL +++ b/contrib/perl5/ext/DynaLoader/DynaLoader_pm.PL @@ -101,7 +101,8 @@ push(@dl_library_path, split(/:/, $ENV{LD_LIBRARY_PATH})) # No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. -boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader); +boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && + !defined(&dl_load_file); if ($dl_debug) { diff --git a/contrib/perl5/ext/DynaLoader/Makefile.PL b/contrib/perl5/ext/DynaLoader/Makefile.PL index 7a75115..2141fde 100644 --- a/contrib/perl5/ext/DynaLoader/Makefile.PL +++ b/contrib/perl5/ext/DynaLoader/Makefile.PL @@ -4,7 +4,7 @@ WriteMakefile( NAME => 'DynaLoader', LINKTYPE => 'static', DEFINE => '-DPERL_CORE -DLIBC="$(LIBC)"', - MAN3PODS => ' ', # Pods will be built by installman. + MAN3PODS => {}, # Pods will be built by installman. SKIP => [qw(dynamic dynamic_lib dynamic_bs)], XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'DynaLoader_pm.PL', diff --git a/contrib/perl5/ext/DynaLoader/dl_beos.xs b/contrib/perl5/ext/DynaLoader/dl_beos.xs new file mode 100644 index 0000000..42a27cb --- /dev/null +++ b/contrib/perl5/ext/DynaLoader/dl_beos.xs @@ -0,0 +1,115 @@ +/* + * dl_beos.xs, by Tom Spindler + * based on dl_dlopen.xs, by Paul Marquess + * $Id:$ + */ + +#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() +{ + (void)dl_generic_private_init(); +} + +MODULE = DynaLoader PACKAGE = DynaLoader + +BOOT: + (void)dl_private_init(); + + +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(PerlIO_stderr(), "dl_load_file(%s,%x):\n", path, flags)); + bogo = load_add_on(path); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL)); + ST(0) = sv_newmortal() ; + if (bogo < 0) { + SaveError("%s", strerror(bogo)); + PerlIO_printf(PerlIO_stderr(), "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo)); + } else { + RETVAL = (void *) bogo; + sv_setiv( ST(0), (IV)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 = form("_%s", symbolname); +#endif + RETVAL = NULL; + DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + "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(PerlIO_stderr(), + " symbolref = %lx\n", (unsigned long) RETVAL)); + ST(0) = sv_newmortal() ; + if (RETVAL == NULL) { + SaveError("%s", strerror(retcode)) ; + PerlIO_printf(PerlIO_stderr(), "retcode = %p (%s)\n", retcode, strerror(retcode)); + } else + sv_setiv( ST(0), (IV)RETVAL); + + +void +dl_undef_symbols() + PPCODE: + + + +# These functions should not need changing on any platform: + +void +dl_install_xsub(perl_name, symref, filename="$Package") + char * perl_name + void * symref + char * filename + CODE: + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n", + perl_name, (unsigned long) symref)); + ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)_((CV *)))symref, filename))); + + +char * +dl_error() + CODE: + RETVAL = LastError ; + OUTPUT: + RETVAL + +# end. diff --git a/contrib/perl5/ext/DynaLoader/dl_cygwin32.xs b/contrib/perl5/ext/DynaLoader/dl_cygwin32.xs index 2b75637..b64ab3e 100644 --- a/contrib/perl5/ext/DynaLoader/dl_cygwin32.xs +++ b/contrib/perl5/ext/DynaLoader/dl_cygwin32.xs @@ -82,11 +82,11 @@ dl_load_file(filename,flags=0) int flags PREINIT: CODE: - DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); + DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename)); RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ; - DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL){ SaveError("%d",GetLastError()) ; @@ -113,10 +113,10 @@ dl_find_symbol(libhandle, symbolname) void * libhandle char * symbolname CODE: - DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n", libhandle, symbolname)); RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname); - DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError("%d",GetLastError()) ; @@ -138,7 +138,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); diff --git a/contrib/perl5/ext/DynaLoader/dl_mpeix.xs b/contrib/perl5/ext/DynaLoader/dl_mpeix.xs index 808c3b0..4cc07ec 100644 --- a/contrib/perl5/ext/DynaLoader/dl_mpeix.xs +++ b/contrib/perl5/ext/DynaLoader/dl_mpeix.xs @@ -2,6 +2,7 @@ * Author: Mark Klein (mklein@dis.com) * Version: 2.1, 1996/07/25 * Version: 2.2, 1997/09/25 Mark Bixby (markb@cccd.edu) + * Version: 2.3, 1998/11/19 Mark Bixby (markb@cccd.edu) */ #include "EXTERN.h" @@ -59,13 +60,13 @@ flags)); ",filename); obj = (p_mpe_dld) safemalloc(sizeof(t_mpe_dld)); memzero(obj, sizeof(t_mpe_dld)); - if (filename[0] == '.') + if (filename[0] != '/') { getcwd(buf,sizeof(buf)); - sprintf(obj->filename,"$%s/%s$",buf,filename); + sprintf(obj->filename," %s/%s ",buf,filename); } else - sprintf(obj->filename,"$%s$",filename); + sprintf(obj->filename," %s ",filename); DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", obj)); @@ -90,11 +91,11 @@ dl_find_symbol(libhandle, symbolname) ST(0) = sv_newmortal() ; errno = 0; - sprintf(symname, "$%s$", symbolname); + sprintf(symname, " %s ", symbolname); HPGETPROCPLABEL(8, symname, &symaddr, &status, obj->filename, 1, 0, &datalen, 1, 0, 0); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref(PROCEDURE) = %x\n", symaddr)); + DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref(PROCEDURE) = %x, status=%x\n", symaddr, status)); if (status != 0) { SaveError("%s",(errno) ? Strerror(errno) : "Symbol not found") ; diff --git a/contrib/perl5/ext/DynaLoader/dl_next.xs b/contrib/perl5/ext/DynaLoader/dl_next.xs index 2b547f0..dfa8a3e 100644 --- a/contrib/perl5/ext/DynaLoader/dl_next.xs +++ b/contrib/perl5/ext/DynaLoader/dl_next.xs @@ -172,6 +172,7 @@ static char *dlopen(char *path, int mode /* mode is ignored */) I32 i, psize; char *result; char **p; + STRLEN n_a; /* Do not load what is already loaded into this process */ if (hv_fetch(dl_loaded_files, path, strlen(path), 0)) @@ -182,7 +183,7 @@ static char *dlopen(char *path, int mode /* mode is ignored */) 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), PL_na); + 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, diff --git a/contrib/perl5/ext/DynaLoader/dl_vms.xs b/contrib/perl5/ext/DynaLoader/dl_vms.xs index 974fd58..08fd2f3 100644 --- a/contrib/perl5/ext/DynaLoader/dl_vms.xs +++ b/contrib/perl5/ext/DynaLoader/dl_vms.xs @@ -1,7 +1,7 @@ /* dl_vms.xs * * Platform: OpenVMS, VAX or AXP - * Author: Charles Bailey bailey@genetics.upenn.edu + * Author: Charles Bailey bailey@newman.upenn.edu * Revised: 12-Dec-1994 * * Implementation Note |
