This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl5.000 patch.0g: [various portability fixes, and use latest metaconfig for Configure]
[perl5.git] / ext / DynaLoader / dl_hpux.xs
1 /*
2  * Author: Jeff Okamoto (okamoto@corp.hp.com)
3  */
4
5 #ifdef __hp9000s300
6 #define magic hpux_magic
7 #define MAGIC HPUX_MAGIC
8 #endif
9
10 #include <dl.h>
11 #ifdef __hp9000s300
12 #undef magic
13 #undef MAGIC
14 #endif
15
16 #include "EXTERN.h"
17 #include "perl.h"
18 #include "XSUB.h"
19
20
21 #include "dlutils.c"    /* for SaveError() etc */
22
23
24 static void
25 dl_private_init()
26 {
27     (void)dl_generic_private_init();
28 }
29
30 MODULE = DynaLoader     PACKAGE = DynaLoader
31
32 BOOT:
33     (void)dl_private_init();
34
35
36 void *
37 dl_load_file(filename)
38     char *              filename
39     CODE:
40     shl_t obj = NULL;
41     DLDEBUG(1,fprintf(stderr,"dl_load_file(%s): ", filename));
42     obj = shl_load(filename,
43         BIND_IMMEDIATE | BIND_NONFATAL | BIND_NOSTART | BIND_VERBOSE, 0L);
44     DLDEBUG(2,fprintf(stderr," libref=%x\n", obj));
45     ST(0) = sv_newmortal() ;
46     if (obj == NULL)
47         SaveError("%s",Strerror(errno)) ;
48     else
49         sv_setiv( ST(0), (IV)obj);
50
51
52 void *
53 dl_find_symbol(libhandle, symbolname)
54     void *      libhandle
55     char *      symbolname
56     CODE:
57     shl_t obj = (shl_t) libhandle;
58     void *symaddr = NULL;
59     int status;
60 #ifdef __hp9000s300
61     char symbolname_buf[MAXPATHLEN];
62     symbolname = dl_add_underscore(symbolname, symbolname_buf);
63 #endif
64     DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
65                 libhandle, symbolname));
66     status = shl_findsym(&obj, symbolname, TYPE_PROCEDURE, &symaddr);
67     DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", symaddr));
68     ST(0) = sv_newmortal() ;
69     if (status == -1)
70         SaveError("%s",(errno) ? Strerror(errno) : "Symbol not found") ;
71     else
72         sv_setiv( ST(0), (IV)symaddr);
73
74
75 int
76 dl_undef_symbols()
77     PPCODE:
78
79
80
81 # These functions should not need changing on any platform:
82
83 void
84 dl_install_xsub(perl_name, symref, filename="$Package")
85     char *      perl_name
86     void *      symref 
87     char *      filename
88     CODE:
89     DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
90             perl_name, symref));
91     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
92
93
94 char *
95 dl_error()
96     CODE:
97     RETVAL = LastError ;
98     OUTPUT:
99     RETVAL
100
101 # end.