Commit | Line | Data |
46193409 |
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 |
24 | } |
25 | |
26 | MODULE = DynaLoader PACKAGE = DynaLoader |
27 | |
28 | BOOT: |
cea2e8a9 |
29 | (void)dl_private_init(aTHX); |
46193409 |
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 |
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 |
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 |
105 | ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, |
106 | (void(*)(pTHX_ CV *))symref, |
107 | filename))); |
46193409 |
108 | |
109 | |
110 | char * |
111 | dl_error() |
112 | CODE: |
113 | RETVAL = LastError ; |
114 | OUTPUT: |
115 | RETVAL |
116 | |
117 | # end. |