Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 119 lines (98 sloc) 2.713 kb
4619340 @jhi BeOS update (Mirror maint-5.005 change #2727).
jhi authored
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
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored
21 dl_private_init(pTHX)
4619340 @jhi BeOS update (Mirror maint-5.005 change #2727).
jhi authored
22 {
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored
23 (void)dl_generic_private_init(aTHX);
4619340 @jhi BeOS update (Mirror maint-5.005 change #2727).
jhi authored
24 }
25
26 MODULE = DynaLoader PACKAGE = DynaLoader
27
28 BOOT:
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored
29 (void)dl_private_init(aTHX);
4619340 @jhi BeOS update (Mirror maint-5.005 change #2727).
jhi authored
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
bf49b05 make die/warn and other diagnostics go to wherever STDERR happens
Gurusamy Sarathy authored
48 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", path, flags));
4619340 @jhi BeOS update (Mirror maint-5.005 change #2727).
jhi authored
49 bogo = load_add_on(path);
bf49b05 make die/warn and other diagnostics go to wherever STDERR happens
Gurusamy Sarathy authored
50 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL));
4619340 @jhi BeOS update (Mirror maint-5.005 change #2727).
jhi authored
51 ST(0) = sv_newmortal() ;
52 if (bogo < 0) {
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored
53 SaveError(aTHX_ "%s", strerror(bogo));
bf49b05 make die/warn and other diagnostics go to wherever STDERR happens
Gurusamy Sarathy authored
54 PerlIO_printf(Perl_debug_log, "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo));
4619340 @jhi BeOS update (Mirror maint-5.005 change #2727).
jhi authored
55 } else {
56 RETVAL = (void *) bogo;
3175b8c @jhi Small doc and whitespace edits.
jhi authored
57 sv_setiv( ST(0), PTR2IV(RETVAL) );
4619340 @jhi BeOS update (Mirror maint-5.005 change #2727).
jhi authored
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
7a3f225 usethreads build fixups for NeXTstep (as suggested by Hans Mulder)
Gurusamy Sarathy authored
70 symbolname = Perl_form_nocontext("_%s", symbolname);
4619340 @jhi BeOS update (Mirror maint-5.005 change #2727).
jhi authored
71 #endif
72 RETVAL = NULL;
bf49b05 make die/warn and other diagnostics go to wherever STDERR happens
Gurusamy Sarathy authored
73 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
4619340 @jhi BeOS update (Mirror maint-5.005 change #2727).
jhi authored
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;
bf49b05 make die/warn and other diagnostics go to wherever STDERR happens
Gurusamy Sarathy authored
79 DLDEBUG(2, PerlIO_printf(Perl_debug_log,
4619340 @jhi BeOS update (Mirror maint-5.005 change #2727).
jhi authored
80 " symbolref = %lx\n", (unsigned long) RETVAL));
81 ST(0) = sv_newmortal() ;
82 if (RETVAL == NULL) {
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored
83 SaveError(aTHX_ "%s", strerror(retcode)) ;
bf49b05 make die/warn and other diagnostics go to wherever STDERR happens
Gurusamy Sarathy authored
84 PerlIO_printf(Perl_debug_log, "retcode = %p (%s)\n", retcode, strerror(retcode));
4619340 @jhi BeOS update (Mirror maint-5.005 change #2727).
jhi authored
85 } else
f66f545 @jhi Change #4136 edited DynaLoader.xs which is kind of fruitless.
jhi authored
86 sv_setiv( ST(0), PTR2IV(RETVAL));
4619340 @jhi BeOS update (Mirror maint-5.005 change #2727).
jhi authored
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:
bf49b05 make die/warn and other diagnostics go to wherever STDERR happens
Gurusamy Sarathy authored
103 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n",
4619340 @jhi BeOS update (Mirror maint-5.005 change #2727).
jhi authored
104 perl_name, (unsigned long) symref));
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored
105 ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
106 (void(*)(pTHX_ CV *))symref,
107 filename)));
4619340 @jhi BeOS update (Mirror maint-5.005 change #2727).
jhi authored
108
109
110 char *
111 dl_error()
112 CODE:
cdc73a1 @jhi Integrate change #12626 from maintperl;
jhi authored
113 dMY_CXT;
114 RETVAL = dl_last_error ;
4619340 @jhi BeOS update (Mirror maint-5.005 change #2727).
jhi authored
115 OUTPUT:
116 RETVAL
117
118 # end.
Something went wrong with that request. Please try again.