This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
c26824e34ee9dcd47840a7a4f2afe5a31fc14920
[perl5.git] / ext / DynaLoader / dl_beos.xs
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
21 dl_private_init(pTHX)
22 {
23     (void)dl_generic_private_init(aTHX);
24 }
25
26 MODULE = DynaLoader     PACKAGE = DynaLoader
27
28 BOOT:
29     (void)dl_private_init(aTHX);
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) {
53         SaveError(aTHX_ "%s", strerror(bogo));
54         PerlIO_printf(PerlIO_stderr(), "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo));
55     } else {
56         RETVAL = (void *) bogo;
57         sv_setiv( ST(0), PTR2IV(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) {
83         SaveError(aTHX_ "%s", strerror(retcode)) ;
84         PerlIO_printf(PerlIO_stderr(), "retcode = %p (%s)\n", retcode, strerror(retcode));
85     } else
86         sv_setiv( ST(0), PTR2IV(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));
105     ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
106                                         (void(*)(pTHX_ CV *))symref,
107                                         filename)));
108
109
110 char *
111 dl_error()
112     CODE:
113     RETVAL = LastError ;
114     OUTPUT:
115     RETVAL
116
117 # end.