Commit | Line | Data |
---|---|---|
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 | ||
20 | static void | |
cea2e8a9 | 21 | dl_private_init(pTHX) |
46193409 | 22 | { |
cea2e8a9 | 23 | (void)dl_generic_private_init(aTHX); |
46193409 JH |
24 | } |
25 | ||
26 | MODULE = DynaLoader PACKAGE = DynaLoader | |
27 | ||
28 | BOOT: | |
cea2e8a9 | 29 | (void)dl_private_init(aTHX); |
46193409 JH |
30 | |
31 | ||
32 | void * | |
33 | dl_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 | ||
48 | DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", path, flags)); | |
49 | bogo = load_add_on(path); | |
50 | DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL)); | |
51 | ST(0) = sv_newmortal() ; | |
52 | if (bogo < 0) { | |
cea2e8a9 | 53 | SaveError(aTHX_ "%s", strerror(bogo)); |
c78749f2 | 54 | PerlIO_printf(PerlIO_stderr(), "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo)); |
46193409 JH |
55 | } else { |
56 | RETVAL = (void *) bogo; | |
57 | sv_setiv( ST(0), (IV)RETVAL); | |
58 | } | |
59 | free(path); | |
60 | } | |
61 | ||
62 | void * | |
63 | dl_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 | |
70 | symbolname = form("_%s", symbolname); | |
71 | #endif | |
72 | RETVAL = NULL; | |
73 | DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), | |
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; | |
79 | DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), | |
80 | " symbolref = %lx\n", (unsigned long) RETVAL)); | |
81 | ST(0) = sv_newmortal() ; | |
82 | if (RETVAL == NULL) { | |
cea2e8a9 | 83 | SaveError(aTHX_ "%s", strerror(retcode)) ; |
c78749f2 | 84 | PerlIO_printf(PerlIO_stderr(), "retcode = %p (%s)\n", retcode, strerror(retcode)); |
46193409 JH |
85 | } else |
86 | sv_setiv( ST(0), (IV)RETVAL); | |
87 | ||
88 | ||
89 | void | |
90 | dl_undef_symbols() | |
91 | PPCODE: | |
92 | ||
93 | ||
94 | ||
95 | # These functions should not need changing on any platform: | |
96 | ||
97 | void | |
98 | dl_install_xsub(perl_name, symref, filename="$Package") | |
99 | char * perl_name | |
100 | void * symref | |
101 | char * filename | |
102 | CODE: | |
103 | DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n", | |
104 | perl_name, (unsigned long) symref)); | |
cea2e8a9 GS |
105 | ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, |
106 | (void(*)(pTHX_ CV *))symref, | |
107 | filename))); | |
46193409 JH |
108 | |
109 | ||
110 | char * | |
111 | dl_error() | |
112 | CODE: | |
113 | RETVAL = LastError ; | |
114 | OUTPUT: | |
115 | RETVAL | |
116 | ||
117 | # end. |