1 /* 2 * Written 3/1/94, Robert Sanders <Robert.Sanders@linux.org> 3 * 4 * based upon the file "dl.c", which is 5 * Copyright (c) 1994, Larry Wall 6 * 7 * You may distribute under the terms of either the GNU General Public 8 * License or the Artistic License, as specified in the README file. 9 * 10 * $Date: 1994/03/07 00:21:43 $ 11 * $Source: /home/rsanders/src/perl5alpha6/RCS/dld_dl.c,v $ 12 * $Revision: 1.4 $ 13 * $State: Exp $ 14 * 15 * Adapted for use with FreeMINT after dld support was removed from perl. 16 * 17 * $Log: dld_dl.c,v $ 18 * Removed implicit link against libc. 1994/09/14 William Setzer. 19 * 20 * Integrated other DynaLoader changes. 1994/06/08 Tim Bunce. 21 * 22 * rewrote dl_load_file, misc updates. 1994/09/03 William Setzer. 23 * 24 * Revision 1.4 1994/03/07 00:21:43 rsanders 25 * added min symbol count for load_libs and switched order so system libs 26 * are loaded after app-specified libs. 27 * 28 * Revision 1.3 1994/03/05 01:17:26 rsanders 29 * added path searching. 30 * 31 * Revision 1.2 1994/03/05 00:52:39 rsanders 32 * added package-specified libraries. 33 * 34 * Revision 1.1 1994/03/05 00:33:40 rsanders 35 * Initial revision 36 * 37 * 38 */ 39 40 #define PERL_EXT 41 #include "EXTERN.h" 42 #define PERL_IN_DL_FREEMINT_XS 43 #include "perl.h" 44 #include "XSUB.h" 45 46 #include <dld.h> /* GNU DLD header file */ 47 #include <unistd.h> 48 49 typedef struct { 50 AV * x_resolve_using; 51 AV * x_require_symbols; 52 } my_cxtx_t; /* this *must* be named my_cxtx_t */ 53 54 #define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */ 55 #include "dlutils.c" /* for SaveError() etc */ 56 57 #define dl_resolve_using (dl_cxtx.x_resolve_using) 58 #define dl_require_symbols (dl_cxtx.x_require_symbols) 59 60 static void 61 dl_private_init(pTHX) 62 { 63 dl_generic_private_init(aTHX); 64 { 65 int dlderr; 66 dMY_CXT; 67 68 dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); 69 dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI); 70 dlderr = dld_init("/kern/self/exe"); 71 if (dlderr) { 72 dlderr = dld_init(dld_find_executable(PL_origargv[0])); 73 if (dlderr) { 74 char *msg = dld_strerror(dlderr); 75 SaveError(aTHX_ "dld_init(%s) failed: %s", dld_find_executable(PL_origargv[0]), msg); 76 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "%s", dl_last_error)); 77 } 78 } 79 } 80 } 81 82 83 MODULE = DynaLoader PACKAGE = DynaLoader 84 85 BOOT: 86 (void)dl_private_init(); 87 88 89 void 90 dl_load_file(filename, flags=0) 91 char * filename 92 int flags 93 PREINIT: 94 int dlderr,x,max; 95 GV *gv; 96 dMY_CXT; 97 CODE: 98 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); 99 if (flags & 0x01) 100 Perl_croak(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); 101 max = AvFILL(dl_require_symbols); 102 for (x = 0; x <= max; x++) { 103 char *sym = SvPVX(*av_fetch(dl_require_symbols, x, 0)); 104 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_create_ref(%s)\n", sym)); 105 if (dlderr = dld_create_reference(sym)) { 106 SaveError(aTHX_ "dld_create_reference(%s): %s", sym, 107 dld_strerror(dlderr)); 108 goto haverror; 109 } 110 } 111 112 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", filename)); 113 if (dlderr = dld_link(filename)) { 114 SaveError(aTHX_ "dld_link(%s): %s", filename, dld_strerror(dlderr)); 115 goto haverror; 116 } 117 118 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(libm.a)\n")); 119 if (dlderr = dld_link("/usr/lib/libm.a")) { 120 SaveError(aTHX_ "dld_link(libm.a): %s", dld_strerror(dlderr)); 121 goto haverror; 122 } 123 124 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(libc.a)\n")); 125 if (dlderr = dld_link("/usr/lib/libc.a")) { 126 SaveError(aTHX_ "dld_link(libc.a): %s", dld_strerror(dlderr)); 127 goto haverror; 128 } 129 130 max = AvFILL(dl_resolve_using); 131 for (x = 0; x <= max; x++) { 132 char *sym = SvPVX(*av_fetch(dl_resolve_using, x, 0)); 133 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", sym)); 134 if (dlderr = dld_link(sym)) { 135 SaveError(aTHX_ "dld_link(%s): %s", sym, dld_strerror(dlderr)); 136 goto haverror; 137 } 138 } 139 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "libref=%s\n", filename)); 140 haverror: 141 ST(0) = sv_newmortal() ; 142 if (dlderr == 0) 143 sv_setiv(ST(0), PTR2IV(filename)); 144 XSRETURN(1); 145 146 147 void 148 dl_find_symbol(libhandle, symbolname, ign_err=0) 149 void * libhandle 150 char * symbolname 151 int ign_err 152 PREINIT: 153 void *retv; 154 CODE: 155 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n", 156 libhandle, symbolname)); 157 retv = (void *)dld_get_func(symbolname); 158 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref = %x\n", (unsigned int)retv)); 159 ST(0) = sv_newmortal() ; 160 if (retv == NULL) { 161 if (!ign_err) 162 SaveError(aTHX_ "dl_find_symbol: Unable to find '%s' symbol", symbolname) ; 163 } else 164 sv_setiv(ST(0), PTR2IV(retv)); 165 XSRETURN(1); 166 167 168 void 169 dl_undef_symbols() 170 PPCODE: 171 if (dld_undefined_sym_count) { 172 int x; 173 char **undef_syms = dld_list_undefined_sym(); 174 EXTEND(SP, dld_undefined_sym_count); 175 for (x=0; x < dld_undefined_sym_count; x++) 176 PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0))); 177 free(undef_syms); 178 } 179 180 181 182 # These functions should not need changing on any platform: 183 184 void 185 dl_install_xsub(perl_name, symref, filename="$Package") 186 char * perl_name 187 void * symref 188 const char * filename 189 CODE: 190 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", 191 perl_name, symref)); 192 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name, 193 (void(*)(pTHX_ CV *))symref, 194 filename, NULL, 195 XS_DYNAMIC_FILENAME))); 196 XSRETURN(1); 197 198 SV * 199 dl_error() 200 CODE: 201 dMY_CXT; 202 RETVAL = newSVsv(MY_CXT.x_dl_last_error); 203 OUTPUT: 204 RETVAL 205 206 #if defined(USE_ITHREADS) 207 208 void 209 CLONE(...) 210 CODE: 211 MY_CXT_CLONE; 212 213 /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid 214 * using Perl variables that belong to another thread, we create our 215 * own for this thread. 216 */ 217 MY_CXT.x_dl_last_error = newSVpvs(""); 218 dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); 219 dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI); 220 221 #endif 222 223 # end. 224