This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix bug in DynaLoader, which has been passing a filename in dynamic
[perl5.git] / ext / DynaLoader / dl_beos.xs
CommitLineData
46193409
JH
1/*
2 * dl_beos.xs, by Tom Spindler
3 * based on dl_dlopen.xs, by Paul Marquess
4 * $Id:$
5 */
6
7#include "EXTERN.h"
8#include "perl.h"
9#include "XSUB.h"
10
11#include <be/kernel/image.h>
12#include <OS.h>
13#include <stdlib.h>
14#include <limits.h>
15
16#define dlerror() strerror(errno)
17
18#include "dlutils.c" /* SaveError() etc */
19
20static void
cea2e8a9 21dl_private_init(pTHX)
46193409 22{
cea2e8a9 23 (void)dl_generic_private_init(aTHX);
46193409
JH
24}
25
26MODULE = DynaLoader PACKAGE = DynaLoader
27
28BOOT:
cea2e8a9 29 (void)dl_private_init(aTHX);
46193409
JH
30
31
32void *
33dl_load_file(filename, flags=0)
34 char * filename
35 int flags
36 CODE:
37{ image_id bogo;
38 char *path;
39 path = malloc(PATH_MAX);
40 if (*filename != '/') {
41 getcwd(path, PATH_MAX);
42 strcat(path, "/");
43 strcat(path, filename);
44 } else {
45 strcpy(path, filename);
46 }
47
bf49b057 48 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", path, flags));
46193409 49 bogo = load_add_on(path);
bf49b057 50 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
46193409
JH
51 ST(0) = sv_newmortal() ;
52 if (bogo < 0) {
cea2e8a9 53 SaveError(aTHX_ "%s", strerror(bogo));
bf49b057 54 PerlIO_printf(Perl_debug_log, "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo));
46193409
JH
55 } else {
56 RETVAL = (void *) bogo;
3175b8cd 57 sv_setiv( ST(0), PTR2IV(RETVAL) );
46193409
JH
58 }
59 free(path);
60}
61
62void *
63dl_find_symbol(libhandle, symbolname)
64 void * libhandle
65 char * symbolname
66 CODE:
67 status_t retcode;
68 void *adr = 0;
69#ifdef DLSYM_NEEDS_UNDERSCORE
7a3f2258 70 symbolname = Perl_form_nocontext("_%s", symbolname);
46193409
JH
71#endif
72 RETVAL = NULL;
bf49b057 73 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
46193409
JH
74 "dl_find_symbol(handle=%lx, symbol=%s)\n",
75 (unsigned long) libhandle, symbolname));
76 retcode = get_image_symbol((image_id) libhandle, symbolname,
77 B_SYMBOL_TYPE_TEXT, (void **) &adr);
78 RETVAL = adr;
bf49b057 79 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
46193409
JH
80 " symbolref = %lx\n", (unsigned long) RETVAL));
81 ST(0) = sv_newmortal() ;
82 if (RETVAL == NULL) {
cea2e8a9 83 SaveError(aTHX_ "%s", strerror(retcode)) ;
bf49b057 84 PerlIO_printf(Perl_debug_log, "retcode = %p (%s)\n", retcode, strerror(retcode));
46193409 85 } else
f66f545a 86 sv_setiv( ST(0), PTR2IV(RETVAL));
46193409
JH
87
88
89void
90dl_undef_symbols()
91 PPCODE:
92
93
94
95# These functions should not need changing on any platform:
96
97void
98dl_install_xsub(perl_name, symref, filename="$Package")
99 char * perl_name
100 void * symref
101 char * filename
102 CODE:
bf49b057 103 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
46193409 104 perl_name, (unsigned long) symref));
77004dee
NC
105 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
106 (void(*)(pTHX_ CV *))symref,
107 filename, NULL,
108 XS_DYNAMIC_FILENAME)));
46193409
JH
109
110
111char *
112dl_error()
113 CODE:
cdc73a10
JH
114 dMY_CXT;
115 RETVAL = dl_last_error ;
46193409
JH
116 OUTPUT:
117 RETVAL
118
119# end.