Commit | Line | Data |
---|---|---|
1d84e8df JH |
1 | /* |
2 | * Author: Mark Klein (mklein@dis.com) | |
3 | * Version: 2.1, 1996/07/25 | |
4 | * Version: 2.2, 1997/09/25 Mark Bixby (markb@cccd.edu) | |
9d7f10f2 | 5 | * Version: 2.3, 1998/11/19 Mark Bixby (markb@cccd.edu) |
feb33499 | 6 | * Version: 2.4, 2002/03/24 Mark Bixby (mark@bixby.org) |
1d84e8df JH |
7 | */ |
8 | ||
9 | #include "EXTERN.h" | |
10 | #include "perl.h" | |
11 | #include "XSUB.h" | |
12 | ||
13 | #ifdef __GNUC__ | |
14 | extern void HPGETPROCPLABEL( int parms, | |
15 | char * procname, | |
feb33499 | 16 | void * plabel, |
1d84e8df JH |
17 | int * status, |
18 | char * firstfile, | |
19 | int casesensitive, | |
20 | int symboltype, | |
21 | int * datasize, | |
22 | int position, | |
23 | int searchpath, | |
24 | int binding); | |
25 | #else | |
26 | #pragma intrinsic HPGETPROCPLABEL | |
27 | #endif | |
28 | #include "dlutils.c" /* for SaveError() etc */ | |
29 | ||
30 | typedef struct { | |
31 | char filename[PATH_MAX + 3]; | |
32 | } t_mpe_dld, *p_mpe_dld; | |
33 | ||
1d84e8df | 34 | static void |
cea2e8a9 | 35 | dl_private_init(pTHX) |
1d84e8df | 36 | { |
cea2e8a9 | 37 | (void)dl_generic_private_init(aTHX); |
1d84e8df JH |
38 | } |
39 | ||
40 | MODULE = DynaLoader PACKAGE = DynaLoader | |
41 | ||
42 | BOOT: | |
cea2e8a9 | 43 | (void)dl_private_init(aTHX); |
1d84e8df JH |
44 | |
45 | void * | |
46 | dl_load_file(filename, flags=0) | |
47 | char * filename | |
48 | int flags | |
49 | PREINIT: | |
50 | char buf[PATH_MAX + 3]; | |
51 | p_mpe_dld obj = NULL; | |
d05c1ba0 | 52 | |
1d84e8df | 53 | CODE: |
bf49b057 | 54 | DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename, |
1d84e8df JH |
55 | flags)); |
56 | if (flags & 0x01) | |
4cbfc073 JH |
57 | Perl_warn(aTHX_ |
58 | "Can't make loaded symbols global on this platform while loading %s",filename); | |
1d84e8df JH |
59 | obj = (p_mpe_dld) safemalloc(sizeof(t_mpe_dld)); |
60 | memzero(obj, sizeof(t_mpe_dld)); | |
9d7f10f2 | 61 | if (filename[0] != '/') |
1d84e8df JH |
62 | { |
63 | getcwd(buf,sizeof(buf)); | |
9d7f10f2 | 64 | sprintf(obj->filename," %s/%s ",buf,filename); |
1d84e8df JH |
65 | } |
66 | else | |
9d7f10f2 | 67 | sprintf(obj->filename," %s ",filename); |
1d84e8df | 68 | |
bf49b057 | 69 | DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", obj)); |
1d84e8df JH |
70 | |
71 | ST(0) = sv_newmortal() ; | |
72 | if (obj == NULL) | |
cea2e8a9 | 73 | SaveError(aTHX_"%s",Strerror(errno)); |
1d84e8df | 74 | else |
3175b8cd | 75 | sv_setiv( ST(0), PTR2IV(obj) ); |
1d84e8df JH |
76 | |
77 | void * | |
78 | dl_find_symbol(libhandle, symbolname) | |
79 | void * libhandle | |
80 | char * symbolname | |
81 | CODE: | |
82 | int datalen; | |
83 | p_mpe_dld obj = (p_mpe_dld) libhandle; | |
84 | char symname[PATH_MAX + 3]; | |
85 | void * symaddr = NULL; | |
86 | int status; | |
bf49b057 | 87 | DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n", |
1d84e8df JH |
88 | libhandle, symbolname)); |
89 | ST(0) = sv_newmortal() ; | |
90 | errno = 0; | |
91 | ||
9d7f10f2 | 92 | sprintf(symname, " %s ", symbolname); |
1d84e8df JH |
93 | HPGETPROCPLABEL(8, symname, &symaddr, &status, obj->filename, 1, |
94 | 0, &datalen, 1, 0, 0); | |
95 | ||
bf49b057 | 96 | DLDEBUG(2,PerlIO_printf(Perl_debug_log," symbolref(PROCEDURE) = %x, status=%x\n", symaddr, status)); |
1d84e8df JH |
97 | |
98 | if (status != 0) { | |
cea2e8a9 | 99 | SaveError(aTHX_"%s",(errno) ? Strerror(errno) : "Symbol not found") ; |
1d84e8df | 100 | } else { |
3175b8cd | 101 | sv_setiv( ST(0), PTR2IV(symaddr) ); |
1d84e8df JH |
102 | } |
103 | ||
104 | void | |
105 | dl_undef_symbols() | |
106 | PPCODE: | |
107 | ||
108 | # These functions should not need changing on any platform: | |
109 | ||
110 | void | |
111 | dl_install_xsub(perl_name, symref, filename="$Package") | |
112 | char * perl_name | |
113 | void * symref | |
114 | char * filename | |
115 | CODE: | |
bf49b057 | 116 | DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n", |
1d84e8df | 117 | perl_name, symref)); |
77004dee NC |
118 | ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name, |
119 | (void(*)(pTHX_ CV *))symref, | |
120 | filename, NULL, | |
121 | XS_DYNAMIC_FILENAME))); | |
1d84e8df JH |
122 | |
123 | char * | |
124 | dl_error() | |
125 | CODE: | |
cdc73a10 JH |
126 | dMY_CXT; |
127 | RETVAL = dl_last_error ; | |
1d84e8df JH |
128 | OUTPUT: |
129 | RETVAL | |
130 | ||
131 | # end. |