annotate keiko/dynlink.c @ 0:bfdcc3820b32

Basis
author Mike Spivey <mike@cs.ox.ac.uk>
date Thu, 05 Oct 2017 08:04:15 +0100
parents
children
rev   line source
0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
1 /*
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
2 * dynlink.c
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
3 *
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
4 * This file is part of the Oxford Oberon-2 compiler
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
5 * Copyright (c) 2006--2016 J. M. Spivey
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
6 * All rights reserved
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
7 *
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
8 * Redistribution and use in source and binary forms, with or without
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
9 * modification, are permitted provided that the following conditions are met:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
10 *
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
11 * 1. Redistributions of source code must retain the above copyright notice,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
12 * this list of conditions and the following disclaimer.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
13 * 2. Redistributions in binary form must reproduce the above copyright notice,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
14 * this list of conditions and the following disclaimer in the documentation
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
15 * and/or other materials provided with the distribution.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
16 * 3. The name of the author may not be used to endorse or promote products
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
17 * derived from this software without specific prior written permission.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
18 *
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
19 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
20 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
21 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
22 * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
23 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
24 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
25 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
26 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
27 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
28 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
29 */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
30
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
31 /*
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
32 Initially, the procedure descriptor for each such primitive has the
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
33 trap handler |dltrap| as its interpreter, and the CP_CODE field of
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
34 the descriptor points to the name of the primitive as a string.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
35 When the primitive is first called, the |dltrap| primitive looks up
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
36 the symbol and binds the primitive to its value for future use.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
37 Finally, it calls the newly-loaded primitive to complete the first
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
38 call.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
39
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
40 Function |load_lib| loads a dynamic library. Each Oberon module that
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
41 links to a dynamic library should call |DynLink.Load("path")|
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
42 in its initialization part.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
43 */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
44
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
45 #include "obx.h"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
46
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
47 #ifdef DYNLINK
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
48
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
49 #ifndef __USE_GNU
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
50 #define __USE_GNU
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
51 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
52 #include <dlfcn.h>
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
53
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
54 #ifdef USEFFI
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
55 #include <ffi.h>
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
56 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
57
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
58 void load_lib(char *fname) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
59 char buf[128];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
60
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
61 /* If the library name starts with '@', look in the OBC lib directory
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
62 and append the extension ".so" or ".dylib" au chois */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
63 if (fname[0] == '@') {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
64 char *dir = getenv("OBC_LIB");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
65 if (dir == NULL) dir = libpath;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
66 if (dir == NULL) panic("no runtime library");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
67 strcpy(buf, dir);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
68 strcat(buf, "/");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
69 strcat(buf, fname+1);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
70 strcat(buf, DLEXT);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
71 fname = buf;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
72 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
73
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
74 /* Load the library */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
75 if (dlopen(fname, RTLD_LAZY|RTLD_GLOBAL) == NULL)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
76 panic(dlerror());
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
77 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
78
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
79 #ifdef USEFFI
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
80 #define MAXP 16
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
81
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
82 typedef struct {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
83 void (*fun)(void);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
84 ffi_cif cif;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
85 } wrapper;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
86
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
87 static ffi_type *ffi_decode(char c) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
88 switch (c) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
89 case 'C':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
90 case 'I':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
91 return &ffi_type_sint32;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
92 case 'L':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
93 return &ffi_type_sint64;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
94 case 'F':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
95 return &ffi_type_float;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
96 case 'D':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
97 return &ffi_type_double;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
98 case 'P':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
99 case 'Q':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
100 case 'X':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
101 return &ffi_type_pointer;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
102 case 'V':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
103 return &ffi_type_void;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
104 default:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
105 panic("Bad type %c", c);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
106 return NULL;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
107 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
108 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
109
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
110 void dlstub(value *bp) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
111 value *cp = valptr(bp[CP]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
112 char *tstring = (char *) pointer(cp[CP_CODE]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
113
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
114 ffi_raw avals[MAXP], rval[2];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
115 int i, p = 0, q = 0;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
116 double d; longint z;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
117
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
118 FPINIT;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
119
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
120 for (i = 0; tstring[i+1] != '\0'; i++) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
121 switch (tstring[i+1]) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
122 case 'C':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
123 avals[q].sint = align_byte(bp[HEAD+p].i);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
124 p += 1; q += 1; break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
125 case 'I':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
126 avals[q].sint = bp[HEAD+p].i;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
127 p += 1; q += 1; break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
128 case 'L':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
129 z = get_long(&bp[HEAD+p]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
130 memcpy(avals[q].data, &z, sizeof(longint));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
131 p += 2; q += sizeof(longint)/sizeof(ffi_raw); break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
132 case 'F':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
133 avals[q].flt = bp[HEAD+p].f;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
134 p += 1; q += 1; break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
135 case 'D':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
136 d = get_double(&bp[HEAD+p]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
137 memcpy(avals[q].data, &d, sizeof(double));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
138 p += 2; q += sizeof(double)/sizeof(ffi_raw); break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
139 case 'P':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
140 avals[q].ptr = pointer(bp[HEAD+p]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
141 p += 1; q += 1; break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
142 case 'X':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
143 avals[q].ptr = pointer(bp[HEAD+p]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
144 p += 2; q += 1; break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
145 case 'Q':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
146 avals[q].ptr = ptrcast(uchar, get_long(&bp[HEAD+p]));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
147 p += 2; q += 1; break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
148 #ifdef SPECIALS
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
149 case 'S':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
150 /* Static link for compilers course -- ignored */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
151 p += 1; break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
152 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
153 default:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
154 panic("Bad type 2 %c", tstring[i+1]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
155 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
156 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
157
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
158 wrapper *w = (wrapper *) pointer(cp[CP_CONST]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
159 ffi_raw_call(&w->cif, w->fun, rval, avals);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
160
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
161 switch (tstring[0]) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
162 case 'C':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
163 case 'I':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
164 ob_res.i = rval->sint;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
165 break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
166 case 'L':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
167 memcpy(&z, rval, sizeof(longint));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
168 put_long(&ob_res, z);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
169 break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
170 case 'F':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
171 ob_res.f = rval->flt;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
172 break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
173 case 'D':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
174 memcpy(&d, rval, sizeof(double));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
175 put_double(&ob_res, d);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
176 break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
177 case 'P':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
178 ob_res.a = rval->uint;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
179 break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
180 case 'Q':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
181 put_long(&ob_res, (ptrtype) rval->ptr);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
182 break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
183 case 'V':
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
184 break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
185 default:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
186 panic("Bad type 3");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
187 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
188 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
189 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
190
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
191 primitive *find_prim(char *name) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
192 return (primitive *) dlsym(RTLD_DEFAULT, name);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
193 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
194
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
195 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
196
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
197 void load_lib(char *fname) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
198 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
199
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
200 primitive *find_prim(char *name) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
201 int i;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
202
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
203 for (i = 0; primtab[i].p_name != NULL; i++) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
204 if (strcmp(name, primtab[i].p_name) == 0)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
205 return primtab[i].p_prim;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
206 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
207
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
208 return NULL;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
209 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
210
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
211 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
212
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
213 void dltrap(value *bp) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
214 value *cp = valptr(bp[CP]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
215 char *tstring = (char *) pointer(cp[CP_CODE]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
216 char *name = tstring + strlen(tstring) + 1;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
217 primitive *prim = NULL;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
218
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
219 if (tstring[0] == '*')
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
220 prim = find_prim(name);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
221 else {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
222 /* Look for a static wrapper */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
223 char primname[32];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
224 sprintf(primname, "P_%s", name);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
225 prim = find_prim(primname);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
226 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
227
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
228 if (prim != NULL) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
229 cp[CP_PRIM].a = wrap_prim(prim);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
230 (*prim)(bp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
231 return;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
232 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
233
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
234 #ifdef DYNLINK
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
235 #ifdef USEFFI
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
236 /* Build a wrapper with FFI */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
237 void (*fun)(void) = (void(*)(void)) dlsym(RTLD_DEFAULT, name);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
238
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
239 if (fun != NULL && tstring[0] != '*') {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
240 int np = strlen(tstring)-1;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
241 ffi_type *rtype = ffi_decode(tstring[0]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
242 ffi_type **atypes =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
243 (ffi_type **) scratch_alloc(np * sizeof(ffi_type *));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
244 for (int i = 0; tstring[i+1] != '\0'; i++)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
245 atypes[i] = ffi_decode(tstring[i+1]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
246
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
247 wrapper *w = (wrapper *) scratch_alloc(sizeof(wrapper));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
248 w->fun = fun;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
249 ffi_prep_cif(&w->cif, FFI_DEFAULT_ABI, np, rtype, atypes);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
250
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
251 cp[CP_PRIM].a = dynstub;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
252 cp[CP_CONST].a = address(w);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
253
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
254 dlstub(bp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
255 return;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
256 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
257 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
258 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
259
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
260 panic("Couldn't find primitive %s", name);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
261 }