|
1 " |
|
2 COPYRIGHT (c) 1994 by Claus Gittinger |
|
3 All Rights Reserved |
|
4 |
|
5 This software is furnished under a license and may be used |
|
6 only in accordance with the terms of that license and with the |
|
7 inclusion of the above copyright notice. This software may not |
|
8 be provided or otherwise made available to, or used by, any |
|
9 other person. No title to or ownership of the software is |
|
10 hereby transferred. |
|
11 " |
|
12 |
|
13 ExecutableFunction subclass:#ExternalFunction |
|
14 instanceVariableNames:'' |
|
15 classVariableNames:'InvalidCustomFunctionSignal' |
|
16 poolDictionaries:'' |
|
17 category:'System-Support' |
|
18 ! |
|
19 |
|
20 !ExternalFunction primitiveDefinitions! |
|
21 %{ |
|
22 #ifdef NOTDEF /* already in stc.h */ |
|
23 typedef int (* INTFUNC)(); /* a function returning an int */ |
|
24 #endif |
|
25 %} |
|
26 ! ! |
|
27 |
|
28 !ExternalFunction primitiveFunctions! |
|
29 %{ |
|
30 |
|
31 /* |
|
32 * given an ST-object, make something useful for C |
|
33 * cast it to an int |
|
34 * |
|
35 * CAVEAT: floats are not allowed. |
|
36 */ |
|
37 int |
|
38 convertST_to_C(stObj) |
|
39 OBJ stObj; |
|
40 { |
|
41 if (__isString(stObj) || __isSymbol(stObj)) { |
|
42 return (int)(__stringVal(stObj)); |
|
43 } |
|
44 if (__isSmallInteger(stObj)) { |
|
45 return (int)(__intVal(stObj)); |
|
46 } |
|
47 if (__isCharacter(stObj)) { |
|
48 return (int)(__intVal(__characterVal(stObj))); |
|
49 } |
|
50 if (stObj == true) { |
|
51 return 1; |
|
52 } |
|
53 if (stObj == false) { |
|
54 return 0; |
|
55 } |
|
56 if (stObj == nil) { |
|
57 return 0; |
|
58 } |
|
59 return 0; |
|
60 } |
|
61 |
|
62 %} |
|
63 ! ! |
|
64 |
|
65 !ExternalFunction class methodsFor:'documentation'! |
|
66 |
|
67 copyright |
|
68 " |
|
69 COPYRIGHT (c) 1994 by Claus Gittinger |
|
70 All Rights Reserved |
|
71 |
|
72 This software is furnished under a license and may be used |
|
73 only in accordance with the terms of that license and with the |
|
74 inclusion of the above copyright notice. This software may not |
|
75 be provided or otherwise made available to, or used by, any |
|
76 other person. No title to or ownership of the software is |
|
77 hereby transferred. |
|
78 " |
|
79 ! |
|
80 |
|
81 documentation |
|
82 " |
|
83 Instances of this class represent external (non-Smalltalk) functions. |
|
84 |
|
85 Also, the class provides access to custom functions |
|
86 These custom functions enable you to call c functions even if no |
|
87 stc is available (they are kind of what user-primitives are in ST-80). |
|
88 You can register your own custom C-functions and relink ST/X from the |
|
89 binaries. |
|
90 (see the demo functions provided in main.c). |
|
91 |
|
92 Non custom externalFunctions provide the basic low level mechanism |
|
93 to call external C functions (as loaded dynamically by the ObjectLoader) |
|
94 - however, this is still in construction and |
|
95 NOT yet published for general use. |
|
96 |
|
97 For now, either use inline C-code, or use the customFunction call |
|
98 mechanism. |
|
99 " |
|
100 ! ! |
|
101 |
|
102 !ExternalFunction class methodsFor:'initialization'! |
|
103 |
|
104 initialize |
|
105 InvalidCustomFunctionSignal isNil ifTrue:[ |
|
106 InvalidCustomFunctionSignal := ExecutionErrorSignal newSignalMayProceed:true. |
|
107 InvalidCustomFunctionSignal nameClass:self message:#invalidCustomFunctionSignal. |
|
108 InvalidCustomFunctionSignal notifierString:'attempt to execute unknown custom function'. |
|
109 ] |
|
110 ! ! |
|
111 |
|
112 !ExternalFunction class methodsFor:'Signal constants'! |
|
113 |
|
114 invalidCustomFunctionSignal |
|
115 "return the signal raised when a non existent custom function is |
|
116 called for." |
|
117 |
|
118 ^ InvalidCustomFunctionSignal |
|
119 ! ! |
|
120 |
|
121 !ExternalFunction class methodsFor:'custom functions'! |
|
122 |
|
123 callCustomFunction:nr |
|
124 ^ self callCustomFunction:nr withArguments:#() |
|
125 |
|
126 " |
|
127 ExternalFunction callCustomFunction:0 |
|
128 ExternalFunction callCustomFunction:999 |
|
129 " |
|
130 ! |
|
131 |
|
132 callCustomFunction:nr with:arg |
|
133 ^ self callCustomFunction:nr withArguments:(Array with:arg) |
|
134 |
|
135 " |
|
136 ExternalFunction callCustomFunction:1 with:'hello world' |
|
137 " |
|
138 ! |
|
139 |
|
140 callCustomFunction:nr with:arg1 with:arg2 |
|
141 ^ self callCustomFunction:nr withArguments:(Array with:arg1 with:arg2) |
|
142 |
|
143 " |
|
144 ExternalFunction callCustomFunction:2 with:(Float pi) with:1.0 |
|
145 " |
|
146 ! |
|
147 |
|
148 callCustomFunction:nr with:arg1 with:arg2 with:arg3 |
|
149 ^ self callCustomFunction:nr |
|
150 withArguments:(Array with:arg1 with:arg2 with:arg3) |
|
151 ! |
|
152 |
|
153 callCustomFunction:nr withArguments:argArray |
|
154 |retVal called| |
|
155 |
|
156 %{ |
|
157 extern int stxNCustomFunctions; |
|
158 extern CUSTOMFUNCTION customFunctions[]; |
|
159 int (* func)(); |
|
160 |
|
161 called = false; |
|
162 if (__isSmallInteger(nr) && __isArray(argArray)) { |
|
163 int nargs = _arraySize(argArray); |
|
164 int functionNr; |
|
165 |
|
166 functionNr = _intVal(nr); |
|
167 if ((functionNr >= 0) && (functionNr < stxNCustomFunctions)) { |
|
168 /* |
|
169 * now, call the function; passing nargs and arg-vector |
|
170 */ |
|
171 func = customFunctions[functionNr].func; |
|
172 if (func) { |
|
173 int ok; |
|
174 |
|
175 retVal = self; |
|
176 ok = (*func)(nargs, &retVal, _ArrayInstPtr(argArray)->a_element); |
|
177 if (ok) { |
|
178 RETURN (retVal); |
|
179 } |
|
180 called = true; |
|
181 } |
|
182 } |
|
183 } |
|
184 %}. |
|
185 called ifTrue:[ |
|
186 " |
|
187 the customFunction returned 0 (failure) |
|
188 " |
|
189 ^ self primitiveFailed |
|
190 ]. |
|
191 |
|
192 " |
|
193 an invalid customFunction-nr was given, |
|
194 " |
|
195 InvalidCustomFunctionSignal raise |
|
196 |
|
197 |
|
198 " |
|
199 ExternalFunction callCustomFunction:2 withArguments:#(1.0 1.0) |
|
200 ExternalFunction callCustomFunction:999 withArguments:#(1.0 1.0) |
|
201 " |
|
202 ! |
|
203 |
|
204 callCustomFunctionNamed:name withArguments:argArray |
|
205 |index| |
|
206 |
|
207 index := self indexOfCustomFunctionNamed:name. |
|
208 index notNil ifTrue:[ |
|
209 ^ self callCustomFunction:index withArguments:argArray |
|
210 ]. |
|
211 " |
|
212 no such function exists |
|
213 " |
|
214 InvalidCustomFunctionSignal raise |
|
215 |
|
216 " |
|
217 ExternalFunction callCustomFunctionNamed:'demoFunction0' |
|
218 withArguments:#() |
|
219 " |
|
220 ! |
|
221 |
|
222 indexOfCustomFunctionNamed:functionName |
|
223 |
|
224 %{ /* NOCONTEXT */ |
|
225 extern int stxNCustomFunctions; |
|
226 extern CUSTOMFUNCTION customFunctions[]; |
|
227 |
|
228 if (__isString(functionName)) { |
|
229 char *nm; |
|
230 int i; |
|
231 |
|
232 nm = _stringVal(functionName); |
|
233 for (i=0; i<stxNCustomFunctions; i++) { |
|
234 if (strcmp(customFunctions[i].name, nm) == 0) { |
|
235 RETURN (_MKSMALLINT(i)); |
|
236 } |
|
237 } |
|
238 } |
|
239 %}. |
|
240 ^ nil |
|
241 |
|
242 " |
|
243 ExternalFunction indexOfCustomFunctionNamed:'demoFunction0' |
|
244 ExternalFunction indexOfCustomFunctionNamed:'fooBar' |
|
245 " |
|
246 ! ! |
|
247 |
|
248 !ExternalFunction methodsFor:'function calling'! |
|
249 |
|
250 call |
|
251 "call the underlying C function, passing no argument. |
|
252 The return value is interpreted as an integer |
|
253 (and must be converted to an externalBytes object, |
|
254 if it is a pointer to something). |
|
255 |
|
256 DANGER alert: This is an unprotected low-level entry. |
|
257 Not for normal application usage. |
|
258 " |
|
259 %{ |
|
260 INTFUNC func; |
|
261 int retVal; |
|
262 |
|
263 func = (INTFUNC) _INST(code_); |
|
264 retVal = (*func)(); |
|
265 RETURN (__MKINT(retVal)); |
|
266 %} |
|
267 ! |
|
268 |
|
269 callWith:arg |
|
270 "call the underlying C function, passing a single argument. |
|
271 The argument arg is converted to a corresponding C data type, |
|
272 as defined in the convertST_to_C() function. |
|
273 The return value is interpreted as an integer |
|
274 (and must be converted to an externalBytes object, |
|
275 if it is a pointer to something). |
|
276 |
|
277 DANGER alert: This is an unprotected low-level entry. |
|
278 Not for normal application usage. |
|
279 " |
|
280 %{ |
|
281 INTFUNC func; |
|
282 int retVal; |
|
283 |
|
284 func = (INTFUNC) _INST(code_); |
|
285 retVal = (*func)(convertST_to_C(arg)); |
|
286 RETURN (__MKINT(retVal)); |
|
287 %} |
|
288 ! |
|
289 |
|
290 callWithArguments:argArray |
|
291 "call the underlying C function, passing up to 10 arguments. |
|
292 The arguments are converted to a corresponding C data type, |
|
293 as defined in the convertST_to_C() function. |
|
294 The return value is interpreted as an integer |
|
295 (and must be converted to an externalBytes object, |
|
296 if it is a pointer to something). |
|
297 |
|
298 DANGER alert: This is an unprotected low-level entry. |
|
299 Not for normal application usage. |
|
300 " |
|
301 %{ |
|
302 INTFUNC func; |
|
303 # define NUMARGS 10 |
|
304 int args[NUMARGS]; |
|
305 int retVal; |
|
306 OBJ *ap; |
|
307 |
|
308 if (__isArray(argArray)) { |
|
309 int n = _arraySize(argArray); |
|
310 int i; |
|
311 |
|
312 if (n <= 10) { |
|
313 ap = _ArrayInstPtr(argArray)->a_element; |
|
314 for (i=0; i<NUMARGS; i++) { |
|
315 args[i] = convertST_to_C(*ap++); |
|
316 } |
|
317 } |
|
318 func = (INTFUNC) _INST(code_); |
|
319 switch (n) { |
|
320 case 0: |
|
321 retVal = (*func)(); |
|
322 break; |
|
323 case 1: |
|
324 retVal = (*func)(args[0]); |
|
325 break; |
|
326 case 2: |
|
327 retVal = (*func)(args[0], args[1]); |
|
328 break; |
|
329 case 3: |
|
330 retVal = (*func)(args[0], args[1], args[2]); |
|
331 break; |
|
332 case 4: |
|
333 retVal = (*func)(args[0], args[1], args[2], args[3]); |
|
334 break; |
|
335 case 5: |
|
336 retVal = (*func)(args[0], args[1], args[2], args[3], |
|
337 args[4]); |
|
338 break; |
|
339 case 6: |
|
340 retVal = (*func)(args[0], args[1], args[2], args[3], |
|
341 args[4], args[5]); |
|
342 break; |
|
343 case 7: |
|
344 retVal = (*func)(args[0], args[1], args[2], args[3], |
|
345 args[4], args[5], args[6]); |
|
346 break; |
|
347 case 8: |
|
348 retVal = (*func)(args[0], args[1], args[2], args[3], |
|
349 args[4], args[5], args[6], args[7]); |
|
350 break; |
|
351 case 9: |
|
352 retVal = (*func)(args[0], args[1], args[2], args[3], |
|
353 args[4], args[5], args[6], args[7], |
|
354 args[8]); |
|
355 break; |
|
356 case 10: |
|
357 retVal = (*func)(args[0], args[1], args[2], args[3], |
|
358 args[4], args[5], args[6], args[7], |
|
359 args[8], args[9]); |
|
360 break; |
|
361 default: |
|
362 goto err; |
|
363 } |
|
364 RETURN (__MKINT(retVal)); |
|
365 } |
|
366 err: ; |
|
367 %}. |
|
368 self primitiveFailed |
|
369 ! ! |
|
370 |
|
371 !ExternalFunction class methodsFor:'documentation'! |
|
372 |
|
373 version |
|
374 ^ '$Header: /cvs/stx/stx/libbasic/ExternalFunction.st,v 1.1 1996-01-11 13:51:36 cg Exp $' |
|
375 ! ! |
|
376 ExternalFunction initialize! |