perl 5.000
[p5sagit/p5-mst-13.2.git] / ext / DynaLoader / dl_next.xs
1 /* dl_next.xs
2  * 
3  * Platform:    NeXT NS 3.2
4  * Author:      Anno Siegel (siegel@zrz.TU-Berlin.DE)
5  * Based on:    dl_dlopen.xs by Paul Marquess
6  * Created:     Aug 15th, 1994
7  *
8  */
9
10 /*
11     And Gandalf said: 'Many folk like to know beforehand what is to
12     be set on the table; but those who have laboured to prepare the
13     feast like to keep their secret; for wonder makes the words of
14     praise louder.'
15 */
16
17 /* Porting notes:
18
19 dl_next.xs is itself a port from dl_dlopen.xs by Paul Marquess.  It
20 should not be used as a base for further ports though it may be used
21 as an example for how dl_dlopen.xs can be ported to other platforms.
22
23 The method used here is just to supply the sun style dlopen etc.
24 functions in terms of NeXTs rld_*.  The xs code proper is unchanged
25 from Paul's original.
26
27 The port could use some streamlining.  For one, error handling could
28 be simplified.
29
30 Anno Siegel
31
32 */
33
34 #include "EXTERN.h"
35 #include "perl.h"
36 #include "XSUB.h"
37
38 #include "dlutils.c"    /* SaveError() etc      */
39
40
41 #include <mach-o/rld.h>
42 #include <streams/streams.h>
43
44 static char * dl_last_error = (char *) 0;
45
46 NXStream *
47 OpenError()
48 {
49     return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
50 }
51
52 void
53 TransferError( s)
54 NXStream *s;
55 {
56     char *buffer;
57     int len, maxlen;
58
59     if ( dl_last_error ) {
60         safefree(dl_last_error);
61     }
62     NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
63     dl_last_error = safemalloc(len);
64     strcpy(dl_last_error, buffer);
65 }
66
67 void
68 CloseError( s)
69 NXStream *s;
70 {
71     if ( s ) {
72       NXCloseMemory( s, NX_FREEBUFFER);
73     }
74 }
75
76 char *dlerror()
77 {
78     return dl_last_error;
79 }
80
81 char *
82 dlopen(path, mode)
83 char * path;
84 int mode; /* mode is ignored */
85 {
86     int rld_success;
87     NXStream *nxerr = OpenError();
88     AV * av_resolve;
89     I32 i, psize;
90     char *result;
91     char **p;
92
93     av_resolve = GvAVn(gv_fetchpv(
94         "DynaLoader::dl_resolve_using", FALSE, SVt_PVAV));
95     psize = AvFILL(av_resolve) + 3;
96     p = (char **) safemalloc(psize * sizeof(char*));
97     p[0] = path;
98     for(i=1; i<psize-1; i++) {
99         p[i] = SvPVx(*av_fetch(av_resolve, i-1, TRUE), na);
100     }
101     p[psize-1] = 0;
102     rld_success = rld_load(nxerr, (struct mach_header **)0, p,
103                             (const char *) 0);
104     safefree((char*) p);
105     if (rld_success) {
106         result = path;
107     } else {
108         TransferError(nxerr);
109         result = (char*) 0;
110     }
111     CloseError(nxerr);
112     return result;
113 }
114
115 int
116 dlclose(handle) /* stub only */
117 void *handle;
118 {
119     return 0;
120 }
121
122 void *
123 dlsym(handle, symbol)
124 void *handle;
125 char *symbol;
126 {
127     NXStream    *nxerr = OpenError();
128     char        symbuf[1024];
129     unsigned long       symref = 0;
130
131     sprintf(symbuf, "_%s", symbol);
132     if (!rld_lookup(nxerr, symbuf, &symref)) {
133         TransferError(nxerr);
134     }
135     CloseError(nxerr);
136     return (void*) symref;
137 }
138
139
140 /* ----- code from dl_dlopen.xs below here ----- */
141
142
143 static void
144 dl_private_init()
145 {
146     (void)dl_generic_private_init();
147 }
148  
149 MODULE = DynaLoader     PACKAGE = DynaLoader
150
151 BOOT:
152     (void)dl_private_init();
153
154
155
156 void *
157 dl_load_file(filename)
158     char *      filename
159     CODE:
160     int mode = 1;
161     DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
162     RETVAL = dlopen(filename, mode) ;
163     DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
164     ST(0) = sv_newmortal() ;
165     if (RETVAL == NULL)
166         SaveError("%s",dlerror()) ;
167     else
168         sv_setiv( ST(0), (IV)RETVAL);
169
170
171 void *
172 dl_find_symbol(libhandle, symbolname)
173     void *              libhandle
174     char *              symbolname
175     CODE:
176     DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
177             libhandle, symbolname));
178     RETVAL = dlsym(libhandle, symbolname);
179     DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", RETVAL));
180     ST(0) = sv_newmortal() ;
181     if (RETVAL == NULL)
182         SaveError("%s",dlerror()) ;
183     else
184         sv_setiv( ST(0), (IV)RETVAL);
185
186
187 void
188 dl_undef_symbols()
189     PPCODE:
190
191
192
193 # These functions should not need changing on any platform:
194
195 void
196 dl_install_xsub(perl_name, symref, filename="$Package")
197     char *      perl_name
198     void *      symref 
199     char *      filename
200     CODE:
201     DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
202             perl_name, symref));
203     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
204
205
206 char *
207 dl_error()
208     CODE:
209     RETVAL = LastError ;
210     OUTPUT:
211     RETVAL
212
213 # end.