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