1 /* Part of XPCE --- The SWI-Prolog GUI toolkit
2
3 Author: Jan Wielemaker and Anjo Anjewierden
4 E-mail: jan@swi.psy.uva.nl
5 WWW: http://www.swi.psy.uva.nl/projects/xpce/
6 Copyright (c) 1985-2002, University of Amsterdam
7 All rights reserved.
8
9 Redistribution and use in source and binary forms, with or without
10 modification, are permitted provided that the following conditions
11 are met:
12
13 1. Redistributions of source code must retain the above copyright
14 notice, this list of conditions and the following disclaimer.
15
16 2. Redistributions in binary form must reproduce the above copyright
17 notice, this list of conditions and the following disclaimer in
18 the documentation and/or other materials provided with the
19 distribution.
20
21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32 POSSIBILITY OF SUCH DAMAGE.
33 */
34
35 #ifdef PCE_INCLUDED
36 #if O_INLINE && INLINE_UTILITIES
37 #define INLINE static inline
38 #define USE_INLINE 1
39 #endif
40 #else
41 #include <h/kernel.h>
42 #define INLINE
43 #define USE_INLINE 1
44 #endif
45
46 #include <h/trace.h>
47
48 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
49 This file defines various time-critical general purpose-functions. Time
50 critical modules may wish to include this file in the following way:
51 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
52
53 #if USE_INLINE
54
55 /********************************
56 * OBJECT MANIPULATIONS *
57 ********************************/
58
59 INLINE status instanceOfObject(const Any obj, const Class super) PURE_FUNCTION;
60 INLINE status objectIsInstanceOf(const Any obj, const Class super) PURE_FUNCTION;
61
62 INLINE status
instanceOfObject(const Any obj,const Class super)63 instanceOfObject(const Any obj, const Class super)
64 { if ( isObject(obj) )
65 { Class class = classOfObject(obj);
66
67 return class == super || (class->tree_index >= super->tree_index &&
68 class->tree_index < super->neighbour_index);
69 }
70
71 fail;
72 }
73
74
75 INLINE status
objectIsInstanceOf(const Any obj,const Class super)76 objectIsInstanceOf(const Any obj, const Class super)
77 { const Class class = classOfObject(obj);
78
79 return class == super || (class->tree_index >= super->tree_index &&
80 class->tree_index < super->neighbour_index);
81 }
82
83
84 INLINE status
isProperObject(const Any obj)85 isProperObject(const Any obj)
86 { return (obj && isAddress(obj) && hasObjectMagic(obj));
87 }
88
89
90 /********************************
91 * HASHTABLES *
92 ********************************/
93
94
95 INLINE Any
getMemberHashTable(const HashTable ht,const Any name)96 getMemberHashTable(const HashTable ht, const Any name)
97 { int hashkey = hashKey(name, ht->buckets);
98 Symbol s = &ht->symbols[hashkey];
99
100 COUNT(hash_lookups++);
101
102 for(;;)
103 { if ( s->name == name )
104 return s->value;
105 if ( !s->name )
106 fail;
107 COUNT(hash_cmp_failed++);
108 if ( ++hashkey == ht->buckets )
109 { hashkey = 0;
110 s = ht->symbols;
111 } else
112 s++;
113 }
114
115 fail;
116 }
117
118
119 /*******************************
120 * REFERENCES FROM CODE *
121 *******************************/
122
123 INLINE void
unallocObject(Any obj)124 unallocObject(Any obj)
125 { unalloc(valInt(classOfObject(obj)->instance_size), obj);
126 }
127
128
129 INLINE void
addCodeReference(Any obj)130 addCodeReference(Any obj)
131 { Instance i = obj;
132
133 i->references += ONE_CODE_REF;
134 }
135
136
137 INLINE void
delCodeReference(Any obj)138 delCodeReference(Any obj)
139 { Instance i = obj;
140
141 i->references -= ONE_CODE_REF;
142 checkDeferredUnalloc(i);
143 }
144
145 /********************************
146 * CODE *
147 ********************************/
148
149 INLINE status
executeCode(Code c)150 executeCode(Code c)
151 { Class cl = classOfObject(c);
152 status rval;
153
154 addCodeReference(c);
155 FixSendFunctionClass(cl, NAME_Execute);
156 if ( onDFlag(c, D_SERVICE) )
157 { ServiceMode(PCE_EXEC_SERVICE, rval = (*cl->send_function)(c));
158 } else
159 rval = (*cl->send_function)(c);
160 delCodeReference(c);
161
162 return rval;
163 }
164
165
166 INLINE status
forwardBlockv(Block b,int argc,const Any argv[])167 forwardBlockv(Block b, int argc, const Any argv[])
168 { status rval;
169
170 if ( isNil(b->parameters) )
171 { withArgs(argc, argv, rval = executeCode((Code) b));
172 } else
173 { withLocalVars({ int i;
174 Var *vars = (Var *) b->parameters->elements;
175 int nvars = valInt(b->parameters->size);
176
177 for(i=0; i<argc; i++)
178 { if ( i < nvars )
179 assignVar(vars[i], argv[i], DEFAULT);
180 else
181 assignVar(Arg(i-nvars+1), argv[i], DEFAULT);
182 }
183 rval = executeCode((Code) b);
184 });
185 }
186
187 return rval;
188 }
189
190
191 INLINE status
forwardCodev(Code c,int argc,const Any argv[])192 forwardCodev(Code c, int argc, const Any argv[])
193 { status rval;
194
195 /*if ( instanceOfObject(c, ClassBlock) )*/
196 if ( c->class == ClassBlock )
197 return forwardBlockv((Block) c, argc, argv);
198
199 withArgs(argc, argv, rval = executeCode(c));
200
201 return rval;
202 }
203
204
205 /********************************
206 * FUNCTIONS *
207 ********************************/
208
209 INLINE Any
getExecuteFunction(Function f)210 getExecuteFunction(Function f)
211 { Class cl = classOfObject(f);
212 Any rval;
213
214 addCodeReference(f);
215 FixGetFunctionClass(cl, NAME_Execute);
216 if ( onDFlag(f, D_SERVICE) )
217 { ServiceMode(PCE_EXEC_SERVICE, rval = (*cl->get_function)(f));
218 } else
219 rval = (*cl->get_function)(f);
220 delCodeReference(f);
221
222 return rval;
223 }
224
225
226 INLINE Any
expandCodeArgument(Any arg)227 expandCodeArgument(Any arg)
228 { if ( isFunction(arg) )
229 return getExecuteFunction(arg);
230
231 return arg;
232 }
233
234
235 /********************************
236 * CLASSES *
237 ********************************/
238
239 #define RealiseClass(class) if ( (class)->realised != ON ) realiseClass(class)
240
241 INLINE Any
getSendMethodClass(Class class,Name name)242 getSendMethodClass(Class class, Name name)
243 { Any rval;
244
245 RealiseClass(class);
246 if ( !(rval = getMemberHashTable(class->send_table, name)) )
247 rval = getResolveSendMethodClass(class, name);
248
249 if ( notNil(rval) )
250 answer(rval);
251
252 fail;
253 }
254
255
256 INLINE Any
getGetMethodClass(Class class,Name name)257 getGetMethodClass(Class class, Name name)
258 { Any rval;
259
260 RealiseClass(class);
261 if ( !(rval = getMemberHashTable(class->get_table, name)) )
262 rval = getResolveGetMethodClass(class, name);
263
264 if ( notNil(rval) )
265 answer(rval);
266
267 fail;
268 }
269
270 /*******************************
271 * TYPES *
272 *******************************/
273
274 INLINE Any
checkType(const Any val,const Type t,const Any ctx)275 checkType(const Any val, const Type t, const Any ctx)
276 { if ( validateType(t, val, ctx) )
277 return val;
278
279 return getTranslateType(t, val, ctx);
280 }
281
282
283 INLINE Name
checkSelector(Any sel)284 checkSelector(Any sel)
285 { if ( isName(sel) )
286 return sel;
287
288 return checkType(sel, TypeName, NIL);
289 }
290
291 #else /*USE_INLINE*/
292
293 COMMON(void) unallocObject(Any obj);
294 COMMON(void) addCodeReference(Any obj);
295 COMMON(void) delCodeReference(Any obj);
296 COMMON(status) instanceOfObject(const Any, const Class) PURE_FUNCTION;
297 COMMON(status) objectIsInstanceOf(const Any obj, const Class super) PURE_FUNCTION;
298 COMMON(status) isProperObject(const Any);
299 COMMON(Any) getSendMethodClass(Class, Name);
300 COMMON(Any) getGetMethodClass(Class, Name);
301 COMMON(Any) getMemberHashTable(const HashTable, const Any);
302 COMMON(status) executeCode(Code);
303 COMMON(Any) getExecuteFunction(Function);
304 COMMON(status) forwardCodev(Code, int, const Any[]);
305 COMMON(status) forwardBlockv(Block, int, const Any[]);
306 COMMON(Any) expandCodeArgument(Any);
307 COMMON(Any) checkType(const Any val, const Type t, const Any ctx);
308 COMMON(Name) checkSelector(Any sel);
309
310 /* Donot write below this line */
311 #endif /*USE_INLINE*/
312