This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
correct FSF address in various places
[perl5.git] / ext / DynaLoader / dl_mpeix.xs
CommitLineData
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)
5 */
6
7#include "EXTERN.h"
8#include "perl.h"
9#include "XSUB.h"
10
11#ifdef __GNUC__
12extern void HPGETPROCPLABEL( int parms,
13 char * procname,
14 int * plabel,
15 int * status,
16 char * firstfile,
17 int casesensitive,
18 int symboltype,
19 int * datasize,
20 int position,
21 int searchpath,
22 int binding);
23#else
24#pragma intrinsic HPGETPROCPLABEL
25#endif
26#include "dlutils.c" /* for SaveError() etc */
27
28typedef struct {
29 char filename[PATH_MAX + 3];
30 } t_mpe_dld, *p_mpe_dld;
31
32static AV *dl_resolve_using = Nullav;
33
34static void
35dl_private_init()
36{
37 (void)dl_generic_private_init();
38 dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4);
39}
40
41MODULE = DynaLoader PACKAGE = DynaLoader
42
43BOOT:
44 (void)dl_private_init();
45
46void *
47dl_load_file(filename, flags=0)
48 char * filename
49 int flags
50 PREINIT:
51 char buf[PATH_MAX + 3];
52 p_mpe_dld obj = NULL;
53 int i;
54 CODE:
55 DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,
56flags));
57 if (flags & 0x01)
58 warn("Can't make loaded symbols global on this platform while loading %s
59",filename);
60 obj = (p_mpe_dld) safemalloc(sizeof(t_mpe_dld));
61 memzero(obj, sizeof(t_mpe_dld));
62 if (filename[0] == '.')
63 {
64 getcwd(buf,sizeof(buf));
65 sprintf(obj->filename,"$%s/%s$",buf,filename);
66 }
67 else
68 sprintf(obj->filename,"$%s$",filename);
69
70 DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", obj));
71
72 ST(0) = sv_newmortal() ;
73 if (obj == NULL)
74 SaveError("%s",Strerror(errno));
75 else
76 sv_setiv( ST(0), (IV)obj);
77
78void *
79dl_find_symbol(libhandle, symbolname)
80 void * libhandle
81 char * symbolname
82 CODE:
83 int datalen;
84 p_mpe_dld obj = (p_mpe_dld) libhandle;
85 char symname[PATH_MAX + 3];
86 void * symaddr = NULL;
87 int status;
88 DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n",
89 libhandle, symbolname));
90 ST(0) = sv_newmortal() ;
91 errno = 0;
92
93 sprintf(symname, "$%s$", symbolname);
94 HPGETPROCPLABEL(8, symname, &symaddr, &status, obj->filename, 1,
95 0, &datalen, 1, 0, 0);
96
97 DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref(PROCEDURE) = %x\n", symaddr));
98
99 if (status != 0) {
100 SaveError("%s",(errno) ? Strerror(errno) : "Symbol not found") ;
101 } else {
102 sv_setiv( ST(0), (IV)symaddr);
103 }
104
105void
106dl_undef_symbols()
107 PPCODE:
108
109# These functions should not need changing on any platform:
110
111void
112dl_install_xsub(perl_name, symref, filename="$Package")
113 char * perl_name
114 void * symref
115 char * filename
116 CODE:
117 DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n",
118 perl_name, symref));
119 ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
120
121char *
122dl_error()
123 CODE:
124 RETVAL = LastError ;
125 OUTPUT:
126 RETVAL
127
128# end.