mirror of
https://git.FreeBSD.org/src.git
synced 2024-12-20 11:11:24 +00:00
118 lines
2.6 KiB
Plaintext
118 lines
2.6 KiB
Plaintext
/*
|
|
* 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(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:
|
|
RETVAL = LastError ;
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
# end.
|