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