Commit | Line | Data |
---|---|---|
46193409 JH |
1 | /* |
2 | * dl_beos.xs, by Tom Spindler | |
3 | * based on dl_dlopen.xs, by Paul Marquess | |
46193409 JH |
4 | */ |
5 | ||
6 | #include "EXTERN.h" | |
7 | #include "perl.h" | |
8 | #include "XSUB.h" | |
9 | ||
10 | #include <be/kernel/image.h> | |
11 | #include <OS.h> | |
12 | #include <stdlib.h> | |
13 | #include <limits.h> | |
14 | ||
15 | #define dlerror() strerror(errno) | |
16 | ||
17 | #include "dlutils.c" /* SaveError() etc */ | |
18 | ||
19 | static void | |
cea2e8a9 | 20 | dl_private_init(pTHX) |
46193409 | 21 | { |
cea2e8a9 | 22 | (void)dl_generic_private_init(aTHX); |
46193409 JH |
23 | } |
24 | ||
25 | MODULE = DynaLoader PACKAGE = DynaLoader | |
26 | ||
27 | BOOT: | |
cea2e8a9 | 28 | (void)dl_private_init(aTHX); |
46193409 JH |
29 | |
30 | ||
31 | void * | |
32 | dl_load_file(filename, flags=0) | |
33 | char * filename | |
34 | int flags | |
35 | CODE: | |
36 | { image_id bogo; | |
37 | char *path; | |
38 | path = malloc(PATH_MAX); | |
39 | if (*filename != '/') { | |
40 | getcwd(path, PATH_MAX); | |
41 | strcat(path, "/"); | |
42 | strcat(path, filename); | |
43 | } else { | |
44 | strcpy(path, filename); | |
45 | } | |
46 | ||
bf49b057 | 47 | DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", path, flags)); |
46193409 | 48 | bogo = load_add_on(path); |
bf49b057 | 49 | DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL)); |
46193409 JH |
50 | ST(0) = sv_newmortal() ; |
51 | if (bogo < 0) { | |
cea2e8a9 | 52 | SaveError(aTHX_ "%s", strerror(bogo)); |
bf49b057 | 53 | PerlIO_printf(Perl_debug_log, "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo)); |
46193409 JH |
54 | } else { |
55 | RETVAL = (void *) bogo; | |
3175b8cd | 56 | sv_setiv( ST(0), PTR2IV(RETVAL) ); |
46193409 JH |
57 | } |
58 | free(path); | |
59 | } | |
60 | ||
61 | void * | |
62 | dl_find_symbol(libhandle, symbolname) | |
63 | void * libhandle | |
64 | char * symbolname | |
65 | CODE: | |
66 | status_t retcode; | |
67 | void *adr = 0; | |
68 | #ifdef DLSYM_NEEDS_UNDERSCORE | |
7a3f2258 | 69 | symbolname = Perl_form_nocontext("_%s", symbolname); |
46193409 JH |
70 | #endif |
71 | RETVAL = NULL; | |
bf49b057 | 72 | DLDEBUG(2, PerlIO_printf(Perl_debug_log, |
46193409 JH |
73 | "dl_find_symbol(handle=%lx, symbol=%s)\n", |
74 | (unsigned long) libhandle, symbolname)); | |
75 | retcode = get_image_symbol((image_id) libhandle, symbolname, | |
76 | B_SYMBOL_TYPE_TEXT, (void **) &adr); | |
77 | RETVAL = adr; | |
bf49b057 | 78 | DLDEBUG(2, PerlIO_printf(Perl_debug_log, |
46193409 JH |
79 | " symbolref = %lx\n", (unsigned long) RETVAL)); |
80 | ST(0) = sv_newmortal() ; | |
81 | if (RETVAL == NULL) { | |
cea2e8a9 | 82 | SaveError(aTHX_ "%s", strerror(retcode)) ; |
bf49b057 | 83 | PerlIO_printf(Perl_debug_log, "retcode = %p (%s)\n", retcode, strerror(retcode)); |
46193409 | 84 | } else |
f66f545a | 85 | sv_setiv( ST(0), PTR2IV(RETVAL)); |
46193409 JH |
86 | |
87 | ||
88 | void | |
89 | dl_undef_symbols() | |
90 | PPCODE: | |
91 | ||
92 | ||
93 | ||
94 | # These functions should not need changing on any platform: | |
95 | ||
96 | void | |
97 | dl_install_xsub(perl_name, symref, filename="$Package") | |
98 | char * perl_name | |
99 | void * symref | |
d3f5e399 | 100 | const char * filename |
46193409 | 101 | CODE: |
bf49b057 | 102 | DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n", |
46193409 | 103 | perl_name, (unsigned long) symref)); |
77004dee NC |
104 | ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name, |
105 | (void(*)(pTHX_ CV *))symref, | |
106 | filename, NULL, | |
107 | XS_DYNAMIC_FILENAME))); | |
46193409 JH |
108 | |
109 | ||
110 | char * | |
111 | dl_error() | |
112 | CODE: | |
cdc73a10 JH |
113 | dMY_CXT; |
114 | RETVAL = dl_last_error ; | |
46193409 JH |
115 | OUTPUT: |
116 | RETVAL | |
117 | ||
8c472fc1 CB |
118 | #if defined(USE_ITHREADS) |
119 | ||
120 | void | |
121 | CLONE(...) | |
122 | CODE: | |
123 | MY_CXT_CLONE; | |
124 | ||
125 | /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid | |
126 | * using Perl variables that belong to another thread, we create our | |
127 | * own for this thread. | |
128 | */ | |
129 | MY_CXT.x_dl_last_error = newSVpvn("", 0); | |
130 | ||
131 | #endif | |
132 | ||
46193409 | 133 | # end. |