1 /* Part of SWI-Prolog
2
3 Author: Jan Wielemaker
4 E-mail: J.Wielemaker@vu.nl
5 WWW: http://www.swi-prolog.org
6 Copyright (c) 2008-2019, University of Amsterdam
7 VU University Amsterdam
8 All rights reserved.
9
10 Redistribution and use in source and binary forms, with or without
11 modification, are permitted provided that the following conditions
12 are met:
13
14 1. Redistributions of source code must retain the above copyright
15 notice, this list of conditions and the following disclaimer.
16
17 2. Redistributions in binary form must reproduce the above copyright
18 notice, this list of conditions and the following disclaimer in
19 the documentation and/or other materials provided with the
20 distribution.
21
22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33 POSSIBILITY OF SUCH DAMAGE.
34 */
35
36 /*#define O_DEBUG 1*/
37 #include "pl-incl.h"
38 #include "pl-comp.h"
39 #include "pl-inline.h"
40 #include "pl-wrap.h"
41
42 #define MAX_FLI_ARGS 10 /* extend switches on change */
43
44 Code
allocCodes(size_t n)45 allocCodes(size_t n)
46 { Code codes = allocHeapOrHalt(sizeof(code)*(n+1));
47
48 *codes++ = (code)n;
49
50 return codes;
51 }
52
53
54 static void
freeCodes(Code codes)55 freeCodes(Code codes)
56 { size_t size = (size_t)codes[-1];
57
58 if ( size > 0 ) /* 0: built-in, see initSupervisors() */
59 freeHeap(&codes[-1], (size+1)*sizeof(code));
60 }
61
62
63 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
64 freeCodesDefinition() destroys the supervisor of a predicate, replacing
65 it by the statically allocated S_VIRGIN supervisor. Note that a
66 predicate *always* has non-NULL def->codes.
67
68 If linger == FALSE, we are absolutely sure that it is harmless to
69 deallocate the old supervisor. If TRUE, there may be references. I.e.,
70 other threads may have started executing this predicate.
71 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
72
73 static void
free_codes_ptr(void * ptr)74 free_codes_ptr(void *ptr)
75 { freeCodes(ptr);
76 }
77
78
79 void
freeSupervisor(Definition def,Code codes,int do_linger)80 freeSupervisor(Definition def, Code codes, int do_linger)
81 { size_t size = (size_t)codes[-1];
82
83 if ( size > 0 ) /* 0: built-in, see initSupervisors() */
84 { if ( do_linger )
85 linger(&def->lingering, free_codes_ptr, codes);
86 else
87 freeHeap(&codes[-1], (size+1)*sizeof(code));
88 }
89 }
90
91
92 void
freeCodesDefinition(Definition def,int do_linger)93 freeCodesDefinition(Definition def, int do_linger)
94 { Code codes;
95
96 if ( (codes=def->codes) != SUPERVISOR(virgin) )
97 { if ( (codes = def->codes) )
98 { if ( unlikely(codes[0] == encode(S_CALLWRAPPER)) )
99 { resetWrappedSupervisor(def);
100 } else
101 { def->codes = SUPERVISOR(virgin);
102 freeSupervisor(def, codes, do_linger);
103 }
104 } else
105 def->codes = SUPERVISOR(virgin);
106 }
107 }
108
109
110 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
111 Foreign supervisors. Creates one of:
112
113 DET code: I_FOPEN, I_FCALLDETVA|I_FCALLDET<N>, I_FEXITDET
114 NDET code: I_FOPENNDET, I_FCALLNDETVA|I_FCALLNDET<N>, I_FEXITNDET, I_FREDO
115 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
116
117 #ifdef O_PROF_PENTIUM
118 #include "pentium.h"
119 static int prof_foreign_index = (I_HIGHEST+20);
120 #endif
121
122 int
createForeignSupervisor(Definition def,Func f)123 createForeignSupervisor(Definition def, Func f)
124 { assert(true(def, P_FOREIGN));
125
126 if ( false(def, P_VARARG) )
127 { if ( def->functor->arity > MAX_FLI_ARGS )
128 sysError("Too many arguments to foreign function %s (>%d)", \
129 predicateName(def), MAX_FLI_ARGS); \
130 }
131
132 if ( false(def, P_NONDET) )
133 { Code codes = allocCodes(4);
134
135 codes[0] = encode(I_FOPEN);
136 if ( true(def, P_VARARG) )
137 codes[1] = encode(I_FCALLDETVA);
138 else
139 codes[1] = encode(I_FCALLDET0+def->functor->arity);
140 codes[2] = (code)f;
141 codes[3] = encode(I_FEXITDET);
142
143 def->codes = codes;
144 } else
145 { Code codes = allocCodes(5);
146
147 codes[0] = encode(I_FOPENNDET);
148 if ( true(def, P_VARARG) )
149 codes[1] = encode(I_FCALLNDETVA);
150 else
151 codes[1] = encode(I_FCALLNDET0+def->functor->arity);
152 codes[2] = (code)f;
153 codes[3] = encode(I_FEXITNDET);
154 codes[4] = encode(I_FREDO);
155
156 def->codes = codes;
157 }
158
159 #ifdef O_PROF_PENTIUM
160 assert(prof_foreign_index < MAXPROF);
161 def->prof_index = prof_foreign_index++;
162 def->prof_name = strdup(predicateName(def));
163 #endif
164
165 succeed;
166 }
167
168
169 /*******************************
170 * PROLOG CASES *
171 *******************************/
172
173 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
174 getClauses() finds alive clauses and stores them into the array refp. It
175 stores at most `max' clauses and returns the total number of candidate
176 clauses. This code is only executed on static code and in theory there
177 should be no reason to validate the counts, but reconsulting files must
178 make us careful.
179 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
180
181 static int
getClauses(Definition def,ClauseRef * refp,int max)182 getClauses(Definition def, ClauseRef *refp, int max)
183 { GET_LD
184 ClauseRef cref;
185 int found = 0;
186
187 acquire_def(def);
188 for(cref = def->impl.clauses.first_clause; cref; cref = cref->next)
189 { if ( visibleClause(cref->value.clause, global_generation()) )
190 { if ( found < max )
191 refp[found] = cref;
192 found++;
193 }
194 }
195 release_def(def);
196
197 return found;
198 }
199
200
201 static Code
undefSupervisor(Definition def)202 undefSupervisor(Definition def)
203 { if ( def->impl.clauses.number_of_clauses == 0 && false(def, PROC_DEFINED) )
204 return SUPERVISOR(undef);
205
206 return NULL;
207 }
208
209 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
210 createSingleClauseSupervisor() creates a supervisor to call the one and
211 only clause of the predicate. Creates
212
213 S_TRUSTME <ClauseRef>
214 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
215
216 static Code
singleClauseSupervisor(Definition def)217 singleClauseSupervisor(Definition def)
218 { if ( def->impl.clauses.number_of_clauses == 1 )
219 { ClauseRef cref;
220 Code codes = allocCodes(2);
221 int found = getClauses(def, &cref, 1);
222
223 if ( found == 1 )
224 { DEBUG(1, Sdprintf("Single clause supervisor for %s\n",
225 predicateName(def)));
226
227 codes[0] = encode(S_TRUSTME);
228 codes[1] = (code)cref;
229
230 return codes;
231 }
232 freeCodes(codes);
233 }
234
235 return NULL;
236 }
237
238
239 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
240 createListSuperVisor() creates a supervisor for predicates that have two
241 clauses (possibly swapped):
242
243 pred([], ....)
244 pred([H|T], ...)
245
246 The code is
247
248 S_LIST <nilclause> <listclause>
249 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
250
251 static Code
listSupervisor(Definition def)252 listSupervisor(Definition def)
253 { if ( def->impl.clauses.number_of_clauses == 2 )
254 { ClauseRef cref[2];
255 word c[2];
256 int found = getClauses(def, cref, 2);
257
258 if ( found == 2 &&
259 arg1Key(cref[0]->value.clause->codes, &c[0]) &&
260 arg1Key(cref[1]->value.clause->codes, &c[1]) &&
261 ( (c[0] == ATOM_nil && c[1] == FUNCTOR_dot2) ||
262 (c[1] == ATOM_nil && c[0] == FUNCTOR_dot2) ) )
263 { Code codes = allocCodes(3);
264
265 DEBUG(1, Sdprintf("List supervisor for %s\n", predicateName(def)));
266
267 codes[0] = encode(S_LIST);
268 if ( c[0] == ATOM_nil )
269 { codes[1] = (code)cref[0];
270 codes[2] = (code)cref[1];
271 } else
272 { codes[1] = (code)cref[1];
273 codes[2] = (code)cref[0];
274 }
275
276 return codes;
277 }
278 }
279
280 return NULL;
281 }
282
283
284 static Code
dynamicSupervisor(Definition def)285 dynamicSupervisor(Definition def)
286 { if ( true(def, P_DYNAMIC) )
287 { if ( true(def, P_INCREMENTAL) )
288 return SUPERVISOR(incr_dynamic);
289 else
290 return SUPERVISOR(dynamic);
291 }
292
293 return NULL;
294 }
295
296
297 static Code
multifileSupervisor(Definition def)298 multifileSupervisor(Definition def)
299 { if ( true(def, P_MULTIFILE) )
300 return SUPERVISOR(multifile);
301
302 return NULL;
303 }
304
305
306 static Code
staticSupervisor(Definition def)307 staticSupervisor(Definition def)
308 { (void)def;
309
310 return SUPERVISOR(staticp);
311 }
312
313
314 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
315 Prepend the already provided supervisor with code for meta-argument
316 module qualifications.
317 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
318
319 static void
copySuperVisorCode(Buffer buf,Code add)320 copySuperVisorCode(Buffer buf, Code add)
321 { size_t len = supervisorLength(add);
322
323 addMultipleBuffer(buf, add, len, code);
324 }
325
326
327 static void
copyCodes(Code dest,Code src,size_t count)328 copyCodes(Code dest, Code src, size_t count)
329 { memcpy(dest, src, count*sizeof(code));
330 }
331
332
333 static Code
chainMetaPredicateSupervisor(Definition def,Code post)334 chainMetaPredicateSupervisor(Definition def, Code post)
335 { if ( true(def, P_META) && true(def, P_TRANSPARENT) )
336 { tmp_buffer buf;
337 unsigned int i;
338 int count = 0;
339 Code codes;
340
341 initBuffer(&buf);
342 for(i=0; i < def->functor->arity; i++)
343 { int ma = def->impl.any.args[i].meta;
344
345 if ( MA_NEEDS_TRANSPARENT(ma) )
346 { addBuffer(&buf, encode(S_MQUAL), code);
347 addBuffer(&buf, VAROFFSET(i), code);
348 count++;
349 }
350 }
351
352 if ( count > 0 )
353 { baseBuffer(&buf, code)[(count-1)*2] = encode(S_LMQUAL);
354
355 copySuperVisorCode((Buffer)&buf, post);
356 freeCodes(post);
357 codes = allocCodes(entriesBuffer(&buf, code));
358 copyCodes(codes, baseBuffer(&buf, code), entriesBuffer(&buf, code));
359
360 return codes;
361 } else
362 { discardBuffer(&buf);
363 }
364 }
365
366 return post;
367 }
368
369
370 /*******************************
371 * ENTRIES *
372 *******************************/
373
374 int
createUndefSupervisor(Definition def)375 createUndefSupervisor(Definition def)
376 { Code codes;
377
378 if ( (codes = undefSupervisor(def)) )
379 { def->codes = codes;
380
381 return TRUE;
382 }
383
384 return FALSE;
385 }
386
387
388 Code
createSupervisor(Definition def)389 createSupervisor(Definition def)
390 { Code codes;
391 int has_codes;
392
393 has_codes = ((codes = undefSupervisor(def)) ||
394 (codes = dynamicSupervisor(def)) ||
395 (codes = multifileSupervisor(def)) ||
396 (codes = singleClauseSupervisor(def)) ||
397 (codes = listSupervisor(def)) ||
398 (codes = staticSupervisor(def)));
399 assert(has_codes);
400 codes = chainMetaPredicateSupervisor(def, codes);
401
402 return codes;
403 }
404
405
406 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
407 setSupervisor() is synchronised with unloadFile() (reconsult/1). Seems
408 this is not yet enough to stop all racer conditions between this code.
409 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
410
411 int
setSupervisor(Definition def)412 setSupervisor(Definition def)
413 { Code codes;
414
415 if ( false(def, P_LOCKED_SUPERVISOR) )
416 { PL_LOCK(L_PREDICATE);
417 codes = createSupervisor(def);
418 MEMORY_BARRIER();
419 def->codes = codes;
420 PL_UNLOCK(L_PREDICATE);
421 }
422
423 return TRUE;
424 }
425
426
427 /*******************************
428 * INFO *
429 *******************************/
430
431 size_t
supervisorLength(Code base)432 supervisorLength(Code base)
433 { Code PC = base;
434 size_t len = (size_t)base[-1];
435
436 if ( len != 0 )
437 { return len;
438 } else
439 { for(; decode(*PC) != I_EXIT; PC = stepPC(PC))
440 ;
441 PC++; /* include I_EXIT */
442 return PC-base;
443 }
444 }
445
446 /* returns 0 for shared static supervisors
447 */
448
449 size_t
sizeof_supervisor(Code base)450 sizeof_supervisor(Code base)
451 { size_t size = (size_t)base[-1];
452
453 return size*sizeof(code);
454 }
455
456
457 /*******************************
458 * INIT *
459 *******************************/
460
461 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
462 Generic and reusable code-sequences. The entry-point of these sequences
463 must be accessed as:
464
465 SUPERVISOR(name)
466
467 The code sequence starts with 0 to avoid freeing using freeCodes(). It
468 ends in I_EXIT, such that generic code walkers will always find the end
469 of the sequence.
470 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
471
472 #define MAKE_SV1(name, i) { PL_code_data.supervisors.name[0] = (code)0; \
473 PL_code_data.supervisors.name[1] = encode(i); \
474 PL_code_data.supervisors.name[2] = encode(I_EXIT); \
475 }
476
477 void
initSupervisors(void)478 initSupervisors(void)
479 { MAKE_SV1(exit, I_EXIT);
480 MAKE_SV1(next_clause, S_NEXTCLAUSE);
481 MAKE_SV1(virgin, S_VIRGIN);
482 MAKE_SV1(undef, S_UNDEF);
483 MAKE_SV1(dynamic, S_DYNAMIC);
484 MAKE_SV1(incr_dynamic, S_INCR_DYNAMIC);
485 MAKE_SV1(thread_local, S_THREAD_LOCAL);
486 MAKE_SV1(multifile, S_MULTIFILE);
487 MAKE_SV1(staticp, S_STATIC);
488 MAKE_SV1(wrapper, S_WRAP);
489 MAKE_SV1(trie_gen, S_TRIE_GEN);
490 }
491