This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix bug in DynaLoader, which has been passing a filename in dynamic
[perl5.git] / ext / DynaLoader / dl_aix.xs
CommitLineData
a0d0e21e
LW
1/* dl_aix.xs
2 *
3 * Written: 8/31/94 by Wayne Scott (wscott@ichips.intel.com)
4 *
5 * All I did was take Jens-Uwe Mager's libdl emulation library for
6 * AIX and merged it with the dl_dlopen.xs file to create a dynamic library
7 * package that works for AIX.
8 *
9 * I did change all malloc's, free's, strdup's, calloc's to use the perl
10 * equilvant. I also removed some stuff we will not need. Call fini()
11 * on statup... It can probably be trimmed more.
12 */
13
077440d8
MB
14#define PERLIO_NOT_STDIO 0
15
a0d0e21e 16/*
61d42ce4
JH
17 * On AIX 4.3 and above the emulation layer is not needed any more, and
18 * indeed if perl uses its emulation and perl is linked into apache
19 * which is supposed to use the native dlopen conflicts arise.
20 * Jens-Uwe Mager jum@helios.de
21 */
22#ifdef USE_NATIVE_DLOPEN
23
24#include "EXTERN.h"
25#include "perl.h"
26#include "XSUB.h"
27#include <dlfcn.h>
28
c6a08c25
JH
29#include "dlutils.c" /* SaveError() etc */
30
61d42ce4
JH
31#else
32
33/*
a0d0e21e
LW
34 * @(#)dlfcn.c 1.5 revision of 93/02/14 20:14:17
35 * This is an unpublished work copyright (c) 1992 Helios Software GmbH
36 * 3000 Hannover 1, Germany
37 */
38#include "EXTERN.h"
39#include "perl.h"
40#include "XSUB.h"
41
19e194ad
JH
42/* When building as a 64-bit binary on AIX, define this to get the
43 * correct structure definitions. Also determines the field-name
44 * macros and gates some logic in readEntries(). -- Steven N. Hirsch
45 * <hirschs@btv.ibm.com> */
46#ifdef USE_64_BIT_ALL
47# define __XCOFF64__
48# define __XCOFF32__
49#endif
50
a0d0e21e
LW
51#include <stdio.h>
52#include <errno.h>
53#include <string.h>
54#include <stdlib.h>
55#include <sys/types.h>
56#include <sys/ldr.h>
57#include <a.out.h>
7ca86468
GS
58#undef FREAD
59#undef FWRITE
a0d0e21e
LW
60#include <ldfcn.h>
61
19e194ad
JH
62#ifdef USE_64_BIT_ALL
63# define AIX_SCNHDR SCNHDR_64
64# define AIX_LDHDR LDHDR_64
65# define AIX_LDSYM LDSYM_64
66# define AIX_LDHDRSZ LDHDRSZ_64
67#else
68# define AIX_SCNHDR SCNHDR
69# define AIX_LDHDR LDHDR
70# define AIX_LDSYM LDSYM
71# define AIX_LDHDRSZ LDHDRSZ
72#endif
73
4e774c84
SB
74/* When using Perl extensions written in C++ the longer versions
75 * of load() and unload() from libC and libC_r need to be used,
76 * otherwise statics in the extensions won't get initialized right.
77 * -- Stephanie Beals <bealzy@us.ibm.com> */
bab3591f
JH
78
79/* Older AIX C compilers cannot deal with C++ double-slash comments in
80 the ibmcxx and/or xlC includes. Since we only need a single file,
81 be more fine-grained about what's included <hirschs@btv.ibm.com> */
3a7209f1 82
c88be79f
JH
83#ifdef USE_libC /* The define comes, when it comes, from hints/aix.pl. */
84# define LOAD loadAndInit
4e774c84 85# define UNLOAD terminateAndUnload
3a7209f1
JH
86# if defined(USE_vacpp_load_h)
87# include "/usr/vacpp/include/load.h"
bab3591f
JH
88# elif defined(USE_ibmcxx_load_h)
89# include "/usr/ibmcxx/include/load.h"
3a7209f1
JH
90# elif defined(USE_xlC_load_h)
91# include "/usr/lpp/xlC/include/load.h"
a660608e 92# elif defined(USE_load_h)
3a7209f1 93# include "/usr/include/load.h"
c88be79f 94# endif
4e774c84
SB
95#else
96# define LOAD load
97# define UNLOAD unload
98#endif
99
ee580363
GS
100/*
101 * AIX 4.3 does remove some useful definitions from ldfcn.h. Define
102 * these here to compensate for that lossage.
103 */
104#ifndef BEGINNING
105# define BEGINNING SEEK_SET
106#endif
107#ifndef FSEEK
108# define FSEEK(ldptr,o,p) fseek(IOPTR(ldptr),(p==BEGINNING)?(OFFSET(ldptr) +o):o,p)
109#endif
110#ifndef FREAD
111# define FREAD(p,s,n,ldptr) fread(p,s,n,IOPTR(ldptr))
112#endif
113
61d42ce4
JH
114#ifndef RTLD_LAZY
115# define RTLD_LAZY 0
116#endif
117#ifndef RTLD_GLOBAL
118# define RTLD_GLOBAL 0
119#endif
120
a0d0e21e
LW
121/*
122 * We simulate dlopen() et al. through a call to load. Because AIX has
123 * no call to find an exported symbol we read the loader section of the
124 * loaded module and build a list of exported symbols and their virtual
125 * address.
126 */
127
128typedef struct {
129 char *name; /* the symbols's name */
130 void *addr; /* its relocated virtual address */
131} Export, *ExportPtr;
132
133/*
134 * The void * handle returned from dlopen is actually a ModulePtr.
135 */
136typedef struct Module {
137 struct Module *next;
138 char *name; /* module name for refcounting */
139 int refCnt; /* the number of references */
140 void *entry; /* entry point from load */
141 int nExports; /* the number of exports found */
142 ExportPtr exports; /* the array of exports */
143} Module, *ModulePtr;
144
cdc73a10
JH
145typedef struct {
146 /*
147 * We keep a list of all loaded modules to be able to reference count
148 * duplicate dlopen's.
149 */
150 ModulePtr x_modList;
151
152 /*
153 * The last error from one of the dl* routines is kept in static
154 * variables here. Each error is returned only once to the caller.
155 */
156 char x_errbuf[BUFSIZ];
157 int x_errvalid;
158 void * x_mainModule;
159} my_cxtx_t; /* this *must* be named my_cxtx_t */
160
161#define DL_CXT_EXTRA /* ask for dl_cxtx to be defined in dlutils.c */
162#include "dlutils.c" /* SaveError() etc */
a0d0e21e 163
cdc73a10
JH
164#define dl_modList (dl_cxtx.x_modList)
165#define dl_errbuf (dl_cxtx.x_errbuf)
166#define dl_errvalid (dl_cxtx.x_errvalid)
167#define dl_mainModule (dl_cxtx.x_mainModule)
a0d0e21e
LW
168
169static void caterr(char *);
170static int readExports(ModulePtr);
7ca86468 171static void *findMain(void);
a0d0e21e 172
cdc73a10 173/* these statics are ok because they're constants */
ce637636
JH
174static char *strerror_failed = "(strerror failed)";
175static char *strerror_r_failed = "(strerror_r failed)";
176
fd206186 177char *strerrorcat(char *str, int err) {
ce637636
JH
178 int strsiz = strlen(str);
179 int msgsiz;
180 char *msg;
181
48c64e3e 182 dTHX;
48c64e3e 183
ce637636
JH
184 if ((msg = strerror(err)) == 0)
185 msg = strerror_failed;
186 msgsiz = strlen(msg); /* Note msg = buf and free() above. */
187 if (strsiz + msgsiz < BUFSIZ) /* Do not move this after #endif. */
188 strcat(str, msg);
ce637636 189
fd206186
JH
190 return str;
191}
ce637636 192
fd206186 193char *strerrorcpy(char *str, int err) {
ce637636
JH
194 int msgsiz;
195 char *msg;
196
48c64e3e 197 dTHX;
48c64e3e 198
ce637636
JH
199 if ((msg = strerror(err)) == 0)
200 msg = strerror_failed;
201 msgsiz = strlen(msg); /* Note msg = buf and free() above. */
202 if (msgsiz < BUFSIZ) /* Do not move this after #endif. */
203 strcpy(str, msg);
ce637636 204
fd206186
JH
205 return str;
206}
a0d0e21e
LW
207
208/* ARGSUSED */
209void *dlopen(char *path, int mode)
210{
5b877257 211 dTHX;
cdc73a10 212 dMY_CXT;
a0d0e21e 213 register ModulePtr mp;
a0d0e21e
LW
214
215 /*
216 * Upon the first call register a terminate handler that will
f6b3007c 217 * close all libraries.
a0d0e21e 218 */
cdc73a10
JH
219 if (dl_mainModule == NULL) {
220 if ((dl_mainModule = findMain()) == NULL)
7ca86468 221 return NULL;
a0d0e21e
LW
222 }
223 /*
224 * Scan the list of modules if have the module already loaded.
225 */
cdc73a10 226 for (mp = dl_modList; mp; mp = mp->next)
a0d0e21e
LW
227 if (strcmp(mp->name, path) == 0) {
228 mp->refCnt++;
229 return mp;
230 }
a02a5408 231 Newxz(mp,1,Module);
a0d0e21e 232 if (mp == NULL) {
cdc73a10
JH
233 dl_errvalid++;
234 strcpy(dl_errbuf, "Newz: ");
235 strerrorcat(dl_errbuf, errno);
a0d0e21e
LW
236 return NULL;
237 }
238
239 if ((mp->name = savepv(path)) == NULL) {
cdc73a10
JH
240 dl_errvalid++;
241 strcpy(dl_errbuf, "savepv: ");
242 strerrorcat(dl_errbuf, errno);
a0d0e21e
LW
243 safefree(mp);
244 return NULL;
245 }
549a6b10 246
a0d0e21e
LW
247 /*
248 * load should be declared load(const char *...). Thus we
249 * cast the path to a normal char *. Ugly.
250 */
4e774c84 251 if ((mp->entry = (void *)LOAD((char *)path,
549a6b10
JH
252#ifdef L_LIBPATH_EXEC
253 L_LIBPATH_EXEC |
254#endif
255 L_NOAUTODEFER,
256 NULL)) == NULL) {
257 int saverrno = errno;
258
a0d0e21e
LW
259 safefree(mp->name);
260 safefree(mp);
cdc73a10
JH
261 dl_errvalid++;
262 strcpy(dl_errbuf, "dlopen: ");
263 strcat(dl_errbuf, path);
264 strcat(dl_errbuf, ": ");
a0d0e21e
LW
265 /*
266 * If AIX says the file is not executable, the error
267 * can be further described by querying the loader about
268 * the last error.
269 */
549a6b10
JH
270 if (saverrno == ENOEXEC) {
271 char *moreinfo[BUFSIZ/sizeof(char *)];
272 if (loadquery(L_GETMESSAGES, moreinfo, sizeof(moreinfo)) == -1)
cdc73a10 273 strerrorcpy(dl_errbuf, saverrno);
a0d0e21e
LW
274 else {
275 char **p;
549a6b10 276 for (p = moreinfo; *p; p++)
a0d0e21e
LW
277 caterr(*p);
278 }
279 } else
cdc73a10 280 strerrorcat(dl_errbuf, saverrno);
a0d0e21e
LW
281 return NULL;
282 }
283 mp->refCnt = 1;
cdc73a10
JH
284 mp->next = dl_modList;
285 dl_modList = mp;
f6b3007c
JH
286 /*
287 * Assume anonymous exports come from the module this dlopen
288 * is linked into, that holds true as long as dlopen and all
7ca86468
GS
289 * of the perl core are in the same shared object. Also bind
290 * against the main part, in the case a perl is not the main
291 * part, e.g mod_perl as DSO in Apache so perl modules can
292 * also reference Apache symbols.
f6b3007c 293 */
7ca86468 294 if (loadbind(0, (void *)dlopen, mp->entry) == -1 ||
cdc73a10 295 loadbind(0, dl_mainModule, mp->entry)) {
549a6b10
JH
296 int saverrno = errno;
297
a0d0e21e 298 dlclose(mp);
cdc73a10
JH
299 dl_errvalid++;
300 strcpy(dl_errbuf, "loadbind: ");
301 strerrorcat(dl_errbuf, saverrno);
a0d0e21e
LW
302 return NULL;
303 }
304 if (readExports(mp) == -1) {
305 dlclose(mp);
306 return NULL;
307 }
308 return mp;
309}
310
311/*
312 * Attempt to decipher an AIX loader error message and append it
313 * to our static error message buffer.
314 */
315static void caterr(char *s)
316{
cdc73a10
JH
317 dTHX;
318 dMY_CXT;
a0d0e21e
LW
319 register char *p = s;
320
321 while (*p >= '0' && *p <= '9')
322 p++;
323 switch(atoi(s)) {
324 case L_ERROR_TOOMANY:
cdc73a10 325 strcat(dl_errbuf, "too many errors");
a0d0e21e
LW
326 break;
327 case L_ERROR_NOLIB:
cdc73a10
JH
328 strcat(dl_errbuf, "can't load library");
329 strcat(dl_errbuf, p);
a0d0e21e
LW
330 break;
331 case L_ERROR_UNDEF:
cdc73a10
JH
332 strcat(dl_errbuf, "can't find symbol");
333 strcat(dl_errbuf, p);
a0d0e21e
LW
334 break;
335 case L_ERROR_RLDBAD:
cdc73a10
JH
336 strcat(dl_errbuf, "bad RLD");
337 strcat(dl_errbuf, p);
a0d0e21e
LW
338 break;
339 case L_ERROR_FORMAT:
cdc73a10
JH
340 strcat(dl_errbuf, "bad exec format in");
341 strcat(dl_errbuf, p);
a0d0e21e
LW
342 break;
343 case L_ERROR_ERRNO:
cdc73a10 344 strerrorcat(dl_errbuf, atoi(++p));
a0d0e21e
LW
345 break;
346 default:
cdc73a10 347 strcat(dl_errbuf, s);
a0d0e21e
LW
348 break;
349 }
350}
351
352void *dlsym(void *handle, const char *symbol)
353{
cdc73a10
JH
354 dTHX;
355 dMY_CXT;
a0d0e21e
LW
356 register ModulePtr mp = (ModulePtr)handle;
357 register ExportPtr ep;
358 register int i;
359
360 /*
361 * Could speed up search, but I assume that one assigns
362 * the result to function pointers anyways.
363 */
364 for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
365 if (strcmp(ep->name, symbol) == 0)
366 return ep->addr;
cdc73a10
JH
367 dl_errvalid++;
368 strcpy(dl_errbuf, "dlsym: undefined symbol ");
369 strcat(dl_errbuf, symbol);
a0d0e21e
LW
370 return NULL;
371}
372
373char *dlerror(void)
374{
cdc73a10
JH
375 dTHX;
376 dMY_CXT;
377 if (dl_errvalid) {
378 dl_errvalid = 0;
379 return dl_errbuf;
a0d0e21e
LW
380 }
381 return NULL;
382}
383
384int dlclose(void *handle)
385{
cdc73a10
JH
386 dTHX;
387 dMY_CXT;
a0d0e21e
LW
388 register ModulePtr mp = (ModulePtr)handle;
389 int result;
390 register ModulePtr mp1;
391
392 if (--mp->refCnt > 0)
393 return 0;
4e774c84 394 result = UNLOAD(mp->entry);
a0d0e21e 395 if (result == -1) {
cdc73a10
JH
396 dl_errvalid++;
397 strerrorcpy(dl_errbuf, errno);
a0d0e21e
LW
398 }
399 if (mp->exports) {
400 register ExportPtr ep;
401 register int i;
402 for (ep = mp->exports, i = mp->nExports; i; i--, ep++)
403 if (ep->name)
404 safefree(ep->name);
405 safefree(mp->exports);
406 }
cdc73a10
JH
407 if (mp == dl_modList)
408 dl_modList = mp->next;
a0d0e21e 409 else {
cdc73a10 410 for (mp1 = dl_modList; mp1; mp1 = mp1->next)
a0d0e21e
LW
411 if (mp1->next == mp) {
412 mp1->next = mp->next;
413 break;
414 }
415 }
416 safefree(mp->name);
417 safefree(mp);
418 return result;
419}
420
a0d0e21e
LW
421/* Added by Wayne Scott
422 * This is needed because the ldopen system call calls
423 * calloc to allocated a block of date. The ldclose call calls free.
424 * Without this we get this system calloc and perl's free, resulting
425 * in a "Bad free" message. This way we always use perl's malloc.
426 */
427void *calloc(size_t ne, size_t sz)
428{
429 void *out;
430
431 out = (void *) safemalloc(ne*sz);
432 memzero(out, ne*sz);
433 return(out);
434}
435
436/*
437 * Build the export table from the XCOFF .loader section.
438 */
439static int readExports(ModulePtr mp)
440{
5b877257 441 dTHX;
cdc73a10 442 dMY_CXT;
a0d0e21e 443 LDFILE *ldp = NULL;
19e194ad
JH
444 AIX_SCNHDR sh;
445 AIX_LDHDR *lhp;
a0d0e21e 446 char *ldbuf;
19e194ad 447 AIX_LDSYM *ls;
a0d0e21e
LW
448 int i;
449 ExportPtr ep;
450
451 if ((ldp = ldopen(mp->name, ldp)) == NULL) {
452 struct ld_info *lp;
453 char *buf;
454 int size = 4*1024;
455 if (errno != ENOENT) {
cdc73a10
JH
456 dl_errvalid++;
457 strcpy(dl_errbuf, "readExports: ");
458 strerrorcat(dl_errbuf, errno);
a0d0e21e
LW
459 return -1;
460 }
461 /*
462 * The module might be loaded due to the LIBPATH
463 * environment variable. Search for the loaded
464 * module using L_GETINFO.
465 */
466 if ((buf = safemalloc(size)) == NULL) {
cdc73a10
JH
467 dl_errvalid++;
468 strcpy(dl_errbuf, "readExports: ");
469 strerrorcat(dl_errbuf, errno);
a0d0e21e
LW
470 return -1;
471 }
472 while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
473 safefree(buf);
474 size += 4*1024;
475 if ((buf = safemalloc(size)) == NULL) {
cdc73a10
JH
476 dl_errvalid++;
477 strcpy(dl_errbuf, "readExports: ");
478 strerrorcat(dl_errbuf, errno);
a0d0e21e
LW
479 return -1;
480 }
481 }
482 if (i == -1) {
cdc73a10
JH
483 dl_errvalid++;
484 strcpy(dl_errbuf, "readExports: ");
485 strerrorcat(dl_errbuf, errno);
a0d0e21e
LW
486 safefree(buf);
487 return -1;
488 }
489 /*
490 * Traverse the list of loaded modules. The entry point
4e774c84 491 * returned by LOAD() does actually point to the data
a0d0e21e
LW
492 * segment origin.
493 */
494 lp = (struct ld_info *)buf;
495 while (lp) {
496 if (lp->ldinfo_dataorg == mp->entry) {
497 ldp = ldopen(lp->ldinfo_filename, ldp);
498 break;
499 }
500 if (lp->ldinfo_next == 0)
501 lp = NULL;
502 else
503 lp = (struct ld_info *)((char *)lp + lp->ldinfo_next);
504 }
505 safefree(buf);
506 if (!ldp) {
cdc73a10
JH
507 dl_errvalid++;
508 strcpy(dl_errbuf, "readExports: ");
509 strerrorcat(dl_errbuf, errno);
a0d0e21e
LW
510 return -1;
511 }
512 }
19e194ad
JH
513#ifdef USE_64_BIT_ALL
514 if (TYPE(ldp) != U803XTOCMAGIC) {
515#else
a0d0e21e 516 if (TYPE(ldp) != U802TOCMAGIC) {
19e194ad 517#endif
cdc73a10
JH
518 dl_errvalid++;
519 strcpy(dl_errbuf, "readExports: bad magic");
a0d0e21e
LW
520 while(ldclose(ldp) == FAILURE)
521 ;
522 return -1;
523 }
524 if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) {
cdc73a10
JH
525 dl_errvalid++;
526 strcpy(dl_errbuf, "readExports: cannot read loader section header");
a0d0e21e
LW
527 while(ldclose(ldp) == FAILURE)
528 ;
529 return -1;
530 }
531 /*
532 * We read the complete loader section in one chunk, this makes
533 * finding long symbol names residing in the string table easier.
534 */
535 if ((ldbuf = (char *)safemalloc(sh.s_size)) == NULL) {
cdc73a10
JH
536 dl_errvalid++;
537 strcpy(dl_errbuf, "readExports: ");
538 strerrorcat(dl_errbuf, errno);
a0d0e21e
LW
539 while(ldclose(ldp) == FAILURE)
540 ;
541 return -1;
542 }
543 if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) {
cdc73a10
JH
544 dl_errvalid++;
545 strcpy(dl_errbuf, "readExports: cannot seek to loader section");
a0d0e21e
LW
546 safefree(ldbuf);
547 while(ldclose(ldp) == FAILURE)
548 ;
549 return -1;
550 }
1553ab04
TB
551/* This first case is a hack, since it assumes that the 3rd parameter to
552 FREAD is 1. See the redefinition of FREAD above to see how this works. */
a0d0e21e 553 if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) {
cdc73a10
JH
554 dl_errvalid++;
555 strcpy(dl_errbuf, "readExports: cannot read loader section");
a0d0e21e
LW
556 safefree(ldbuf);
557 while(ldclose(ldp) == FAILURE)
558 ;
559 return -1;
560 }
19e194ad
JH
561 lhp = (AIX_LDHDR *)ldbuf;
562 ls = (AIX_LDSYM *)(ldbuf+AIX_LDHDRSZ);
a0d0e21e
LW
563 /*
564 * Count the number of exports to include in our export table.
565 */
566 for (i = lhp->l_nsyms; i; i--, ls++) {
567 if (!LDR_EXPORT(*ls))
568 continue;
569 mp->nExports++;
570 }
a02a5408 571 Newxz(mp->exports, mp->nExports, Export);
a0d0e21e 572 if (mp->exports == NULL) {
cdc73a10
JH
573 dl_errvalid++;
574 strcpy(dl_errbuf, "readExports: ");
575 strerrorcat(dl_errbuf, errno);
a0d0e21e
LW
576 safefree(ldbuf);
577 while(ldclose(ldp) == FAILURE)
578 ;
579 return -1;
580 }
581 /*
582 * Fill in the export table. All entries are relative to
583 * the entry point we got from load.
584 */
585 ep = mp->exports;
19e194ad 586 ls = (AIX_LDSYM *)(ldbuf+AIX_LDHDRSZ);
a0d0e21e
LW
587 for (i = lhp->l_nsyms; i; i--, ls++) {
588 char *symname;
589 if (!LDR_EXPORT(*ls))
590 continue;
19e194ad 591#ifndef USE_64_BIT_ALL
a0d0e21e 592 if (ls->l_zeroes == 0)
19e194ad 593#endif
a0d0e21e 594 symname = ls->l_offset+lhp->l_stoff+ldbuf;
19e194ad 595#ifndef USE_64_BIT_ALL
a0d0e21e
LW
596 else
597 symname = ls->l_name;
19e194ad 598#endif
a0d0e21e
LW
599 ep->name = savepv(symname);
600 ep->addr = (void *)((unsigned long)mp->entry + ls->l_value);
601 ep++;
602 }
603 safefree(ldbuf);
604 while(ldclose(ldp) == FAILURE)
605 ;
606 return 0;
607}
608
7ca86468
GS
609/*
610 * Find the main modules entry point. This is used as export pointer
611 * for loadbind() to be able to resolve references to the main part.
612 */
613static void * findMain(void)
614{
cdc73a10
JH
615 dTHX;
616 dMY_CXT;
7ca86468
GS
617 struct ld_info *lp;
618 char *buf;
619 int size = 4*1024;
620 int i;
621 void *ret;
622
623 if ((buf = safemalloc(size)) == NULL) {
cdc73a10
JH
624 dl_errvalid++;
625 strcpy(dl_errbuf, "findMain: ");
626 strerrorcat(dl_errbuf, errno);
7ca86468
GS
627 return NULL;
628 }
629 while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
630 safefree(buf);
631 size += 4*1024;
632 if ((buf = safemalloc(size)) == NULL) {
cdc73a10
JH
633 dl_errvalid++;
634 strcpy(dl_errbuf, "findMain: ");
635 strerrorcat(dl_errbuf, errno);
7ca86468
GS
636 return NULL;
637 }
638 }
639 if (i == -1) {
cdc73a10
JH
640 dl_errvalid++;
641 strcpy(dl_errbuf, "findMain: ");
642 strerrorcat(dl_errbuf, errno);
7ca86468
GS
643 safefree(buf);
644 return NULL;
645 }
646 /*
647 * The first entry is the main module. The entry point
648 * returned by load() does actually point to the data
649 * segment origin.
650 */
651 lp = (struct ld_info *)buf;
652 ret = lp->ldinfo_dataorg;
653 safefree(buf);
654 return ret;
655}
61d42ce4 656#endif /* USE_NATIVE_DLOPEN */
7ca86468 657
a0d0e21e
LW
658/* dl_dlopen.xs
659 *
660 * Platform: SunOS/Solaris, possibly others which use dlopen.
0536e0eb 661 * Author: Paul Marquess (Paul.Marquess@btinternet.com)
a0d0e21e
LW
662 * Created: 10th July 1994
663 *
664 * Modified:
665 * 15th July 1994 - Added code to explicitly save any error messages.
666 * 3rd August 1994 - Upgraded to v3 spec.
667 * 9th August 1994 - Changed to use IV
668 * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging,
669 * basic FreeBSD support, removed ClearError
670 *
671 */
672
673/* Porting notes:
674
675 see dl_dlopen.xs
676
677*/
678
a0d0e21e 679static void
cea2e8a9 680dl_private_init(pTHX)
a0d0e21e 681{
cea2e8a9 682 (void)dl_generic_private_init(aTHX);
a0d0e21e
LW
683}
684
685MODULE = DynaLoader PACKAGE = DynaLoader
686
687BOOT:
cea2e8a9 688 (void)dl_private_init(aTHX);
a0d0e21e
LW
689
690
691void *
ff7f3c60
NIS
692dl_load_file(filename, flags=0)
693 char * filename
694 int flags
a0d0e21e 695 CODE:
bf49b057 696 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
ff7f3c60 697 if (flags & 0x01)
cea2e8a9 698 Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
61d42ce4 699 RETVAL = dlopen(filename, RTLD_GLOBAL|RTLD_LAZY) ;
bf49b057 700 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
a0d0e21e
LW
701 ST(0) = sv_newmortal() ;
702 if (RETVAL == NULL)
cea2e8a9 703 SaveError(aTHX_ "%s",dlerror()) ;
a0d0e21e 704 else
3175b8cd 705 sv_setiv( ST(0), PTR2IV(RETVAL) );
a0d0e21e 706
7ca86468
GS
707int
708dl_unload_file(libref)
709 void * libref
710 CODE:
711 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", libref));
712 RETVAL = (dlclose(libref) == 0 ? 1 : 0);
713 if (!RETVAL)
714 SaveError(aTHX_ "%s", dlerror()) ;
715 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " retval = %d\n", RETVAL));
716 OUTPUT:
717 RETVAL
a0d0e21e
LW
718
719void *
720dl_find_symbol(libhandle, symbolname)
721 void * libhandle
722 char * symbolname
723 CODE:
bf49b057 724 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n",
a0d0e21e
LW
725 libhandle, symbolname));
726 RETVAL = dlsym(libhandle, symbolname);
bf49b057 727 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref = %x\n", RETVAL));
a0d0e21e
LW
728 ST(0) = sv_newmortal() ;
729 if (RETVAL == NULL)
cea2e8a9 730 SaveError(aTHX_ "%s",dlerror()) ;
a0d0e21e 731 else
f66f545a 732 sv_setiv( ST(0), PTR2IV(RETVAL));
a0d0e21e
LW
733
734
735void
736dl_undef_symbols()
737 PPCODE:
738
739
740
741# These functions should not need changing on any platform:
742
743void
744dl_install_xsub(perl_name, symref, filename="$Package")
745 char * perl_name
746 void * symref
747 char * filename
748 CODE:
bf49b057 749 DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
a0d0e21e 750 perl_name, symref));
77004dee
NC
751 ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
752 (void(*)(pTHX_ CV *))symref,
753 filename, NULL,
754 XS_DYNAMIC_FILENAME)));
a0d0e21e
LW
755
756
757char *
758dl_error()
759 CODE:
cdc73a10
JH
760 dMY_CXT;
761 RETVAL = dl_last_error ;
a0d0e21e
LW
762 OUTPUT:
763 RETVAL
764
765# end.