1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
/*
* 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.
|
