1 /* 2 * Author: Jeff Okamoto (okamoto@corp.hp.com) 3 * Version: 2.1, 1995/1/25 4 */ 5 6 /* o Added BIND_VERBOSE to dl_nonlazy condition to add names of missing 7 * symbols to stderr message on fatal error. 8 * 9 * o Added BIND_NONFATAL comment to default condition. 10 * 11 * Chuck Phillips (cdp@fc.hp.com) 12 * Version: 2.2, 1997/5/4 */ 13 14 #ifdef __hp9000s300 15 #define magic hpux_magic 16 #define MAGIC HPUX_MAGIC 17 #endif 18 19 #include <dl.h> 20 #ifdef __hp9000s300 21 #undef magic 22 #undef MAGIC 23 #endif 24 25 #define PERL_EXT 26 #include "EXTERN.h" 27 #define PERL_IN_DL_HPUX_XS 28 #include "perl.h" 29 #include "XSUB.h" 30 31 typedef struct { 32 AV * x_resolve_using; 33 } my_cxtx_t; /* this *must* be named my_cxtx_t */ 34 35 #define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ 36 #include "dlutils.c" /* for SaveError() etc */ 37 38 #define dl_resolve_using (dl_cxtx.x_resolve_using) 39 40 static void 41 dl_private_init(pTHX) 42 { 43 (void)dl_generic_private_init(aTHX); 44 { 45 dMY_CXT; 46 dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); 47 } 48 } 49 50 MODULE = DynaLoader PACKAGE = DynaLoader 51 52 BOOT: 53 (void)dl_private_init(aTHX); 54 55 56 void 57 dl_load_file(filename, flags=0) 58 char * filename 59 int flags 60 PREINIT: 61 shl_t obj = NULL; 62 int i, max, bind_type; 63 dMY_CXT; 64 CODE: 65 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); 66 if (flags & 0x01) 67 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); 68 if (dl_nonlazy) { 69 bind_type = BIND_IMMEDIATE|BIND_VERBOSE; 70 } else { 71 bind_type = BIND_DEFERRED; 72 /* For certain libraries, like DCE, deferred binding often causes run 73 * time problems. Adding BIND_NONFATAL to BIND_IMMEDIATE still allows 74 * unresolved references in situations like this. */ 75 /* bind_type = BIND_IMMEDIATE|BIND_NONFATAL; */ 76 } 77 /* BIND_NOSTART removed from bind_type because it causes the shared library's */ 78 /* initialisers not to be run. This causes problems with all of the static objects */ 79 /* in the library. */ 80 #ifdef DEBUGGING 81 if (dl_debug) 82 bind_type |= BIND_VERBOSE; 83 #endif /* DEBUGGING */ 84 85 max = AvFILL(dl_resolve_using); 86 for (i = 0; i <= max; i++) { 87 char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0)); 88 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s) (dependent)\n", sym)); 89 obj = shl_load(sym, bind_type, 0L); 90 if (obj == NULL) { 91 goto end; 92 } 93 } 94 95 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s): ", filename)); 96 obj = shl_load(filename, bind_type, 0L); 97 98 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%p\n", (void*)obj)); 99 end: 100 ST(0) = sv_newmortal() ; 101 if (obj == NULL) 102 SaveError(aTHX_ "%s",Strerror(errno)); 103 else 104 sv_setiv( ST(0), PTR2IV(obj) ); 105 106 107 int 108 dl_unload_file(libref) 109 void * libref 110 CODE: 111 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref))); 112 RETVAL = (shl_unload((shl_t)libref) == 0 ? 1 : 0); 113 if (!RETVAL) 114 SaveError(aTHX_ "%s", Strerror(errno)); 115 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL)); 116 OUTPUT: 117 RETVAL 118 119 120 void 121 dl_find_symbol(libhandle, symbolname, ign_err=0) 122 void * libhandle 123 char * symbolname 124 int ign_err 125 PREINIT: 126 shl_t obj = (shl_t) libhandle; 127 void *symaddr = NULL; 128 int status; 129 CODE: 130 #ifdef __hp9000s300 131 symbolname = Perl_form_nocontext("_%s", symbolname); 132 #endif 133 DLDEBUG(2, PerlIO_printf(Perl_debug_log, 134 "dl_find_symbol(handle=%lx, symbol=%s)\n", 135 (unsigned long) libhandle, symbolname)); 136 137 ST(0) = sv_newmortal() ; 138 errno = 0; 139 140 status = shl_findsym(&obj, symbolname, TYPE_PROCEDURE, &symaddr); 141 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref(PROCEDURE) = %p\n", (void*)symaddr)); 142 143 if (status == -1 && errno == 0) { /* try TYPE_DATA instead */ 144 status = shl_findsym(&obj, symbolname, TYPE_DATA, &symaddr); 145 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref(DATA) = %p\n", (void*)symaddr)); 146 } 147 148 if (status == -1) { 149 if (!ign_err) SaveError(aTHX_ "%s",(errno) ? Strerror(errno) : "Symbol not found") ; 150 } else { 151 sv_setiv( ST(0), PTR2IV(symaddr) ); 152 } 153 154 155 void 156 dl_undef_symbols() 157 CODE: 158 159 160 161 # These functions should not need changing on any platform: 162 163 void 164 dl_install_xsub(perl_name, symref, filename="$Package") 165 char * perl_name 166 void * symref 167 const char * filename 168 CODE: 169 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%p)\n", 170 perl_name, (void*)symref)); 171 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name, 172 (void(*)(pTHX_ CV *))symref, 173 filename, NULL, 174 XS_DYNAMIC_FILENAME))); 175 176 SV * 177 dl_error() 178 CODE: 179 dMY_CXT; 180 RETVAL = newSVsv(MY_CXT.x_dl_last_error); 181 OUTPUT: 182 RETVAL 183 184 #if defined(USE_ITHREADS) 185 186 void 187 CLONE(...) 188 CODE: 189 MY_CXT_CLONE; 190 191 PERL_UNUSED_VAR(items); 192 193 /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid 194 * using Perl variables that belong to another thread, we create our 195 * own for this thread. 196 */ 197 MY_CXT.x_dl_last_error = newSVpvs(""); 198 dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); 199 200 #endif 201 202 # end. 203