summaryrefslogtreecommitdiff
path: root/ext/DynaLoader/dl_beos.xs
blob: 4e773df202ac3017ba2718a440ba2a5b801c1eb3 (plain)
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
/*
 * 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()
{
    (void)dl_generic_private_init();
}

MODULE = DynaLoader	PACKAGE = DynaLoader

BOOT:
    (void)dl_private_init();


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(PerlIO_stderr(), "dl_load_file(%s,%x):\n", path, flags));
    bogo = load_add_on(path);
    DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL));
    ST(0) = sv_newmortal() ;
    if (bogo < 0) {
	SaveError("%s", strerror(bogo));
	PerlIO_printf(PerlIO_stderr(), "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo));
    } else {
	RETVAL = (void *) bogo;
	sv_setiv( ST(0), (IV)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 = form("_%s", symbolname);
#endif
    RETVAL = NULL;
    DLDEBUG(2, PerlIO_printf(PerlIO_stderr(),
			     "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(PerlIO_stderr(),
			     "  symbolref = %lx\n", (unsigned long) RETVAL));
    ST(0) = sv_newmortal() ;
    if (RETVAL == NULL) {
	SaveError("%s", strerror(retcode)) ;
	PerlIO_printf(PerlIO_stderr(), "retcode = %p (%s)\n", retcode, strerror(retcode));
    } else
	sv_setiv( ST(0), (IV)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(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n",
		perl_name, (unsigned long) symref));
    ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(CV *))symref, filename)));


char *
dl_error()
    CODE:
    RETVAL = LastError ;
    OUTPUT:
    RETVAL

# end.