Commit | Line | Data |
a0d0e21e |
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 | |
8e07c86e |
34 | /* include these before perl headers */ |
35 | #include <mach-o/rld.h> |
36 | #include <streams/streams.h> |
37 | |
a0d0e21e |
38 | #include "EXTERN.h" |
39 | #include "perl.h" |
40 | #include "XSUB.h" |
41 | |
8e07c86e |
42 | #define DL_LOADONCEONLY |
a0d0e21e |
43 | |
8e07c86e |
44 | #include "dlutils.c" /* SaveError() etc */ |
a0d0e21e |
45 | |
a0d0e21e |
46 | |
47 | static char * dl_last_error = (char *) 0; |
8e07c86e |
48 | static AV *dl_resolve_using = Nullav; |
a0d0e21e |
49 | |
50 | NXStream * |
51 | OpenError() |
52 | { |
53 | return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY); |
54 | } |
55 | |
56 | void |
57 | TransferError( s) |
58 | NXStream *s; |
59 | { |
60 | char *buffer; |
61 | int len, maxlen; |
62 | |
63 | if ( dl_last_error ) { |
64 | safefree(dl_last_error); |
65 | } |
66 | NXGetMemoryBuffer(s, &buffer, &len, &maxlen); |
67 | dl_last_error = safemalloc(len); |
68 | strcpy(dl_last_error, buffer); |
69 | } |
70 | |
71 | void |
72 | CloseError( s) |
73 | NXStream *s; |
74 | { |
75 | if ( s ) { |
76 | NXCloseMemory( s, NX_FREEBUFFER); |
77 | } |
78 | } |
79 | |
80 | char *dlerror() |
81 | { |
82 | return dl_last_error; |
83 | } |
84 | |
85 | char * |
86 | dlopen(path, mode) |
87 | char * path; |
88 | int mode; /* mode is ignored */ |
89 | { |
90 | int rld_success; |
8e07c86e |
91 | NXStream *nxerr; |
a0d0e21e |
92 | I32 i, psize; |
93 | char *result; |
94 | char **p; |
8e07c86e |
95 | |
96 | /* Do not load what is already loaded into this process */ |
97 | if (hv_fetch(dl_loaded_files, path, strlen(path), 0)) |
98 | return path; |
a0d0e21e |
99 | |
8e07c86e |
100 | nxerr = OpenError(); |
101 | psize = AvFILL(dl_resolve_using) + 3; |
a0d0e21e |
102 | p = (char **) safemalloc(psize * sizeof(char*)); |
103 | p[0] = path; |
104 | for(i=1; i<psize-1; i++) { |
8e07c86e |
105 | p[i] = SvPVx(*av_fetch(dl_resolve_using, i-1, TRUE), na); |
a0d0e21e |
106 | } |
107 | p[psize-1] = 0; |
108 | rld_success = rld_load(nxerr, (struct mach_header **)0, p, |
109 | (const char *) 0); |
110 | safefree((char*) p); |
111 | if (rld_success) { |
112 | result = path; |
8e07c86e |
113 | /* prevent multiple loads of same file into same process */ |
114 | hv_store(dl_loaded_files, path, strlen(path), &sv_yes, 0); |
a0d0e21e |
115 | } else { |
116 | TransferError(nxerr); |
117 | result = (char*) 0; |
118 | } |
119 | CloseError(nxerr); |
120 | return result; |
121 | } |
122 | |
123 | int |
124 | dlclose(handle) /* stub only */ |
125 | void *handle; |
126 | { |
127 | return 0; |
128 | } |
129 | |
130 | void * |
131 | dlsym(handle, symbol) |
132 | void *handle; |
133 | char *symbol; |
134 | { |
135 | NXStream *nxerr = OpenError(); |
136 | char symbuf[1024]; |
137 | unsigned long symref = 0; |
138 | |
139 | sprintf(symbuf, "_%s", symbol); |
140 | if (!rld_lookup(nxerr, symbuf, &symref)) { |
141 | TransferError(nxerr); |
142 | } |
143 | CloseError(nxerr); |
144 | return (void*) symref; |
145 | } |
146 | |
147 | |
148 | /* ----- code from dl_dlopen.xs below here ----- */ |
149 | |
150 | |
151 | static void |
152 | dl_private_init() |
153 | { |
154 | (void)dl_generic_private_init(); |
8e07c86e |
155 | dl_resolve_using = perl_get_av("DynaLoader::dl_resolve_using", 0x4); |
a0d0e21e |
156 | } |
157 | |
158 | MODULE = DynaLoader PACKAGE = DynaLoader |
159 | |
160 | BOOT: |
161 | (void)dl_private_init(); |
162 | |
163 | |
164 | |
165 | void * |
166 | dl_load_file(filename) |
167 | char * filename |
168 | CODE: |
169 | int mode = 1; |
170 | DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); |
171 | RETVAL = dlopen(filename, mode) ; |
172 | DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); |
173 | ST(0) = sv_newmortal() ; |
174 | if (RETVAL == NULL) |
175 | SaveError("%s",dlerror()) ; |
176 | else |
177 | sv_setiv( ST(0), (IV)RETVAL); |
178 | |
179 | |
180 | void * |
181 | dl_find_symbol(libhandle, symbolname) |
182 | void * libhandle |
183 | char * symbolname |
184 | CODE: |
185 | DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", |
186 | libhandle, symbolname)); |
187 | RETVAL = dlsym(libhandle, symbolname); |
188 | DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); |
189 | ST(0) = sv_newmortal() ; |
190 | if (RETVAL == NULL) |
191 | SaveError("%s",dlerror()) ; |
192 | else |
193 | sv_setiv( ST(0), (IV)RETVAL); |
194 | |
195 | |
196 | void |
197 | dl_undef_symbols() |
198 | PPCODE: |
199 | |
200 | |
201 | |
202 | # These functions should not need changing on any platform: |
203 | |
204 | void |
205 | dl_install_xsub(perl_name, symref, filename="$Package") |
206 | char * perl_name |
207 | void * symref |
208 | char * filename |
209 | CODE: |
210 | DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", |
211 | perl_name, symref)); |
212 | ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); |
213 | |
214 | |
215 | char * |
216 | dl_error() |
217 | CODE: |
218 | RETVAL = LastError ; |
219 | OUTPUT: |
220 | RETVAL |
221 | |
222 | # end. |