Perl 5.001
[p5sagit/p5-mst-13.2.git] / ext / DynaLoader / dl_hpux.xs
1 /*
2  * Author: Jeff Okamoto (okamoto@corp.hp.com)
3  * Version: 2.1, 1995/1/25
4  */
5
6 #ifdef __hp9000s300
7 #define magic hpux_magic
8 #define MAGIC HPUX_MAGIC
9 #endif
10
11 #include <dl.h>
12 #ifdef __hp9000s300
13 #undef magic
14 #undef MAGIC
15 #endif
16
17 #include "EXTERN.h"
18 #include "perl.h"
19 #include "XSUB.h"
20
21
22 #include "dlutils.c"    /* for SaveError() etc */
23
24
25 static void
26 dl_private_init()
27 {
28     (void)dl_generic_private_init();
29 }
30
31 MODULE = DynaLoader     PACKAGE = DynaLoader
32
33 BOOT:
34     (void)dl_private_init();
35
36
37 void *
38 dl_load_file(filename)
39     char *              filename
40     CODE:
41     shl_t obj = NULL;
42     int i, max;
43     GV  *gv;
44     AV  *av;
45
46     gv = gv_fetchpv("DynaLoader::dl_resolve_using", FALSE, SVt_PVAV);
47     if (gv) {
48         av  = GvAV(gv);
49         max = AvFILL(av);
50         for (i = 0; i <= max; i++) {
51             char *sym = SvPVX(*av_fetch(av, i, 0));
52             DLDEBUG(1,fprintf(stderr, "dl_load_file(%s) (dependent)\n", sym));
53             obj = shl_load(sym,
54                 BIND_IMMEDIATE | BIND_NONFATAL | BIND_NOSTART | BIND_VERBOSE,
55                 0L);
56             if (obj == NULL) {
57                 goto end;
58             }
59         }
60     }
61
62     DLDEBUG(1,fprintf(stderr,"dl_load_file(%s): ", filename));
63     obj = shl_load(filename,
64         BIND_IMMEDIATE | BIND_NONFATAL | BIND_NOSTART | BIND_VERBOSE, 0L);
65
66     DLDEBUG(2,fprintf(stderr," libref=%x\n", obj));
67 end:
68     ST(0) = sv_newmortal() ;
69     if (obj == NULL)
70         SaveError("%s",Strerror(errno));
71     else
72         sv_setiv( ST(0), (IV)obj);
73
74
75 void *
76 dl_find_symbol(libhandle, symbolname)
77     void *      libhandle
78     char *      symbolname
79     CODE:
80     shl_t obj = (shl_t) libhandle;
81     void *symaddr = NULL;
82     int status;
83 #ifdef __hp9000s300
84     char symbolname_buf[MAXPATHLEN];
85     symbolname = dl_add_underscore(symbolname, symbolname_buf);
86 #endif
87     DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
88                 libhandle, symbolname));
89     status = shl_findsym(&obj, symbolname, TYPE_PROCEDURE, &symaddr);
90     DLDEBUG(2,fprintf(stderr,"  symbolref(PROCEDURE) = %x\n", symaddr));
91     ST(0) = sv_newmortal() ;
92     if (status == -1) {
93         if (errno == 0) {
94             status = shl_findsym(&obj, symbolname, TYPE_DATA, &symaddr);
95             DLDEBUG(2,fprintf(stderr,"  symbolref(DATA) = %x\n", symaddr));
96             if (status == -1) {
97                 SaveError("%s",(errno) ? Strerror(errno) : "Symbol not found") ;
98             } else {
99                 sv_setiv( ST(0), (IV)symaddr);
100             }
101         } else {
102             SaveError("%s", Strerror(errno));
103         }
104     } else {
105         sv_setiv( ST(0), (IV)symaddr);
106     }
107
108
109 int
110 dl_undef_symbols()
111     PPCODE:
112
113
114
115 # These functions should not need changing on any platform:
116
117 void
118 dl_install_xsub(perl_name, symref, filename="$Package")
119     char *      perl_name
120     void *      symref 
121     char *      filename
122     CODE:
123     DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
124             perl_name, symref));
125     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
126
127
128 char *
129 dl_error()
130     CODE:
131     RETVAL = LastError ;
132     OUTPUT:
133     RETVAL
134
135 # end.