YAP 7.1.0
index.c
Go to the documentation of this file.
1/*************************************************************************
2 * *
3 * Yap Prolog *
4 * *
5 * Yap Prolog was developed at NCCUP - Universidade do Porto *
6 * *
7 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8 * *
9 **************************************************************************
10 * *
11 * File: index.c *
12 * comments: Indexing a Prolog predicate *
13 * *
14 * Last rev: $Date: 2008-08-07 20:51:21 $,$Author: vsc $
15 **
16 * $Log: not supported by cvs2svn $
17 * Revision 1.202 2008/07/11 17:02:07 vsc
18 * fixes by Bart and Tom: mostly libraries but nasty one in indexing
19 * compilation.
20 *
21 * Revision 1.201 2008/05/10 23:24:11 vsc
22 * fix threads and LU
23 *
24 * Revision 1.200 2008/04/16 17:16:47 vsc
25 * make static_clause only commit to a lause if it is sure that is the true
26 * clause. Otherwise, search for the clause.
27 *
28 * Revision 1.199 2008/04/14 21:20:35 vsc
29 * fixed a bug in static_clause (thanks to Jose Santos)
30 *
31 * Revision 1.198 2008/03/25 16:45:53 vsc
32 * make or-parallelism compile again
33 *
34 * Revision 1.197 2008/02/14 14:35:13 vsc
35 * fixes for indexing code.
36 *
37 * Revision 1.196 2008/01/30 10:35:43 vsc
38 * fix indexing in 64 bits (it would split ints from atoms :( ).
39 *
40 * Revision 1.195 2008/01/24 10:20:42 vsc
41 * clause should not try to discover who is fail.
42 *
43 * Revision 1.194 2008/01/24 00:11:59 vsc
44 * garbage collector was not asking for space.
45 * avoid 0 sized calls to mmap.
46 *
47 * Revision 1.193 2008/01/23 17:57:46 vsc
48 * valgrind it!
49 * enable atom garbage collection.
50 *
51 * Revision 1.192 2007/11/26 23:43:08 vsc
52 * fixes to support threads and assert correctly, even if inefficiently.
53 *
54 * Revision 1.191 2007/11/08 15:52:15 vsc
55 * fix some bugs in new dbterm code.
56 *
57 * Revision 1.190 2007/11/07 09:25:27 vsc
58 * speedup meta-calls
59 *
60 * Revision 1.189 2007/11/06 17:02:12 vsc
61 * compile ground terms away.
62 *
63 * Revision 1.188 2007/10/28 11:23:40 vsc
64 * fix overflow
65 *
66 * Revision 1.187 2007/09/22 08:38:05 vsc
67 * nb_ extra stuff plus an indexing overflow fix.
68 *
69 * Revision 1.186 2007/06/20 13:48:45 vsc
70 * fix bug in index emulator
71 *
72 * Revision 1.185 2007/05/02 11:01:37 vsc
73 * get rid of type punning warnings.
74 *
75 * Revision 1.184 2007/03/26 15:18:43 vsc
76 * debugging and clause/3 over tabled predicates would kill YAP.
77 *
78 * Revision 1.183 2007/03/21 23:23:46 vsc
79 * fix excessive trail cleaning in gc tr overflow.
80 *
81 * Revision 1.182 2007/01/28 14:26:36 vsc
82 * WIN32 support
83 *
84 * Revision 1.181 2007/01/08 08:27:19 vsc
85 * fix restore (Trevor)
86 * make indexing a bit faster on IDB
87 *
88 * Revision 1.180 2006/12/27 01:32:37 vsc
89 * diverse fixes
90 *
91 * Revision 1.179 2006/11/27 17:42:02 vsc
92 * support for UNICODE, and other bug fixes.
93 *
94 * Revision 1.178 2006/11/21 16:21:31 vsc
95 * fix I/O mess
96 * fix spy/reconsult mess
97 *
98 * Revision 1.177 2006/11/15 00:13:36 vsc
99 * fixes for indexing code.
100 *
101 * Revision 1.176 2006/11/08 01:53:08 vsc
102 * avoid generating suspensions on static code.
103 *
104 * Revision 1.175 2006/11/06 18:35:04 vsc
105 * 1estranha
106 *
107 * Revision 1.174 2006/10/25 02:31:07 vsc
108 * fix emulation of trust_logical
109 *
110 * Revision 1.173 2006/10/18 13:47:31 vsc
111 * index.c implementation of trust_logical was decrementing the wrong
112 * cp_tr
113 *
114 * Revision 1.172 2006/10/16 17:12:48 vsc
115 * fixes for threaded version.
116 *
117 * Revision 1.171 2006/10/11 14:53:57 vsc
118 * fix memory leak
119 * fix overflow handling
120 * VS: ----------------------------------------------------------------------
121 *
122 * Revision 1.170 2006/10/10 14:08:16 vsc
123 * small fixes on threaded implementation.
124 *
125 * Revision 1.169 2006/09/20 20:03:51 vsc
126 * improve indexing on floats
127 * fix sending large lists to DB
128 *
129 * Revision 1.168 2006/05/16 18:37:30 vsc
130 * WIN32 fixes
131 * compiler bug fixes
132 * extend interface
133 *
134 * Revision 1.167 2006/05/02 16:44:11 vsc
135 * avoid uninitialized memory at overflow.
136 *
137 * Revision 1.166 2006/05/02 16:39:06 vsc
138 * bug in indexing code
139 * fix warning messages for write.c
140 *
141 * Revision 1.165 2006/04/27 17:04:08 vsc
142 * don't use <= to compare with block top (libc may not have block header).
143 *
144 * Revision 1.164 2006/04/27 14:10:36 rslopes
145 * *** empty log message ***
146 *
147 * Revision 1.163 2006/04/20 15:28:08 vsc
148 * more graph stuff.
149 *
150 * Revision 1.162 2006/04/12 18:56:50 vsc
151 * fix bug in clause: a trust_me followed by a try should be implemented by
152 * reusing the choice-point.
153 *
154 * Revision 1.161 2006/04/05 00:16:54 vsc
155 * Lots of fixes (check logfile for details
156 *
157 * Revision 1.160 2006/03/24 17:13:41 rslopes
158 * New update to BEAM engine.
159 * BEAM now uses YAP Indexing (JITI)
160 *
161 * Revision 1.159 2006/03/22 20:07:28 vsc
162 * take better care of zombies
163 *
164 * Revision 1.158 2006/03/21 21:30:54 vsc
165 * avoid looking around when expanding for statics too.
166 *
167 * Revision 1.157 2006/03/21 19:20:34 vsc
168 * fix fix on index expansion
169 *
170 * Revision 1.156 2006/03/21 17:11:39 vsc
171 * prevent breakage
172 *
173 * Revision 1.155 2006/03/21 15:06:35 vsc
174 * fixes to handle expansion of dyn amic predicates more efficiently.
175 *
176 * Revision 1.154 2006/03/20 19:51:43 vsc
177 * fix indexing and tabling bugs
178 *
179 * Revision 1.153 2006/02/22 11:55:36 vsc
180 * indexing code would get confused about size of float/1, db_reference1.
181 *
182 * Revision 1.152 2006/02/19 02:55:46 vsc
183 * disable indexing on bigints
184 *
185 * Revision 1.151 2006/01/16 02:57:51 vsc
186 * fix bug with very large integers
187 * fix bug where indexing code was looking at code after a cut.
188 *
189 * Revision 1.150 2005/12/23 00:20:13 vsc
190 * updates to gprof
191 * support for __POWER__
192 * Try to saveregs before siglongjmp.
193 *
194 * Revision 1.149 2005/12/17 03:25:39 vsc
195 * major changes to support online event-based profiling
196 * improve error discovery and restart on scanner.
197 *
198 * Revision 1.148 2005/11/24 15:33:52 tiagosoares
199 * removed some compilation warnings related to the cut-c code
200 *
201 * Revision 1.147 2005/11/18 18:48:52 tiagosoares
202 * support for executing c code when a cut occurs
203 *
204 * Revision 1.146 2005/10/29 02:21:47 vsc
205 * people should be able to disable indexing.
206 *
207 * Revision 1.145 2005/09/08 22:06:44 rslopes
208 * BEAM for YAP update...
209 *
210 * Revision 1.144 2005/08/17 18:48:35 vsc
211 * fix bug in processing overflows of expand_clauses.
212 *
213 * Revision 1.143 2005/08/02 03:09:50 vsc
214 * fix debugger to do well nonsource predicates.
215 *
216 * Revision 1.142 2005/08/01 15:40:37 ricroc
217 * TABLING NEW: better support for incomplete tabling
218 *
219 * Revision 1.141 2005/07/19 16:54:20 rslopes
220 * fix for older compilers...
221 *
222 * Revision 1.140 2005/07/18 17:41:16 vsc
223 * Yap should respect single argument indexing.
224 *
225 * Revision 1.139 2005/07/06 19:33:53 ricroc
226 * TABLING: answers for completed calls can now be obtained by loading (new
227 *option) or executing (default) them from the trie data structure.
228 *
229 * Revision 1.138 2005/07/05 18:32:32 vsc
230 * ifix some wierd cases in indexing code:
231 * would not look at next argument
232 * problem with pvar as last clause (R Camacho).
233 *
234 * Revision 1.137 2005/06/04 07:27:34 ricroc
235 * long int support for tabling
236 *
237 * Revision 1.136 2005/06/03 08:26:32 ricroc
238 * float support for tabling
239 *
240 * Revision 1.135 2005/06/01 20:25:23 vsc
241 * == and \= should not need a choice-point in ->
242 *
243 * Revision 1.134 2005/06/01 16:42:30 vsc
244 * put switch_list_nl back
245 *
246 * Revision 1.133 2005/06/01 14:02:50 vsc
247 * get_rid of try_me?, retry_me? and trust_me? instructions: they are not
248 * significantly used nowadays.
249 *
250 * Revision 1.132 2005/05/31 20:04:17 vsc
251 * fix cleanup of expand_clauses: make sure we have everything with NULL
252 *afterwards.
253 *
254 * Revision 1.131 2005/05/31 19:42:27 vsc
255 * insert some more slack for indices in LU
256 * Use doubly linked list for LU indices so that updating is less cumbersome.
257 *
258 * Revision 1.130 2005/05/31 04:46:06 vsc
259 * fix expand_index on tabled code.
260 *
261 * Revision 1.129 2005/05/31 02:15:53 vsc
262 * fix SYSTEM_ERROR_INTERNAL messages
263 *
264 * Revision 1.128 2005/05/30 05:26:49 vsc
265 * fix tabling
266 * allow atom gc again for now.
267 *
268 * Revision 1.127 2005/05/27 21:44:00 vsc
269 * Don't try to mess with sequences that don't end with a trust.
270 * A fix for the atom garbage collector actually ignore floats ;-).
271 *
272 * Revision 1.126 2005/05/25 18:58:37 vsc
273 * fix another bug in nth_instance, thanks to Pat Caldon
274 *
275 * Revision 1.125 2005/04/28 14:50:45 vsc
276 * clause should always deref before testing type
277 *
278 * Revision 1.124 2005/04/27 20:09:25 vsc
279 * indexing code could get confused with suspension points
280 * some further improvements on oveflow handling
281 * fix paths in Java makefile
282 * changs to support gibbs sampling in CLP(BN)
283 *
284 * Revision 1.123 2005/04/21 13:53:05 vsc
285 * fix bug with (var(X) -> being interpreted as var(X) by indexing code
286 *
287 * Revision 1.122 2005/04/10 04:01:12 vsc
288 * bug fixes, I hope!
289 *
290 * Revision 1.121 2005/04/07 17:48:54 ricroc
291 * Adding tabling support for mixed strategy evaluation (batched and local
292 *scheduling)
293 * UPDATE: compilation flags -DTABLING_BATCHED_SCHEDULING and
294 *-DTABLING_LOCAL_SCHEDULING removed. To support tabling use -DTABLING in the
295 *Makefile or --enable-tabling in configure.
296 * NEW: yap_flag(tabling_mode,MODE) changes the tabling execution mode of all
297 *tabled predicates to MODE (batched, local or default).
298 * NEW: tabling_mode(PRED,MODE) changes the default tabling execution mode of
299 *predicate PRED to MODE (batched or local).
300 *
301 * Revision 1.120 2005/03/15 18:29:23 vsc
302 * fix GPL
303 * fix idb: stuff in coroutines.
304 *
305 * Revision 1.119 2005/03/04 20:30:12 ricroc
306 * bug fixes for YapTab support
307 *
308 * Revision 1.118 2005/03/01 22:25:08 vsc
309 * fix pruning bug
310 * make DL_MALLOC less enthusiastic about walking through buckets.
311 *
312 * Revision 1.117 2005/02/25 00:09:06 vsc
313 * fix fix, otherwise I'd remove two choice-points :-(.
314 *
315 * Revision 1.116 2005/02/24 21:46:39 vsc
316 * Improve error handling routine, trying to make it more robust.
317 * Improve hole handling in stack expansion
318 * Clause interrpeter was supposed to prune _trust_me
319 * Wrong messages for acos and atanh
320 *
321 * Revision 1.115 2005/02/21 16:50:00 vsc
322 * amd64 fixes
323 * library fixes
324 *
325 * Revision 1.114 2005/01/28 23:14:36 vsc
326 * move to Yap-4.5.7
327 * Fix clause size
328 *
329 * Revision 1.113 2005/01/15 05:21:36 vsc
330 * fix bug in clause emulator
331 *
332 * Revision 1.112 2004/12/28 22:20:35 vsc
333 * some extra bug fixes for trail overflows: some cannot be recovered that
334 *easily,
335 * some can.
336 *
337 * Revision 1.111 2004/12/21 17:17:15 vsc
338 * miscounting of variable-only clauses in groups might lead to bug in indexing
339 * code.
340 *
341 * Revision 1.110 2004/12/06 04:50:22 vsc
342 * fix bug in removing first clause of a try sequence (lu preds)
343 *
344 * Revision 1.109 2004/12/05 05:01:24 vsc
345 * try to reduce overheads when running with goal expansion enabled.
346 * CLPBN fixes
347 * Handle overflows when allocating big clauses properly.
348 *
349 * Revision 1.108 2004/11/19 22:08:42 vsc
350 * replace SYSTEM_ERROR_INTERNAL by out OUT_OF_WHATEVER_ERROR whenever
351 *appropriate.
352 *
353 * Revision 1.107 2004/11/19 17:14:14 vsc
354 * a few fixes for 64 bit compiling.
355 *
356 * Revision 1.106 2004/11/18 22:32:36 vsc
357 * fix situation where we might assume nonextsing double initialization of C
358 *predicates (use
359 * Hidden Pred Flag).
360 * $host_type was double initialized.
361 *
362 * Revision 1.105 2004/11/04 18:22:32 vsc
363 * don't ever use memory that has been freed (that was done by LU).
364 * generic fixes for WIN32 libraries
365 *
366 * Revision 1.104 2004/10/27 15:56:33 vsc
367 * bug fixes on memory overflows and on clauses :- fail being ignored by clause.
368 *
369 * Revision 1.103 2004/10/22 16:53:19 vsc
370 * bug fixes
371 *
372 * Revision 1.102 2004/10/04 18:56:19 vsc
373 * fixes for thread support
374 * fix indexing bug (serious)
375 *
376 * Revision 1.101 2004/09/30 21:37:41 vsc
377 * fixes for thread support
378 *
379 * Revision 1.100 2004/09/30 19:51:54 vsc
380 * fix overflow from within clause/2
381 *
382 * Revision 1.99 2004/09/27 20:45:03 vsc
383 * Mega clauses
384 * Fixes to sizeof(expand_clauses) which was being overestimated
385 * Fixes to profiling+indexing
386 * Fixes to reallocation of memory after restoring
387 * Make sure all clauses, even for C, end in _Ystop
388 * Don't reuse space for Streams
389 * Fix Stream_F on StreaNo+1
390 *
391 * Revision 1.98 2004/09/14 03:30:06 vsc
392 * make sure that condor version always grows trail!
393 *
394 * Revision 1.97 2004/09/03 03:11:09 vsc
395 * memory management fixes
396 *
397 * Revision 1.96 2004/08/27 20:18:52 vsc
398 * more small fixes
399 *
400 * Revision 1.95 2004/08/11 16:14:52 vsc
401 * whole lot of fixes:
402 * - memory leak in indexing
403 * - memory management in WIN32 now supports holes
404 * - extend Yap interface, more support for SWI-Interface
405 * - new predicate mktime in system
406 * - buffer console I/O in WIN32
407 *
408 * Revision 1.94 2004/07/29 18:15:18 vsc
409 * fix severe bug in indexing of floating point numbers
410 *
411 * Revision 1.93 2004/07/23 19:01:14 vsc
412 * fix bad ref count in expand_clauses when copying indexing block
413 *
414 * Revision 1.92 2004/06/29 19:04:42 vsc
415 * fix multithreaded version
416 * include new version of Ricardo's profiler
417 * new predicat atomic_concat
418 * allow multithreaded-debugging
419 * small fixes
420 *
421 * Revision 1.91 2004/06/17 22:07:23 vsc
422 * bad bug in indexing code.
423 *
424 * Revision 1.90 2004/04/29 03:44:04 vsc
425 * fix bad suspended clause counter
426 *
427 * Revision 1.89 2004/04/27 15:03:43 vsc
428 * more fixes for expand_clauses
429 *
430 * Revision 1.88 2004/04/22 03:24:17 vsc
431 * trust_logical should protect the last clause, otherwise it cannot
432 * jump there.
433 *
434 * Revision 1.87 2004/04/21 04:01:53 vsc
435 * fix bad ordering when inserting second clause
436 *
437 * Revision 1.86 2004/04/20 22:08:23 vsc
438 * fixes for corourining
439 *
440 * Revision 1.85 2004/04/16 19:27:31 vsc
441 * more bug fixes
442 *
443 * Revision 1.84 2004/04/14 19:10:38 vsc
444 * expand_clauses: keep a list of clauses to expand
445 * fix new trail scheme for multi-assignment variables
446 *
447 * Revision 1.83 2004/04/07 22:04:04 vsc
448 * fix memory leaks
449 *
450 * Revision 1.82 2004/03/31 01:02:18 vsc
451 * if number of left-over < 1/5 keep list of clauses to expand around
452 * fix call to stack expander
453 *
454 * Revision 1.81 2004/03/25 02:19:10 pmoura
455 * Removed debugging line to allow compilation.
456 *
457 * Revision 1.80 2004/03/19 11:35:42 vsc
458 * trim_trail for default machine
459 * be more aggressive about try-retry-trust chains.
460 * - handle cases where block starts with a wait
461 * - don't use _killed instructions, just let the thing rot by itself.
462 * *
463 * *
464 *************************************************************************/
465#ifdef SCCS
466static char SccsId[] = "%W% %G%";
467#endif
468
611/*
612 * This file compiles and removes the indexation code for the prolog compiler
613 *
614 * Some remarks: *try_me always point to inside the code;
615 * try always points to outside
616 *
617
618 Algorithm:
619
620 - fetch info on all clauses
621 - if #clauses =1 return
622 - compute groups:
623 seq of variable only clauses
624 seq: of one or more type instructions
625 bound clauses
626 - sort group
627 - select constant
628 --> type instructions
629 --> count constants
630 --> switch
631 for all arguments:
632 select new argument
633
634*/
635
636#include "absmi.h"
637#include "YapCompile.h"
638#if DEBUG
639#include "yapio.h"
640#endif
641
642#include "index.h"
643
644#ifndef NULL
645#define NULL (void *)0
646#endif
647#if HAVE_STRING_H
648#include <string.h>
649#endif
650#include "cut_c.h"
651
652#if defined(YAPOR) || defined(THREADS)
653#define SET_JLBL(X) jlbl = &(ipc->y_u.X)
654#else
655#define SET_JLBL(X)
656#endif
657
658static UInt do_index(ClauseDef *, ClauseDef *, struct intermediates *, UInt,
659 UInt, int, int, CELL *);
660static UInt do_compound_index(ClauseDef *, ClauseDef *, Term *t,
661 struct intermediates *, UInt, UInt, UInt, UInt,
662 int, int, int, CELL *, int);
663static UInt do_dbref_index(ClauseDef *, ClauseDef *, Term,
664 struct intermediates *, UInt, UInt, int, int,
665 CELL *);
666static UInt do_blob_index(ClauseDef *, ClauseDef *, Term,
667 struct intermediates *, UInt, UInt, int, int, CELL *,
668 int);
669
670static UInt cleanup_sw_on_clauses(CELL larg, UInt sz, OPCODE ecls) {
671 if (larg & 1) {
672 return sz;
673 } else {
674 yamop *xp = (yamop *)larg;
675 if (xp->opc == ecls) {
676 if (xp->y_u.sssllp.s3 == 1) {
677 UInt nsz = sz + (UInt)(NEXTOP((yamop *)NULL, sssllp)) +
678 xp->y_u.sssllp.s1 * sizeof(yamop *);
679 LOCK(ExpandClausesListLock);
680 if (ExpandClausesFirst == xp)
681 ExpandClausesFirst = xp->y_u.sssllp.snext;
682 if (ExpandClausesLast == xp) {
683 ExpandClausesLast = xp->y_u.sssllp.sprev;
684 }
685 if (xp->y_u.sssllp.sprev) {
686 xp->y_u.sssllp.sprev->y_u.sssllp.snext = xp->y_u.sssllp.snext;
687 }
688 if (xp->y_u.sssllp.snext) {
689 xp->y_u.sssllp.snext->y_u.sssllp.sprev = xp->y_u.sssllp.sprev;
690 }
691 UNLOCK(ExpandClausesListLock);
692#if DEBUG
693 Yap_ExpandClauses--;
694 Yap_expand_clauses_sz -= (UInt)(NEXTOP((yamop *)NULL, sssllp)) +
695 xp->y_u.sssllp.s1 * sizeof(yamop *);
696#endif
697 if (xp->y_u.sssllp.p->PredFlags & LogUpdatePredFlag) {
698 Yap_LUIndexSpace_EXT -= (UInt)NEXTOP((yamop *)NULL, sssllp) +
699 xp->y_u.sssllp.s1 * sizeof(yamop *);
700 } else
701 Yap_IndexSpace_EXT -= (UInt)(NEXTOP((yamop *)NULL, sssllp)) +
702 xp->y_u.sssllp.s1 * sizeof(yamop *);
703 Yap_FreeCodeSpace((char *)xp);
704 return nsz;
705 } else {
706 xp->y_u.sssllp.s3--;
707 return sz;
708 }
709 } else {
710 return sz;
711 }
712 }
713}
714
715static UInt recover_from_failed_susp_on_cls(struct intermediates *cint,
716 UInt sz) {
717 /* we have to recover all allocated blocks,
718 just follow the code through. */
719 struct PSEUDO *cpc = cint->CodeStart;
720 OPCODE ecls = Yap_opcode(_expand_clauses);
721 pred_flags_t log_upd_pred = cint->CurrentPred->PredFlags & LogUpdatePredFlag;
722
723 while (cpc) {
724 switch (cpc->op) {
725 case enter_lu_op:
726 if (cpc->rnd4) {
727 yamop *code_p = (yamop *)cpc->rnd4;
728 yamop *first = code_p->y_u.Illss.l1;
729 yamop *last = code_p->y_u.Illss.l2;
730 while (first) {
731 yamop *next = first->y_u.OtaLl.n;
732 LogUpdClause *cl = first->y_u.OtaLl.d;
733 cl->ClRefCount--;
734 Yap_FreeCodeSpace((char *)first);
735 if (first == last)
736 break;
737 first = next;
738 }
739 }
740 cpc->rnd4 = Zero;
741 break;
742 case jump_v_op:
743 case jump_nv_op:
744 sz = cleanup_sw_on_clauses(cpc->rnd1, sz, ecls);
745 break;
746 case switch_on_type_op: {
747 TypeSwitch *type_sw = (TypeSwitch *)(cpc->arnds);
748 sz = cleanup_sw_on_clauses(type_sw->PairEntry, sz, ecls);
749 sz = cleanup_sw_on_clauses(type_sw->ConstEntry, sz, ecls);
750 sz = cleanup_sw_on_clauses(type_sw->FuncEntry, sz, ecls);
751 sz = cleanup_sw_on_clauses(type_sw->VarEntry, sz, ecls);
752 } break;
753 case switch_c_op:
754 case if_c_op: {
755 AtomSwiEntry *target = (AtomSwiEntry *)(cpc->rnd2);
756 int cases = cpc->rnd1, i;
757
758 for (i = 0; i < cases; i++) {
759 sz = cleanup_sw_on_clauses(target[i].u_a.Label, sz, ecls);
760 }
761 if (log_upd_pred) {
762 LogUpdIndex *lcl = ClauseCodeToLogUpdIndex(cpc->rnd2);
763 sz += sizeof(LogUpdIndex) + cases * sizeof(AtomSwiEntry);
764 Yap_LUIndexSpace_SW -=
765 sizeof(LogUpdIndex) + cases * sizeof(AtomSwiEntry);
766 Yap_FreeCodeSpace((char *)lcl);
767 } else {
768 StaticIndex *scl = ClauseCodeToStaticIndex(cpc->rnd2);
769 sz += sizeof(StaticIndex) + cases * sizeof(AtomSwiEntry);
770 Yap_IndexSpace_SW -= sizeof(StaticIndex) + cases * sizeof(AtomSwiEntry);
771 Yap_FreeCodeSpace((char *)scl);
772 }
773 } break;
774 case switch_f_op:
775 case if_f_op: {
776 FuncSwiEntry *target = (FuncSwiEntry *)(cpc->rnd2);
777 int cases = cpc->rnd1, i;
778
779 for (i = 0; i < cases; i++) {
780 sz = cleanup_sw_on_clauses(target[i].u_f.Label, sz, ecls);
781 }
782 if (log_upd_pred) {
783 LogUpdIndex *lcl = ClauseCodeToLogUpdIndex(cpc->rnd2);
784 sz += sizeof(LogUpdIndex) + cases * sizeof(FuncSwiEntry);
785 Yap_LUIndexSpace_SW -=
786 sizeof(LogUpdIndex) + cases * sizeof(FuncSwiEntry);
787 Yap_FreeCodeSpace((char *)lcl);
788 } else {
789 StaticIndex *scl = ClauseCodeToStaticIndex(cpc->rnd2);
790 Yap_IndexSpace_SW -= sizeof(StaticIndex) + cases * sizeof(FuncSwiEntry);
791 sz += sizeof(StaticIndex) + cases * sizeof(FuncSwiEntry);
792 Yap_FreeCodeSpace((char *)scl);
793 }
794 } break;
795 default:
796 break;
797 }
798 cpc = cpc->nextInst;
799 }
800 Yap_ReleaseCMem(cint);
801 if (cint->code_addr) {
802 Yap_FreeCodeSpace((char *)cint->code_addr);
803 cint->code_addr = NULL;
804 }
805 return sz;
806}
807
808static inline int smaller(Term t1, Term t2) {
809 CELL tg1 = LowTagOf(t1), tg2 = LowTagOf(t2);
810 if (tg1 == tg2) {
811 return t1 < t2;
812 } else
813 return tg1 < tg2;
814}
815
816static inline int smaller_or_eq(Term t1, Term t2) {
817 CELL tg1 = LowTagOf(t1), tg2 = LowTagOf(t2);
818 if (tg1 == tg2) {
819 return t1 <= t2;
820 } else
821 return tg1 < tg2;
822}
823
824static inline void clcpy(ClauseDef *d, ClauseDef *s) {
825 memcpy((void *)d, (void *)s, sizeof(ClauseDef));
826}
827
828static void insort(ClauseDef base[], CELL *p, CELL *q, int my_p) {
829 CELL *j;
830
831 if (my_p) {
832 p[1] = p[0];
833 for (j = p; j < q; j += 2) {
834 Term key;
835 Int off = *j;
836 CELL *i;
837
838 key = base[off].Tag;
839 i = j + 1;
840
841 /* we are at offset 1 */
842 while (i > p + 1 && smaller(key, base[i[-2]].Tag)) {
843 i[0] = i[-2];
844 i -= 2;
845 }
846 i[0] = off;
847 }
848 } else {
849 for (j = p + 2; j < q; j += 2) {
850 Term key;
851 Int off = *j;
852 CELL *i;
853
854 key = base[off].Tag;
855 i = j;
856
857 /* we are at offset 1 */
858 while (i > p && smaller(key, base[i[-2]].Tag)) {
859 i[0] = i[-2];
860 i -= 2;
861 }
862 i[0] = off;
863 }
864 }
865}
866
867/* copy to a new list of terms */
868static void msort(ClauseDef *base, CELL *pt, Int size, int my_p) {
869
870 if (size > 2) {
871 Int half_size = size / 2;
872 CELL *pt_left, *pt_right, *end_pt, *end_pt_left;
873 int left_p, right_p;
874
875 if (size < 50) {
876 insort(base, pt, pt + 2 * size, my_p);
877 return;
878 }
879 pt_right = pt + half_size * 2;
880 left_p = my_p ^ 1;
881 right_p = my_p;
882 msort(base, pt, half_size, left_p);
883 msort(base, pt_right, size - half_size, right_p);
884 /* now implement a simple merge routine */
885
886 /* pointer to after the end of the list */
887 end_pt = pt + 2 * size;
888 /* pointer to the element after the last element to the left */
889 end_pt_left = pt + half_size * 2;
890 /* where is left list */
891 pt_left = pt + left_p;
892 /* where is right list */
893 pt_right += right_p;
894 /* where is new list */
895 pt += my_p;
896 /* while there are elements in the left or right vector do compares */
897 while (pt_left < end_pt_left && pt_right < end_pt) {
898 /* if the element to the left is larger than the one to the right */
899 if (smaller_or_eq(base[pt_left[0]].Tag, base[pt_right[0]].Tag)) {
900 /* copy the one to the left */
901 pt[0] = pt_left[0];
902 /* and avance the two pointers */
903 pt += 2;
904 pt_left += 2;
905 } else {
906 /* otherwise, copy the one to the right */
907 pt[0] = pt_right[0];
908 pt += 2;
909 pt_right += 2;
910 }
911 }
912 /* if any elements were left in the left vector just copy them */
913 while (pt_left < end_pt_left) {
914 pt[0] = pt_left[0];
915 pt += 2;
916 pt_left += 2;
917 }
918 /* if any elements were left in the right vector
919 and they are in the wrong place, just copy them */
920 if (my_p != right_p) {
921 while (pt_right < end_pt) {
922 pt[0] = pt_right[0];
923 pt += 2;
924 pt_right += 2;
925 }
926 }
927 } else {
928 if (size > 1 && smaller(base[pt[2]].Tag, base[pt[0]].Tag)) {
929 CELL t = pt[2];
930 pt[2 + my_p] = pt[0];
931 pt[my_p] = t;
932 } else if (my_p) {
933 pt[1] = pt[0];
934 if (size > 1)
935 pt[3] = pt[2];
936 }
937 }
938}
939
940static void copy_back(ClauseDef *dest, CELL *pt, int max) {
941 /* first need to say that we had no need to make a copy */
942 int i;
943 CELL *tmp = pt;
944 for (i = 0; i < max; i++) {
945 if (*tmp != i) {
946 ClauseDef cl;
947 int j = i;
948 CELL *pnt = tmp;
949
950 /* found a chain */
951 /* make a backup copy */
952 clcpy(&cl, dest + i);
953 do {
954 /* follow the chain */
955 int k = *pnt;
956
957 *pnt = j;
958 /* printf("i=%d, k = %d, j = %d\n",i,j,k); */
959 if (k == i) {
960 clcpy(dest + j, &cl);
961 break;
962 } else {
963 clcpy(dest + j, dest + k);
964 }
965 pnt = pt + 2 * k;
966 j = k;
967 } while (TRUE);
968 }
969 /* we don't need to do swap */
970 tmp += 2;
971 }
972}
973
974/* sort a group of clauses by using their tags */
975static void sort_group(GroupDef *grp, CELL *top, struct intermediates *cint) {
976 int max = (grp->LastClause - grp->FirstClause) + 1, i;
977 CELL *pt, *base;
978
979#if USE_SYSTEM_MALLOC
980 if (!(base = (CELL *)Yap_AllocCodeSpace(2 * max * sizeof(CELL)))) {
981 CACHE_REGS
982 save_machine_regs();
983 LOCAL_Error_Size = 2 * max * sizeof(CELL);
984 siglongjmp(cint->CompilerBotch, 2);
985 }
986#else
987 base = top;
988 while (top + 2 * max > (CELL *)LOCAL_TrailTop) {
989 if (!Yap_growtrail(2 * max * CellSize, TRUE)) {
990 LOCAL_Error_Size = 2 * max * CellSize;
991 save_machine_regs();
992 siglongjmp(cint->CompilerBotch, 4);
993 return;
994 }
995 }
996#endif
997 pt = base;
998 /* initialize vector */
999 for (i = 0; i < max; i++) {
1000 *pt = i;
1001 pt += 2;
1002 }
1003#define M_EVEN 0
1004 msort(grp->FirstClause, base, max, M_EVEN);
1005 copy_back(grp->FirstClause, base, max);
1006#if USE_SYSTEM_MALLOC
1007 Yap_FreeCodeSpace((ADDR)base);
1008#endif
1009}
1010
1011/* add copy to register stack for original reg */
1012static int init_regcopy(wamreg regs[MAX_REG_COPIES], wamreg copy) {
1013 regs[0] = copy;
1014 return 1;
1015}
1016
1017/* add copy to register stack for original reg */
1018static int is_regcopy(wamreg regs[MAX_REG_COPIES], int regs_count,
1019 wamreg copy) {
1020 int i = 0;
1021 while (i < regs_count) {
1022 if (regs[i] == copy) {
1023 return TRUE;
1024 }
1025 i++;
1026 }
1027 /* this copy had overflowed, or it just was not there */
1028 return FALSE;
1029}
1030
1031/* add copy to register stack for original reg */
1032static int delete_regcopy(wamreg regs[MAX_REG_COPIES], int regs_count,
1033 wamreg copy) {
1034 int i = 0;
1035 while (i < regs_count) {
1036 if (regs[i] == copy) {
1037 /* we found it */
1038 regs[i] = regs[regs_count - 1];
1039 return regs_count - 1;
1040 }
1041 i++;
1042 }
1043 /* this copy had overflowed, or it just was not there */
1044 return regs_count;
1045}
1046
1047/* add copy to register stack for original reg */
1048static int add_regcopy(wamreg regs[MAX_REG_COPIES], int regs_count, Int source,
1049 Int copy) {
1050 int i = 0;
1051 while (i < regs_count) {
1052 if (regs[i] == source) {
1053 /* we found it, add new element as last element */
1054 if (regs_count == MAX_REG_COPIES) {
1055 return regs_count;
1056 }
1057 regs[regs_count] = copy;
1058 return regs_count + 1;
1059 }
1060 i++;
1061 }
1062 /* be careful: we may overwrite an existing copy */
1063 return delete_regcopy(regs, regs_count, copy);
1064}
1065
1066/* add copy to register stack for original reg */
1067inline static int link_regcopies(wamreg regs[MAX_REG_COPIES], int regs_count,
1068 Int c1, Int c2) {
1069 int i;
1070 for (i = 0; i < regs_count; i++) {
1071 if (regs[i] == c1) {
1072 return add_regcopy(regs, regs_count, c1, c2);
1073 }
1074 if (regs[i] == c2) {
1075 return add_regcopy(regs, regs_count, c2, c1);
1076 }
1077 }
1078 /* this copy could not be found */
1079 regs_count = delete_regcopy(regs, regs_count, c1);
1080 return delete_regcopy(regs, regs_count, c2);
1081}
1082
1083static void add_info(ClauseDef *clause, UInt regno) {
1084 wamreg myregs[MAX_REG_COPIES];
1085 int nofregs;
1086 yamop *cl;
1087
1088 nofregs = init_regcopy(myregs, Yap_regnotoreg(regno));
1089 cl = clause->CurrentCode;
1090#include "findclause.h"
1091}
1092
1093static void add_head_info(ClauseDef *clause, UInt regno) {
1094 wamreg iarg = Yap_regnotoreg(regno);
1095
1096 yamop *cl = clause->CurrentCode;
1097#include "headclause.h"
1098}
1099
1100static void move_next(ClauseDef *clause, UInt regno) {
1101 yamop *cl = clause->CurrentCode;
1102 wamreg wreg = Yap_regnotoreg(regno);
1103 op_numbers op = Yap_op_from_opcode(cl->opc);
1104
1105 switch (op) {
1106#if YAP_JIT
1107 case _jit_handler:
1108 return;
1109#endif
1110#if THREADS
1111 case _unlock_lu:
1112 clause->CurrentCode = NEXTOP(cl, e);
1113 return;
1114#endif
1115 case _p_db_ref_x:
1116 case _p_float_x:
1117 if (wreg == cl->y_u.xl.x) {
1118 clause->CurrentCode = NEXTOP(cl, xl);
1119 }
1120 return;
1121 case _get_list:
1122 if (wreg == cl->y_u.x.x) {
1123 clause->CurrentCode = NEXTOP(cl, x);
1124 }
1125 return;
1126 case _glist_valx:
1127 case _gl_void_vary:
1128 case _gl_void_valy:
1129 case _gl_void_varx:
1130 case _gl_void_valx:
1131 case _glist_valy:
1132 return;
1133 case _get_atom:
1134 if (wreg == cl->y_u.xc.x) {
1135 clause->CurrentCode = NEXTOP(cl, xc);
1136 }
1137 return;
1138 case _get_2atoms:
1139 return;
1140 case _get_3atoms:
1141 return;
1142 case _get_4atoms:
1143 return;
1144 case _get_5atoms:
1145 return;
1146 case _get_6atoms:
1147 return;
1148 /*
1149 matching is not guaranteed:
1150 case _get_float:
1151 case _get_longint:
1152 case _get_bigint:
1153 */
1154 case _get_struct:
1155 if (wreg == cl->y_u.xfa.x) {
1156 clause->CurrentCode = NEXTOP(cl, xfa);
1157 }
1158 default:
1159 clause->CurrentCode = clause->Code;
1160 return;
1161 }
1162}
1163
1164static void add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno) {
1165 yamop *cl;
1166 if (ap->ModuleOfPred == IDB_MODULE) {
1167 cl = clause->Code;
1168 } else {
1169 cl = clause->ucd.WorkPC;
1170 }
1171 while (TRUE) {
1172 op_numbers op = Yap_op_from_opcode(cl->opc);
1173 switch (op) {
1174 case _glist_valx:
1175 if (argno == 1) {
1176 clause->Tag = (CELL)NULL;
1177 return;
1178 }
1179 argno--;
1180 cl = NEXTOP(cl, xx);
1181 break;
1182 case _gl_void_vary:
1183 case _gl_void_valy:
1184 case _gl_void_varx:
1185 case _gl_void_valx:
1186 clause->Tag = (CELL)NULL;
1187 return;
1188 case _glist_valy:
1189 if (argno == 1) {
1190 clause->Tag = (CELL)NULL;
1191 return;
1192 }
1193 argno = 2;
1194 cl = NEXTOP(cl, yx);
1195 break;
1196 case _unify_l_x_var:
1197 case _unify_l_x_val:
1198 case _unify_l_x_loc:
1199 case _unify_x_var:
1200 case _unify_x_val:
1201 case _unify_x_loc:
1202 if (argno == 1) {
1203 clause->Tag = (CELL)NULL;
1204 return;
1205 }
1206 argno--;
1207 case _unify_l_x_var_write:
1208 case _unify_l_x_val_write:
1209 case _unify_l_x_loc_write:
1210 case _unify_x_var_write:
1211 case _unify_x_val_write:
1212 case _unify_x_loc_write:
1213 cl = NEXTOP(cl, ox);
1214 break;
1215 case _save_pair_x_write:
1216 case _save_pair_x:
1217 case _save_appl_x_write:
1218 case _save_appl_x:
1219 cl = NEXTOP(cl, ox);
1220 break;
1221 case _unify_l_x_var2:
1222 case _unify_x_var2:
1223 if (argno == 1 || argno == 2) {
1224 clause->Tag = (CELL)NULL;
1225 return;
1226 }
1227 argno -= 2;
1228 case _unify_l_x_var2_write:
1229 case _unify_x_var2_write:
1230 cl = NEXTOP(cl, oxx);
1231 break;
1232 case _unify_y_var:
1233 case _unify_y_val:
1234 case _unify_y_loc:
1235 case _unify_l_y_var:
1236 case _unify_l_y_val:
1237 case _unify_l_y_loc:
1238 /* we're just done with the head of a list, but there
1239 is nothing inside.
1240 */
1241 if (argno == 1) {
1242 clause->Tag = (CELL)NULL;
1243 return;
1244 }
1245 argno--;
1246 case _unify_y_var_write:
1247 case _unify_y_val_write:
1248 case _unify_y_loc_write:
1249 case _unify_l_y_var_write:
1250 case _unify_l_y_val_write:
1251 case _unify_l_y_loc_write:
1252 cl = NEXTOP(cl, oy);
1253 break;
1254 case _save_pair_y_write:
1255 case _save_pair_y:
1256 case _save_appl_y_write:
1257 case _save_appl_y:
1258 cl = NEXTOP(cl, oy);
1259 break;
1260 case _unify_l_void:
1261 case _unify_void:
1262 if (argno == 1) {
1263 clause->Tag = (CELL)NULL;
1264 return;
1265 }
1266 argno--;
1267 case _unify_l_void_write:
1268 case _unify_void_write:
1269 cl = NEXTOP(cl, o);
1270 break;
1271 case _unify_list:
1272 case _unify_l_list:
1273 if (argno == 1) {
1274 clause->Tag = AbsPair(NULL);
1275 clause->ucd.WorkPC = NEXTOP(cl, o);
1276 return;
1277 }
1278 argno += 1; /* 2-1: have two extra arguments to skip */
1279 case _unify_list_write:
1280 case _unify_l_list_write:
1281 cl = NEXTOP(cl, o);
1282 break;
1283 case _unify_n_voids:
1284 case _unify_l_n_voids:
1285 if (argno <= cl->y_u.os.s) {
1286 clause->Tag = (CELL)NULL;
1287 return;
1288 }
1289 argno -= cl->y_u.os.s;
1290 case _unify_n_voids_write:
1291 case _unify_l_n_voids_write:
1292 cl = NEXTOP(cl, os);
1293 break;
1294 case _unify_atom:
1295 case _unify_l_atom:
1296 if (argno == 1) {
1297 clause->Tag = cl->y_u.oc.c;
1298 return;
1299 }
1300 argno--;
1301 case _unify_atom_write:
1302 case _unify_l_atom_write:
1303 cl = NEXTOP(cl, oc);
1304 break;
1305 case _unify_float_write:
1306 case _unify_l_float_write:
1307 cl = NEXTOP(cl, od);
1308 break;
1309 case _unify_float:
1310 case _unify_l_float:
1311 if (argno == 1) {
1312 clause->Tag = AbsAppl((CELL *)FunctorDouble);
1313 clause->ucd.t_ptr = AbsAppl(cl->y_u.od.d);
1314 return;
1315 }
1316 cl = NEXTOP(cl, od);
1317 argno--;
1318 break;
1319 case _unify_longint:
1320 case _unify_l_longint:
1321 if (argno == 1) {
1322 clause->Tag = AbsAppl((CELL *)FunctorLongInt);
1323 clause->ucd.t_ptr = AbsAppl(cl->y_u.oi.i);
1324 return;
1325 }
1326 argno--;
1327 cl = NEXTOP(cl, oi);
1328 break;
1329 case _unify_bigint:
1330 case _unify_l_bigint:
1331 if (argno == 1) {
1332 clause->Tag = AbsAppl((CELL *)FunctorBigInt);
1333 clause->ucd.t_ptr = cl->y_u.oc.c;
1334 return;
1335 }
1336 cl = NEXTOP(cl, oc);
1337 argno--;
1338 break;
1339 case _unify_string:
1340 case _unify_l_string:
1341 if (argno == 1) {
1342 clause->Tag = AbsAppl((CELL *)FunctorString);
1343 clause->ucd.t_ptr = cl->y_u.ou.ut;
1344 return;
1345 }
1346 cl = NEXTOP(cl, ou);
1347 argno--;
1348 break;
1349 case _unify_n_atoms:
1350 if (argno <= cl->y_u.osc.s) {
1351 clause->Tag = cl->y_u.osc.c;
1352 return;
1353 }
1354 argno -= cl->y_u.osc.s;
1355 case _unify_n_atoms_write:
1356 cl = NEXTOP(cl, osc);
1357 break;
1358 case _unify_struct:
1359 case _unify_l_struc:
1360 if (argno == 1) {
1361 clause->Tag = AbsAppl((CELL *)cl->y_u.ofa.f);
1362 clause->ucd.WorkPC = NEXTOP(cl, ofa);
1363 return;
1364 }
1365 /* must skip next n arguments */
1366 argno += cl->y_u.ofa.a - 1;
1367 case _unify_l_struc_write:
1368 case _unify_struct_write:
1369 cl = NEXTOP(cl, ofa);
1370 break;
1371 case _pop:
1372 cl = NEXTOP(cl, e);
1373 break;
1374 case _pop_n:
1375 cl = NEXTOP(cl, s);
1376 break;
1377#ifdef BEAM
1378 case _run_eam:
1379 cl = NEXTOP(cl, os);
1380 break;
1381#endif
1382#ifdef THREADS
1383 case _unlock_lu:
1384 cl = NEXTOP(cl, e);
1385 break;
1386#endif
1387 case _get_dbterm:
1388 cl = NEXTOP(cl, xc);
1389 break;
1390 case _unify_dbterm:
1391 case _unify_l_dbterm:
1392 cl = NEXTOP(cl, oc);
1393 break;
1394 case _unify_idb_term:
1395 case _copy_idb_term: {
1396 Term t = clause->ucd.c_sreg[argno];
1397
1398 if (IsVarTerm(t)) {
1399 clause->Tag = (CELL)NULL;
1400 } else if (IsApplTerm(t)) {
1401 CELL *pt = RepAppl(t);
1402
1403 clause->Tag = AbsAppl((CELL *)pt[0]);
1404 if (IsExtensionFunctor(FunctorOfTerm(t))) {
1405 clause->ucd.t_ptr = t;
1406 } else {
1407 clause->ucd.c_sreg = pt;
1408 }
1409 } else if (IsPairTerm(t)) {
1410 CELL *pt = RepPair(t);
1411
1412 clause->Tag = AbsPair(NULL);
1413 clause->ucd.c_sreg = pt - 1;
1414 } else {
1415 clause->Tag = t;
1416 }
1417 }
1418 return;
1419 default:
1420 return;
1421 }
1422 }
1423}
1424
1425static void skip_to_arg(ClauseDef *clause, PredEntry *ap, UInt argno,
1426 int at_point) {
1427 yamop *cl;
1428 int done = FALSE;
1429 if (ap->ModuleOfPred == IDB_MODULE) {
1430 return;
1431 } else {
1432 cl = clause->CurrentCode;
1433 }
1434
1435 if (!at_point) {
1436 clause->CurrentCode = clause->Code;
1437 return;
1438 }
1439
1440 while (!done) {
1441 op_numbers op = Yap_op_from_opcode(cl->opc);
1442 switch (op) {
1443#ifdef BEAM
1444 case _run_eam:
1445 clause->CurrentCode = clause->Code;
1446 return;
1447#endif
1448 case _unify_void:
1449 if (argno == 1) {
1450 clause->CurrentCode = clause->Code;
1451 return;
1452 } else {
1453 argno--;
1454 }
1455 case _unify_void_write:
1456 cl = NEXTOP(cl, o);
1457 break;
1458 case _unify_list:
1459 case _unify_l_list:
1460 case _unify_atom:
1461 case _unify_l_atom:
1462 /*
1463 unification is not guaranteed
1464 case _unify_longint:
1465 case _unify_l_longint:
1466 case _unify_bigint:
1467 case _unify_l_bigint:
1468 case _unify_l_float:
1469 */
1470 case _unify_struct:
1471 case _unify_l_struc:
1472 if (cl == clause->ucd.WorkPC) {
1473 clause->CurrentCode = cl;
1474 } else {
1475 clause->CurrentCode = clause->Code;
1476 }
1477 return;
1478 case _unify_list_write:
1479 case _unify_l_list_write:
1480 cl = NEXTOP(cl, o);
1481 break;
1482 case _unify_n_voids:
1483 case _unify_l_n_voids:
1484 if (argno <= cl->y_u.os.s) {
1485 clause->CurrentCode = clause->Code;
1486 return;
1487 } else {
1488 argno -= cl->y_u.os.s;
1489 }
1490 case _unify_n_voids_write:
1491 case _unify_l_n_voids_write:
1492 cl = NEXTOP(cl, os);
1493 break;
1494 case _unify_atom_write:
1495 case _unify_l_atom_write:
1496 cl = NEXTOP(cl, oc);
1497 break;
1498 case _unify_float_write:
1499 case _unify_l_float_write:
1500 cl = NEXTOP(cl, od);
1501 break;
1502 case _unify_l_struc_write:
1503 case _unify_struct_write:
1504 cl = NEXTOP(cl, ofa);
1505 break;
1506#ifdef THREADS
1507 case _unlock_lu:
1508#endif
1509 case _pop:
1510 cl = NEXTOP(cl, e);
1511 break;
1512 case _pop_n:
1513 cl = NEXTOP(cl, s);
1514 break;
1515 default:
1516 clause->CurrentCode = clause->Code;
1517 return;
1518 }
1519 }
1520}
1521
1522static UInt groups_in(ClauseDef *min, ClauseDef *max, GroupDef *grp,
1523 struct intermediates *cint) {
1524 CACHE_REGS
1525 UInt groups = 0;
1526
1527 while (min <= max) {
1528 grp->FirstClause = min;
1529 grp->AtomClauses = 0;
1530 grp->PairClauses = 0;
1531 grp->StructClauses = 0;
1532 grp->TestClauses = 0;
1533 if (min->Tag == (_var + 1) * sizeof(CELL)) {
1534 min++;
1535 continue;
1536 }
1537 /* only do this for the first clauses in a group */
1538 if (IsVarTerm(min->Tag)) {
1539 ClauseDef *clp = min + 1;
1540
1541 grp->VarClauses = 1;
1542 do {
1543 if (clp > max || !IsVarTerm(clp->Tag)) {
1544 grp->LastClause = (min = clp) - 1;
1545 break;
1546 }
1547 if (clp->Tag != (_var + 1) * sizeof(CELL))
1548 grp->VarClauses++;
1549 clp++;
1550 } while (TRUE);
1551 } else {
1552 grp->VarClauses = 0;
1553 do {
1554 restart_loop:
1555 if (IsAtomTerm(min->Tag) || IsIntTerm(min->Tag)) {
1556 grp->AtomClauses++;
1557 } else if (IsPairTerm(min->Tag)) {
1558 grp->PairClauses++;
1559 } else if (IsApplTerm(min->Tag)) {
1560 grp->StructClauses++;
1561 } else {
1562 grp->TestClauses++;
1563 }
1564 min++;
1565 } while (min <= max && (!IsVarTerm(min->Tag)));
1566 if (min <= max && min->Tag == (_var + 1) * sizeof(CELL)) {
1567 min++;
1568 if (min < max)
1569 goto restart_loop;
1570 }
1571 grp->LastClause = min - 1;
1572 }
1573 groups++;
1574 grp++;
1575 while (grp + 16 > (GroupDef *)LOCAL_TrailTop) {
1576 UInt sz = (groups + 16) * sizeof(GroupDef);
1577#if USE_SYSTEM_MALLOC
1578 LOCAL_Error_Size = sz;
1579 /* grow stack */
1580 save_machine_regs();
1581 siglongjmp(cint->CompilerBotch, 4);
1582#else
1583 if (!Yap_growtrail(sz, TRUE)) {
1584 LOCAL_Error_Size = sz;
1585 save_machine_regs();
1586 siglongjmp(cint->CompilerBotch, 4);
1587 return 0;
1588 }
1589#endif
1590 }
1591 }
1592 return groups;
1593}
1594
1595static UInt new_label(struct intermediates *cint) {
1596 UInt lbl = cint->i_labelno;
1597 cint->i_labelno += 2;
1598 return lbl;
1599}
1600
1601static Int has_cut(yamop *pc, PredEntry *ap) {
1602 if (ap->PredFlags & LogUpdatePredFlag) {
1603 LogUpdClause *lcl = ClauseCodeToLogUpdClause(pc);
1604 return ((lcl->ClFlags & HasCutMask) != 0);
1605 } else if (ap->PredFlags & MegaClausePredFlag) {
1606 /* must be a fact */
1607 return FALSE;
1608 } else {
1609 StaticClause *scl;
1610
1611 scl = ClauseCodeToStaticClause(pc);
1612 return ((scl->ClFlags & HasCutMask) != 0);
1613 }
1614}
1615
1616static void emit_trust(ClauseDef *cl, struct intermediates *cint, UInt nxtlbl,
1617 int clauses) {
1618 PredEntry *ap = cint->CurrentPred;
1619 yamop *clcode = cl->Code;
1620
1621 if (ap->PredFlags & TabledPredFlag)
1622 clcode = NEXTOP(clcode, Otapl);
1623 if (!(ap->PredFlags & LogUpdatePredFlag)) {
1624 /* this should not be generated for logical update predicates!! */
1625 if (ap->PredFlags & ProfiledPredFlag) {
1626 Yap_emit(retry_profiled_op, Unsigned(ap), Zero, cint);
1627 }
1628 if (ap->PredFlags & CountPredFlag) {
1629 Yap_emit(count_retry_op, Unsigned(ap), Zero, cint);
1630 }
1631 }
1632 if (clauses == 0) {
1633 Yap_emit(trust_op, (CELL)clcode, has_cut(cl->Code, ap), cint);
1634 } else {
1635 Yap_emit(retry_op, (CELL)clcode, (clauses << 1) | has_cut(cl->Code, ap),
1636 cint);
1637 Yap_emit(jumpi_op, nxtlbl, Zero, cint);
1638 }
1639}
1640
1641static void emit_retry(ClauseDef *cl, struct intermediates *cint, int clauses) {
1642 PredEntry *ap = cint->CurrentPred;
1643 yamop *clcode = cl->Code;
1644
1645 if (ap->PredFlags & TabledPredFlag)
1646 clcode = NEXTOP(clcode, Otapl);
1647 if (!(ap->PredFlags & LogUpdatePredFlag)) {
1648 /* this should not be generated for logical update predicates!! */
1649 if (ap->PredFlags & ProfiledPredFlag) {
1650 Yap_emit(retry_profiled_op, Unsigned(ap), Zero, cint);
1651 }
1652 if (ap->PredFlags & CountPredFlag) {
1653 Yap_emit(count_retry_op, Unsigned(ap), Zero, cint);
1654 }
1655 }
1656 Yap_emit(retry_op, (CELL)clcode, (clauses << 1) | has_cut(cl->Code, ap),
1657 cint);
1658}
1659
1660static compiler_vm_op emit_optry(int var_group, int first, int clauses,
1661 int clleft, PredEntry *ap) {
1662 /* var group */
1663 if (var_group || clauses == 0) {
1664 if (first) {
1665 return try_op;
1666 } else if (clleft + clauses) {
1667 return retry_op;
1668 } else {
1669 return trust_op;
1670 }
1671 } else if (clleft == 0) {
1672#ifdef TABLING
1673 if (ap->PredFlags & TabledPredFlag && !first) {
1674 /* we never actually get to remove the last choice-point in this case */
1675 return retry_op;
1676 } else
1677#endif /* TABLING */
1678 {
1679 /* last group */
1680 return try_op;
1681 }
1682 } else {
1683 /* nonvar group */
1684 return try_in_op;
1685 }
1686}
1687
1688static void emit_try(ClauseDef *cl, struct intermediates *cint, int var_group,
1689 int first, int clauses, int clleft, UInt nxtlbl) {
1690 PredEntry *ap = cint->CurrentPred;
1691 yamop *clcode;
1692 compiler_vm_op comp_op;
1693
1694 if (ap->PredFlags & LogUpdatePredFlag) {
1695 clcode = cl->Code;
1696 } else if (ap->PredFlags & TabledPredFlag) {
1697 clcode = NEXTOP(cl->Code, Otapl);
1698 } else {
1699 clcode = cl->CurrentCode;
1700 }
1701
1702 comp_op = emit_optry(var_group, first, clauses, clleft, cint->CurrentPred);
1703 Yap_emit(comp_op, (CELL)clcode,
1704 ((clauses + clleft) << 1) | has_cut(cl->Code, ap), cint);
1705}
1706
1707static TypeSwitch *emit_type_switch(compiler_vm_op op,
1708 struct intermediates *cint) {
1709 return (TypeSwitch *)Yap_emit_extra_size(op, 0, sizeof(TypeSwitch), cint);
1710}
1711
1712static yamop *emit_switch_space(UInt n, UInt item_size,
1713 struct intermediates *cint, CELL func_mask) {
1714 CACHE_REGS
1715 PredEntry *ap = cint->CurrentPred;
1716
1717 if (ap->PredFlags & LogUpdatePredFlag) {
1718 UInt sz = sizeof(LogUpdIndex) + n * item_size;
1719 LogUpdIndex *cl = (LogUpdIndex *)Yap_AllocCodeSpace(sz);
1720 if (cl == NULL) {
1721 LOCAL_Error_Size = sz;
1722 /* grow stack */
1723 save_machine_regs();
1724 siglongjmp(cint->CompilerBotch, 2);
1725 }
1726 Yap_LUIndexSpace_SW += sz;
1727 cl->ClFlags = SwitchTableMask | LogUpdMask | func_mask;
1728 cl->ClSize = sz;
1729 cl->ClPred = cint->CurrentPred;
1730 /* insert into code chain */
1731 Yap_inform_profiler_of_clause(cl, (CODEADDR)cl + sz, ap,
1732 GPROF_NEW_LU_SWITCH);
1733 return cl->ClCode;
1734 } else {
1735 UInt sz = sizeof(StaticIndex) + n * item_size;
1736 StaticIndex *cl = (StaticIndex *)Yap_AllocCodeSpace(sz);
1737 if (cl == NULL) {
1738 LOCAL_Error_Size = sz;
1739 /* grow stack */
1740 save_machine_regs();
1741 siglongjmp(cint->CompilerBotch, 2);
1742 }
1743 Yap_IndexSpace_SW += sz;
1744 cl->ClFlags = SwitchTableMask;
1745 cl->ClSize = sz;
1746 cl->ClPred = cint->CurrentPred;
1747 Yap_inform_profiler_of_clause(cl, (CODEADDR)cl + sz, ap,
1748 GPROF_NEW_STATIC_SWITCH);
1749 return cl->ClCode;
1750 /* insert into code chain */
1751 }
1752}
1753
1754static AtomSwiEntry *emit_cswitch(COUNT n, yamop *fail_l,
1755 struct intermediates *cint) {
1756 compiler_vm_op op;
1757 AtomSwiEntry *target;
1758
1759 if (n > MIN_HASH_ENTRIES) {
1760 COUNT cases = MIN_HASH_ENTRIES, i;
1761 n += 1 + n / 4;
1762 while (cases < n)
1763 cases *= 2;
1764 n = cases;
1765 op = switch_c_op;
1766 target =
1767 (AtomSwiEntry *)emit_switch_space(n, sizeof(AtomSwiEntry), cint, 0);
1768 for (i = 0; i < n; i++) {
1769 target[i].Tag = Zero;
1770 target[i].u_a.labp = fail_l;
1771 }
1772 Yap_emit(op, Unsigned(n), (CELL)target, cint);
1773 } else {
1774 UInt i;
1775
1776 op = if_c_op;
1777 target =
1778 (AtomSwiEntry *)emit_switch_space(n + 1, sizeof(AtomSwiEntry), cint, 0);
1779
1780 for (i = 0; i < n; i++) {
1781 target[i].u_a.labp = fail_l;
1782 }
1783 target[n].Tag = Zero;
1784 target[n].u_a.labp = fail_l;
1785 Yap_emit(op, Unsigned(n), (CELL)target, cint);
1786 }
1787 return target;
1788}
1789
1790static AtomSwiEntry *lookup_c_hash(Term t, yamop *tab, COUNT entries) {
1791 AtomSwiEntry *cebase = (AtomSwiEntry *)tab;
1792 int hash, d;
1793 AtomSwiEntry *centry;
1794
1795 hash = (t >> HASH_SHIFT) & (entries - 1);
1796 centry = cebase + hash;
1797 d = (entries - 1) & (t | 1);
1798 while (centry->Tag != t) {
1799 if (centry->Tag == 0L)
1800 return centry;
1801 hash = (hash + d) & (entries - 1);
1802 centry = cebase + hash;
1803 }
1804 return centry;
1805}
1806
1807static AtomSwiEntry *fetch_centry(AtomSwiEntry *cebase, Term wt, int i, int n) {
1808 if (n > MIN_HASH_ENTRIES) {
1809 int cases = MIN_HASH_ENTRIES;
1810
1811 n += 1 + n / 4;
1812 while (cases < n)
1813 cases *= 2;
1814 return lookup_c_hash(wt, (yamop *)cebase, cases);
1815 } else {
1816 return cebase + i;
1817 }
1818}
1819
1820static FuncSwiEntry *emit_fswitch(COUNT n, yamop *fail_l,
1821 struct intermediates *cint) {
1822 compiler_vm_op op;
1823 FuncSwiEntry *target;
1824
1825 if (n > MIN_HASH_ENTRIES) {
1826 int cases = MIN_HASH_ENTRIES, i;
1827 n += 1 + n / 4;
1828 while (cases < n)
1829 cases *= 2;
1830 n = cases;
1831 op = switch_f_op;
1832 target = (FuncSwiEntry *)emit_switch_space(n, sizeof(FuncSwiEntry), cint,
1833 FuncSwitchMask);
1834 for (i = 0; i < n; i++) {
1835 target[i].Tag = NULL;
1836 target[i].u_f.labp = fail_l;
1837 }
1838 Yap_emit(op, Unsigned(n), (CELL)target, cint);
1839 } else {
1840 UInt i;
1841
1842 op = if_f_op;
1843 target = (FuncSwiEntry *)emit_switch_space(n + 1, sizeof(FuncSwiEntry),
1844 cint, FuncSwitchMask);
1845 for (i = 0; i < n; i++) {
1846 target[i].u_f.labp = fail_l;
1847 }
1848 target[n].Tag = NULL;
1849 target[n].u_f.labp = fail_l;
1850 Yap_emit(op, Unsigned(n), (CELL)target, cint);
1851 }
1852 return target;
1853}
1854
1855static FuncSwiEntry *lookup_f_hash(Functor f, yamop *tab, COUNT entries) {
1856 FuncSwiEntry *febase = (FuncSwiEntry *)tab;
1857 int hash, d;
1858 FuncSwiEntry *fentry;
1859 Term wt = (Term)f;
1860
1861 hash = (wt >> HASH_SHIFT) & (entries - 1);
1862 fentry = febase + hash;
1863 d = (entries - 1) & (wt | 1);
1864 while (fentry->Tag != f) {
1865 if (fentry->Tag == NULL)
1866 return fentry;
1867 hash = (hash + d) & (entries - 1);
1868 fentry = febase + hash;
1869 }
1870 return fentry;
1871}
1872
1873static FuncSwiEntry *fetch_fentry(FuncSwiEntry *febase, Functor ft, int i,
1874 int n) {
1875 if (n > MIN_HASH_ENTRIES) {
1876 int cases = MIN_HASH_ENTRIES;
1877
1878 n += 1 + n / 4;
1879 while (cases < n)
1880 cases *= 2;
1881 return lookup_f_hash(ft, (yamop *)febase, cases);
1882 } else {
1883 return febase + i;
1884 }
1885}
1886
1887/* we assume there is at least one clause, that is, c0 < cf */
1888static UInt do_var_clauses(ClauseDef *c0, ClauseDef *cf, int var_group,
1889 struct intermediates *cint, int first, int clleft,
1890 UInt nxtlbl, UInt argno0) {
1891 UInt labl;
1892 UInt labl_dyn0 = 0, labl_dynf = 0;
1893
1894 labl = new_label(cint);
1895 Yap_emit(label_op, labl, Zero, cint);
1896 /*
1897 add expand_node if var_group == TRUE (jump on var) ||
1898 var_group == FALSE (leaf node)
1899 */
1900 if (first && cint->CurrentPred->PredFlags & LogUpdatePredFlag) {
1901 UInt ncls;
1902 labl_dyn0 = new_label(cint);
1903 if (clleft)
1904 labl_dynf = labl_dyn0;
1905 else
1906 labl_dynf = new_label(cint);
1907 if (clleft == 0) /* trust*/
1908 ncls = (cf - c0) + 1;
1909 else
1910 ncls = 0;
1911 Yap_emit_4ops(enter_lu_op, labl_dyn0, labl_dynf, ncls, Zero, cint);
1912 Yap_emit(label_op, labl_dyn0, Zero, cint);
1913 }
1914 if (c0 == cf) {
1915 emit_try(c0, cint, var_group, first, 0, clleft, nxtlbl);
1916 } else {
1917
1918 if (c0 < cf) {
1919 emit_try(c0, cint, var_group, first, cf - c0, clleft, nxtlbl);
1920 }
1921 c0++;
1922 while (c0 < cf) {
1923 emit_retry(c0, cint, clleft + (cf - c0));
1924 c0++;
1925 }
1926 if (c0 == cf) {
1927 emit_trust(c0, cint, nxtlbl, clleft);
1928 if (!clleft && cint->CurrentPred->PredFlags & LogUpdatePredFlag) {
1929 Yap_emit(label_op, labl_dynf, Zero, cint);
1930 }
1931 }
1932 }
1933 return labl;
1934}
1935
1936static UInt do_var_group(GroupDef *grp, struct intermediates *cint,
1937 int var_group, int first, int clleft, UInt nxtlbl,
1938 UInt argno0) {
1939 return do_var_clauses(grp->FirstClause, grp->LastClause, var_group, cint,
1940 first, clleft, nxtlbl, argno0);
1941}
1942
1943/* count the number of different constants */
1944static UInt count_consts(GroupDef *grp) {
1945 Term current = MkAtomTerm(AtomFoundVar);
1946 UInt i = 0;
1947 ClauseDef *cl = grp->FirstClause;
1948
1949 while (IsAtomTerm(cl->Tag) || IsIntTerm(cl->Tag)) {
1950 if (current != cl->Tag) {
1951 i++;
1952 current = cl->Tag;
1953 }
1954 if (cl == grp->LastClause) {
1955 return i;
1956 }
1957 cl++;
1958 }
1959 return i;
1960}
1961
1962static UInt count_blobs(GroupDef *grp) {
1963 UInt i = 1;
1964 ClauseDef *cl = grp->FirstClause + 1;
1965 Term current = grp->FirstClause->Tag;
1966
1967 while (cl <= grp->LastClause) {
1968 if (current != cl->Tag) {
1969 i++;
1970 current = cl->Tag;
1971 }
1972 cl++;
1973 }
1974 return i;
1975}
1976
1977/* count the number of different constants */
1978static UInt count_funcs(GroupDef *grp) {
1979 Term current = MkAtomTerm(AtomFoundVar);
1980 UInt i = 0;
1981 ClauseDef *cl = grp->FirstClause;
1982
1983 while (IsApplTerm(cl->Tag)) {
1984 if (current != cl->Tag) {
1985 i++;
1986 current = cl->Tag;
1987 }
1988 if (cl == grp->LastClause) {
1989 return i;
1990 }
1991 cl++;
1992 }
1993 return i;
1994}
1995
1996static UInt emit_single_switch_case(ClauseDef *min, struct intermediates *cint,
1997 int first, int clleft, UInt nxtlbl) {
1998 if (cint->CurrentPred->PredFlags & TabledPredFlag) {
1999 /* with tabling we don't clean trust at the very end of computation.
2000 */
2001 if (clleft || !first) {
2002 /*
2003 if we still have clauses left, means we already created a CP,
2004 so I should avoid creating again
2005 */
2006 return (UInt)NEXTOP(min->Code, Otapl);
2007 } else {
2008 return (UInt)min->Code;
2009 }
2010 }
2011 if (cint->CurrentPred->PredFlags & LogUpdatePredFlag) {
2012 return (UInt)(min->Code);
2013 } else {
2014 return (UInt)(min->CurrentCode);
2015 }
2016}
2017
2018static UInt suspend_indexing(ClauseDef *min, ClauseDef *max, PredEntry *ap,
2019 struct intermediates *cint) {
2020 UInt tcls = ap->cs.p_code.NOfClauses;
2021 UInt cls = (max - min) + 1;
2022
2023 if (cint->expand_block &&
2024 cint->expand_block != (yamop *)(&(ap->cs.p_code.ExpandCode)) &&
2025 cint->expand_block->y_u.sssllp.s2 < 2 * (max - min)) {
2026 cint->expand_block->y_u.sssllp.s3++;
2027 return (UInt)(cint->expand_block);
2028 }
2029 if (cls < tcls / 8) {
2030 yamop *ncode;
2031 yamop **st;
2032 UInt tels;
2033 UInt sz;
2034
2035 if (ap->PredFlags & LogUpdatePredFlag) {
2036 /* give it some slack */
2037 tels = cls + 4;
2038 } else {
2039 tels = cls;
2040 }
2041 sz = (UInt)NEXTOP((yamop *)NULL, sssllp) + tels * sizeof(yamop *);
2042 if ((ncode = (yamop *)Yap_AllocCodeSpace(sz)) == NULL) {
2043 save_machine_regs();
2044 siglongjmp(cint->CompilerBotch, 2);
2045 }
2046#if DEBUG
2047 Yap_ExpandClauses++;
2048 Yap_expand_clauses_sz += sz;
2049#endif
2050 if (ap->PredFlags & LogUpdatePredFlag) {
2051 Yap_LUIndexSpace_EXT += sz;
2052 } else {
2053 Yap_IndexSpace_EXT += sz;
2054 }
2055 Yap_inform_profiler_of_clause(ncode, (CODEADDR)ncode + sz, ap,
2056 GPROF_NEW_EXPAND_BLOCK);
2057 /* create an expand_block */
2058 ncode->opc = Yap_opcode(_expand_clauses);
2059 ncode->y_u.sssllp.p = ap;
2060 ncode->y_u.sssllp.s1 = tels;
2061 ncode->y_u.sssllp.s2 = cls;
2062 ncode->y_u.sssllp.s3 = 1;
2063 st = (yamop **)NEXTOP(ncode, sssllp);
2064 while (min <= max) {
2065 *st++ = min->Code;
2066 min++;
2067 }
2068 while (cls < tels) {
2069 *st++ = NULL;
2070 cls++;
2071 }
2072 LOCK(ExpandClausesListLock);
2073 ncode->y_u.sssllp.snext = ExpandClausesFirst;
2074 ncode->y_u.sssllp.sprev = NULL;
2075 if (ExpandClausesFirst)
2076 ExpandClausesFirst->y_u.sssllp.sprev = ncode;
2077 ExpandClausesFirst = ncode;
2078 if (ExpandClausesLast == NULL)
2079 ExpandClausesLast = ncode;
2080 UNLOCK(ExpandClausesListLock);
2081 return (UInt)ncode;
2082 }
2083 return (UInt) & (ap->cs.p_code.ExpandCode);
2084}
2085
2086static void recover_ecls_block(yamop *ipc) {
2087 ipc->y_u.sssllp.s3--;
2088 if (!ipc->y_u.sssllp.s3) {
2089 LOCK(ExpandClausesListLock);
2090 if (ExpandClausesFirst == ipc)
2091 ExpandClausesFirst = ipc->y_u.sssllp.snext;
2092 if (ExpandClausesLast == ipc) {
2093 ExpandClausesLast = ipc->y_u.sssllp.sprev;
2094 }
2095 if (ipc->y_u.sssllp.sprev) {
2096 ipc->y_u.sssllp.sprev->y_u.sssllp.snext = ipc->y_u.sssllp.snext;
2097 }
2098 if (ipc->y_u.sssllp.snext) {
2099 ipc->y_u.sssllp.snext->y_u.sssllp.sprev = ipc->y_u.sssllp.sprev;
2100 }
2101 UNLOCK(ExpandClausesListLock);
2102#if DEBUG
2103 Yap_ExpandClauses--;
2104 Yap_expand_clauses_sz -= (UInt)(NEXTOP((yamop *)NULL, sssllp)) +
2105 ipc->y_u.sssllp.s1 * sizeof(yamop *);
2106#endif
2107 /* no dangling pointers for gprof */
2108 Yap_InformOfRemoval(ipc);
2109 if (ipc->y_u.sssllp.p->PredFlags & LogUpdatePredFlag) {
2110 Yap_LUIndexSpace_EXT -= (UInt)NEXTOP((yamop *)NULL, sssllp) +
2111 ipc->y_u.sssllp.s1 * sizeof(yamop *);
2112 } else
2113 Yap_IndexSpace_EXT -= (UInt)NEXTOP((yamop *)NULL, sssllp) +
2114 ipc->y_u.sssllp.s1 * sizeof(yamop *);
2115 Yap_FreeCodeSpace((char *)ipc);
2116 }
2117}
2118
2119static UInt do_var_entries(GroupDef *grp, Term t, struct intermediates *cint,
2120 UInt argno, int first, int clleft, UInt nxtlbl) {
2121 PredEntry *ap = cint->CurrentPred;
2122
2123 if (!IsVarTerm(t) || t != 0L) {
2124 return suspend_indexing(grp->FirstClause, grp->LastClause, ap, cint);
2125 }
2126 return do_var_group(grp, cint, FALSE, first, clleft, nxtlbl,
2127 ap->ArityOfPE + 1);
2128}
2129
2130static UInt do_consts(GroupDef *grp, Term t, struct intermediates *cint,
2131 int compound_term, CELL *sreg, UInt arity, int last_arg,
2132 UInt argno, int first, UInt nxtlbl, int clleft,
2133 CELL *top) {
2134 COUNT n;
2135 ClauseDef *min = grp->FirstClause;
2136 COUNT i;
2137 UInt lbl;
2138 /* generate a switch */
2139 AtomSwiEntry *cs;
2140 PredEntry *ap = cint->CurrentPred;
2141
2142 if (!IsAtomTerm(min->Tag) && !IsIntTerm(min->Tag)) {
2143 /* no clauses, just skip */
2144 return nxtlbl;
2145 }
2146 n = count_consts(grp);
2147 lbl = new_label(cint);
2148 Yap_emit(label_op, lbl, Zero, cint);
2149 cs = emit_cswitch(n, FAILCODE, cint);
2150 for (i = 0; i < n; i++) {
2151 AtomSwiEntry *ics;
2152 ClauseDef *max = min;
2153
2154 ics = fetch_centry(cs, min->Tag, i, n);
2155 ics->Tag = min->Tag;
2156 while (max != grp->LastClause && (max + 1)->Tag == min->Tag)
2157 max++;
2158 if (min != max) {
2159 if (sreg != NULL) {
2160 if (ap->PredFlags & LogUpdatePredFlag && max > min) {
2161 ics->u_a.Label = suspend_indexing(min, max, ap, cint);
2162 } else {
2163 ics->u_a.Label = do_compound_index(
2164 min, max, sreg, cint, compound_term, arity, argno, nxtlbl, first,
2165 last_arg, clleft, top, TRUE);
2166 }
2167 } else if (ap->PredFlags & LogUpdatePredFlag) {
2168 ics->u_a.Label = suspend_indexing(min, max, cint->CurrentPred, cint);
2169 } else {
2170 ics->u_a.Label =
2171 do_index(min, max, cint, argno + 1, nxtlbl, first, clleft, top);
2172 }
2173 } else {
2174 ics->u_a.Label =
2175 do_index(min, max, cint, argno + 1, nxtlbl, first, clleft, top);
2176 }
2177 grp->FirstClause = min = max + 1;
2178 }
2179 return lbl;
2180}
2181
2182static void do_blobs(GroupDef *grp, Term t, struct intermediates *cint,
2183 UInt argno, int first, UInt nxtlbl, int clleft,
2184 CELL *top) {
2185 COUNT n;
2186 ClauseDef *min = grp->FirstClause;
2187 COUNT i;
2188 /* generate a switch */
2189 AtomSwiEntry *cs;
2190 PredEntry *ap = cint->CurrentPred;
2191
2192 n = count_blobs(grp);
2193 cs = emit_cswitch(n, (yamop *)nxtlbl, cint);
2194 for (i = 0; i < n; i++) {
2195 AtomSwiEntry *ics;
2196 ClauseDef *max = min;
2197
2198 ics = fetch_centry(cs, min->Tag, i, n);
2199 ics->Tag = min->Tag;
2200 while (max != grp->LastClause && (max + 1)->Tag == min->Tag)
2201 max++;
2202 if (min != max && (ap->PredFlags & LogUpdatePredFlag)) {
2203 ics->u_a.Label = suspend_indexing(min, max, ap, cint);
2204 } else {
2205 ics->u_a.Label =
2206 do_index(min, max, cint, argno + 1, nxtlbl, first, clleft, top);
2207 }
2208 grp->FirstClause = min = max + 1;
2209 }
2210}
2211
2212static UInt do_funcs(GroupDef *grp, Term t, struct intermediates *cint,
2213 UInt argno, int first, int last_arg, UInt nxtlbl,
2214 int clleft, CELL *top) {
2215 COUNT n = count_funcs(grp);
2216 ClauseDef *min = grp->FirstClause;
2217 COUNT i;
2218 FuncSwiEntry *fs;
2219 UInt lbl;
2220
2221 if (min > grp->LastClause || n == 0) {
2222 /* no clauses, just skip */
2223 return nxtlbl;
2224 }
2225 lbl = new_label(cint);
2226 Yap_emit(label_op, lbl, Zero, cint);
2227 /* generate a switch */
2228 fs = emit_fswitch(n, FAILCODE, cint);
2229 for (i = 0; i < n; i++) {
2230 Functor f = (Functor)RepAppl(min->Tag);
2231 FuncSwiEntry *ifs;
2232 ClauseDef *max = min;
2233
2234 ifs = fetch_fentry(fs, f, i, n);
2235 ifs->Tag = f;
2236 while (max != grp->LastClause && (max + 1)->Tag == min->Tag)
2237 max++;
2238 /* delay non-trivial indexing
2239 if (min != max &&
2240 !IsExtensionFunctor(f)) {
2241 ifs->y_u.Label = suspend_indexing(min, max, ap, cint);
2242 } else
2243 */
2244
2245 if (IsExtensionFunctor(f)) {
2246 if (f == FunctorDBRef)
2247 ifs->u_f.Label = do_dbref_index(min, max, t, cint, argno, nxtlbl, first,
2248 clleft, top);
2249 else if (f == FunctorLongInt || f == FunctorBigInt)
2250 ifs->u_f.Label = do_blob_index(min, max, t, cint, argno, nxtlbl, first,
2251 clleft, top, FALSE);
2252 else
2253 ifs->u_f.Label = do_blob_index(min, max, t, cint, argno, nxtlbl, first,
2254 clleft, top, TRUE);
2255
2256 } else {
2257 CELL *sreg;
2258
2259 if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) == f) {
2260 sreg = RepAppl(t) + 1;
2261 } else {
2262 sreg = NULL;
2263 }
2264 ifs->u_f.Label =
2265 do_compound_index(min, max, sreg, cint, 0, ArityOfFunctor(f), argno,
2266 nxtlbl, first, last_arg, clleft, top, TRUE);
2267 }
2268 grp->FirstClause = min = max + 1;
2269 }
2270 return lbl;
2271}
2272
2273static UInt do_pair(GroupDef *grp, Term t, struct intermediates *cint,
2274 UInt argno, int first, int last_arg, UInt nxtlbl,
2275 int clleft, CELL *top) {
2276 ClauseDef *min = grp->FirstClause;
2277 ClauseDef *max = grp->FirstClause;
2278
2279 while (IsPairTerm(max->Tag) && max != grp->LastClause) {
2280 max++;
2281 }
2282 if (!IsPairTerm(max->Tag)) {
2283 max--;
2284 }
2285 if (min > grp->LastClause) {
2286 /* no clauses, just skip */
2287 return nxtlbl;
2288 }
2289 grp->FirstClause = max + 1;
2290 if (min == max) {
2291 /* single clause, no need to do indexing, but we do know it is a list */
2292 if (cint->CurrentPred->PredFlags & LogUpdatePredFlag) {
2293 return (UInt)(min->Code);
2294 } else {
2295 return (UInt)(min->CurrentCode);
2296 }
2297 }
2298 if (min != max && !IsPairTerm(t)) {
2299 return suspend_indexing(min, max, cint->CurrentPred, cint);
2300 }
2301 return do_compound_index(min, max, (IsPairTerm(t) ? RepPair(t) : NULL), cint,
2302 0, 2, argno, nxtlbl, first, last_arg, clleft, top,
2303 TRUE);
2304}
2305
2306static void group_prologue(int compound_term, UInt argno, int first,
2307 struct intermediates *cint) {
2308 if (compound_term) {
2309 Yap_emit(cache_sub_arg_op, compound_term - 1, compound_term - 1, cint);
2310 } else {
2311 if (!first || argno != 1) {
2312 Yap_emit(cache_arg_op, argno, argno, cint);
2313 }
2314 }
2315}
2316
2317/* make sure that we can handle failure correctly */
2318static void emit_protection_choicepoint(int first, int clleft, UInt nxtlbl,
2319 struct intermediates *cint) {
2320
2321 if (first) {
2322 if (clleft) {
2323 if (cint->CurrentPred->PredFlags & LogUpdatePredFlag) {
2324 UInt labl = new_label(cint);
2325
2326 Yap_emit_4ops(enter_lu_op, labl, labl, 0, Zero, cint);
2327 Yap_emit(label_op, labl, Zero, cint);
2328 }
2329 Yap_emit(tryme_op, nxtlbl, (clleft << 1), cint);
2330 }
2331 } else {
2332 /* !first */
2333 if (clleft) {
2334 Yap_emit(retryme_op, nxtlbl, (clleft << 1), cint);
2335 } else {
2336 Yap_emit(trustme_op, 0, 0, cint);
2337 }
2338 }
2339}
2340
2341static ClauseDef *cls_move(ClauseDef *min, PredEntry *ap, ClauseDef *max,
2342 int compound_term, UInt argno, int last_arg) {
2343 ClauseDef *cl = min;
2344
2345 cl = min;
2346 if (compound_term) {
2347 while (cl <= max) {
2348 skip_to_arg(cl, ap, compound_term, last_arg);
2349 cl++;
2350 }
2351 } else {
2352 while (cl <= max) {
2353 if (cl->Tag == (_var + 1) * sizeof(CELL)) {
2354 ClauseDef *cli = cl;
2355 while (cli < max) {
2356 clcpy(cli, cli + 1);
2357 cli++;
2358 }
2359 max--;
2360 } else {
2361 move_next(cl, argno);
2362 }
2363 cl++;
2364 }
2365 }
2366 return max;
2367}
2368
2369static void purge_pvar(GroupDef *group) {
2370 ClauseDef *max = group->LastClause;
2371 ClauseDef *cl = group->FirstClause;
2372
2373 while (cl <= max) {
2374 if (cl->Tag == (_var + 1) * sizeof(CELL)) {
2375 ClauseDef *cli = cl;
2376 while (cli < max) {
2377 clcpy(cli, cli + 1);
2378 cli++;
2379 }
2380 group->VarClauses--;
2381 max--;
2382 }
2383 cl++;
2384 }
2385 group->LastClause = max;
2386}
2387
2388static UInt *do_nonvar_group(GroupDef *grp, Term t, UInt compound_term,
2389 CELL *sreg, UInt arity, UInt labl,
2390 struct intermediates *cint, UInt argno, int first,
2391 int last_arg, UInt nxtlbl, int clleft, CELL *top) {
2392 TypeSwitch *type_sw;
2393 PredEntry *ap = cint->CurrentPred;
2394
2395 /* move cl pointer */
2396 if (grp->AtomClauses + grp->PairClauses + grp->StructClauses > 1) {
2397 Yap_emit(label_op, labl, Zero, cint);
2398 if (argno == 1 && !compound_term) {
2399 emit_protection_choicepoint(first, clleft, nxtlbl, cint);
2400 }
2401 group_prologue(compound_term, argno, first, cint);
2402 if (grp->LastClause < grp->FirstClause) { /* only tests */
2403 return NULL;
2404 }
2405 type_sw = emit_type_switch(switch_on_type_op, cint);
2406 /* have these first so that we will have something initialized here */
2407 type_sw->ConstEntry = type_sw->FuncEntry = type_sw->PairEntry =
2408 type_sw->VarEntry = nxtlbl;
2409 type_sw->VarEntry =
2410 do_var_entries(grp, t, cint, argno, first, clleft, nxtlbl);
2411 grp->LastClause = cls_move(grp->FirstClause, ap, grp->LastClause,
2412 compound_term, argno, last_arg);
2413 sort_group(grp, top, cint);
2414 while (grp->FirstClause <= grp->LastClause) {
2415 if (IsAtomOrIntTerm(grp->FirstClause->Tag)) {
2416 type_sw->ConstEntry =
2417 do_consts(grp, t, cint, compound_term, sreg, arity, last_arg, argno,
2418 first, nxtlbl, clleft, top);
2419 } else if (IsApplTerm(grp->FirstClause->Tag)) {
2420 type_sw->FuncEntry =
2421 do_funcs(grp, t, cint, argno, first, last_arg, nxtlbl, clleft, top);
2422 } else {
2423 type_sw->PairEntry =
2424 do_pair(grp, t, cint, argno, first, last_arg, nxtlbl, clleft, top);
2425 }
2426 }
2427 return &(type_sw->VarEntry);
2428 } else {
2429 Yap_emit(label_op, labl, Zero, cint);
2430 do_var_group(grp, cint, TRUE, first, clleft, nxtlbl, ap->ArityOfPE + 1);
2431 return NULL;
2432 }
2433}
2434
2435static UInt do_optims(GroupDef *group, int ngroups, UInt fail_l, ClauseDef *min,
2436 struct intermediates *cint) {
2437 if (ngroups == 2 && group[0].FirstClause == group[0].LastClause &&
2438 group[0].AtomClauses == 1 && group[1].VarClauses == 1) {
2439 CELL *sp;
2440 UInt labl;
2441
2442 labl = new_label(cint);
2443 sp = Yap_emit_extra_size(if_not_op, Zero, 4 * CellSize, cint);
2444 sp[0] = (CELL)(group[0].FirstClause->Tag);
2445 sp[1] = (CELL)(group[1].FirstClause->Code);
2446 sp[2] = do_var_clauses(group[0].FirstClause, group[1].LastClause, FALSE,
2447 cint, TRUE, 0, (CELL)FAILCODE,
2448 cint->CurrentPred->ArityOfPE + 1);
2449 sp[3] = do_var_clauses(min, group[1].LastClause, FALSE, cint, TRUE, 0,
2450 (CELL)FAILCODE, cint->CurrentPred->ArityOfPE + 1);
2451 return labl;
2452 }
2453 return fail_l;
2454}
2455
2456static int cls_info(ClauseDef *min, ClauseDef *max, UInt argno) {
2457 ClauseDef *cl = min;
2458 int found_pvar = FALSE;
2459
2460 while (cl <= max) {
2461 add_info(cl, argno);
2462 if (cl->Tag == (_var + 1) * sizeof(CELL)) {
2463 found_pvar = TRUE;
2464 }
2465 /* if (IsVarTerm(cl->Tag)) cl->Tag = (CELL)NULL; */
2466 cl++;
2467 }
2468 return found_pvar;
2469}
2470
2471static int cls_head_info(ClauseDef *min, ClauseDef *max, UInt argno,
2472 int in_idb) {
2473 ClauseDef *cl = min;
2474
2475 if (in_idb) {
2476 if (argno != 2) {
2477 while (cl <= max) {
2478 cl->Tag = (CELL)NULL;
2479 cl++;
2480 }
2481 } else {
2482 while (cl <= max) {
2483 LogUpdClause *lcl = ClauseCodeToLogUpdClause(cl->CurrentCode);
2484 Term t = lcl->lusl.ClSource->Entry;
2485
2486 if (IsVarTerm(t)) {
2487 cl->Tag = (CELL)NULL;
2488 } else if (IsApplTerm(t)) {
2489 CELL *pt = RepAppl(t);
2490
2491 cl->Tag = AbsAppl((CELL *)pt[0]);
2492 if (IsExtensionFunctor(FunctorOfTerm(t))) {
2493 cl->ucd.t_ptr = t;
2494 } else {
2495 cl->ucd.c_sreg = pt;
2496 }
2497 } else if (IsPairTerm(t)) {
2498 CELL *pt = RepPair(t);
2499
2500 cl->Tag = AbsPair(NULL);
2501 cl->ucd.c_sreg = pt - 1;
2502 } else {
2503 cl->Tag = t;
2504 }
2505 cl++;
2506 }
2507 }
2508 } else {
2509 while (cl <= max) {
2510 add_info(cl, argno);
2511 /* if (IsVarTerm(cl->Tag)) cl->Tag = (CELL)NULL; */
2512 cl++;
2513 }
2514 }
2515 return FALSE;
2516}
2517
2518static UInt do_index(ClauseDef *min, ClauseDef *max, struct intermediates *cint,
2519 UInt argno, UInt fail_l, int first, int clleft,
2520 CELL *top) {
2521 CACHE_REGS
2522 UInt ngroups, found_pvar = FALSE;
2523 UInt i = 0;
2524 GroupDef *group = (GroupDef *)top;
2525 UInt labl, labl0, lablx;
2526 Term t;
2527 /* remember how we entered here */
2528 UInt argno0 = argno;
2529 PredEntry *ap = cint->CurrentPred;
2530 yamop *eblk = cint->expand_block;
2531
2532 if (min == max) {
2533 /* base case, just commit to the current code */
2534 return emit_single_switch_case(min, cint, first, clleft, fail_l);
2535 }
2536 if ((argno > 1 && indexingMode() == TermSingle &&
2537 ap->PredFlags & LogUpdatePredFlag) ||
2538 indexingMode() == TermOff || ap->ArityOfPE < argno) {
2539 return do_var_clauses(min, max, FALSE, cint, first, clleft, fail_l,
2540 ap->ArityOfPE + 1);
2541 }
2542 t = Deref(XREGS[argno]);
2543 if (ap->PredFlags & LogUpdatePredFlag) {
2544 found_pvar =
2545 cls_head_info(min, max, argno, (ap->ModuleOfPred == IDB_MODULE));
2546 } else {
2547 found_pvar = cls_info(min, max, argno);
2548 }
2549 ngroups = groups_in(min, max, group, cint);
2550 if (IsVarTerm(t)) {
2551 lablx = new_label(cint);
2552 Yap_emit(label_op, lablx, Zero, cint);
2553 while (IsVarTerm(t)) {
2554 if (ngroups > 1 || !group->VarClauses) {
2555 UInt susp_lab = suspend_indexing(min, max, ap, cint);
2556 if (!cint->expand_block) {
2557 cint->expand_block = (yamop *)susp_lab;
2558 }
2559 Yap_emit(jump_nv_op, susp_lab, argno, cint);
2560 }
2561 if (argno == ap->ArityOfPE ||
2562 (indexingMode() == TermSingle && ap->PredFlags & LogUpdatePredFlag)) {
2563 do_var_clauses(min, max, FALSE, cint, first, clleft, fail_l, argno0);
2564 cint->expand_block = eblk;
2565 return lablx;
2566 }
2567 argno++;
2568 t = Deref(XREGS[argno]);
2569 if (ap->PredFlags & LogUpdatePredFlag) {
2570 found_pvar =
2571 cls_head_info(min, max, argno, (ap->ModuleOfPred == IDB_MODULE));
2572 } else {
2573 found_pvar = cls_info(min, max, argno);
2574 }
2575 ngroups = groups_in(min, max, group, cint);
2576 }
2577 labl0 = labl = new_label(cint);
2578 } else {
2579 lablx = labl0 = labl = new_label(cint);
2580 }
2581 cint->expand_block = eblk;
2582 top = (CELL *)(group + ngroups);
2583 if (argno > 1) {
2584 /* don't try being smart for other arguments than the first */
2585 if (ngroups > 1 || group->VarClauses != 0 || found_pvar) {
2586 if (ap->ArityOfPE == argno) {
2587 return do_var_clauses(min, max, FALSE, cint, first, clleft, fail_l,
2588 ap->ArityOfPE + 1);
2589 } else {
2590 return do_index(min, max, cint, argno + 1, fail_l, first, clleft, top);
2591 }
2592 } else {
2593 ClauseDef *cl = min;
2594 /*
2595 need to reset the code pointer, otherwise I could be in
2596 the middle of a compound term.
2597 */
2598 while (cl <= max) {
2599 cl->CurrentCode = cl->Code;
2600 cl++;
2601 }
2602 }
2603 } else {
2604 UInt special_options;
2605
2606 if ((ap->PredFlags & LogUpdatePredFlag) && ngroups > 1) {
2607 if (ngroups > 1) {
2608 group[0].VarClauses = ap->cs.p_code.NOfClauses;
2609 group[0].AtomClauses = group[0].PairClauses = group[0].StructClauses =
2610 group[0].TestClauses = 0;
2611 group[0].LastClause = group[ngroups - 1].LastClause;
2612 ngroups = 1;
2613 }
2614 } else if ((special_options =
2615 do_optims(group, ngroups, fail_l, min, cint)) != fail_l) {
2616 return special_options;
2617 }
2618 if (ngroups == 1 && group->VarClauses && !found_pvar) {
2619 return do_index(min, max, cint, argno + 1, fail_l, first, clleft, top);
2620 } else if (found_pvar ||
2621 (ap->PredFlags & LogUpdatePredFlag && group[0].VarClauses)) {
2622 /* make sure we know where to suspend */
2623 Yap_emit(label_op, labl0, Zero, cint);
2624 labl = new_label(cint);
2625 Yap_emit(jump_v_op, suspend_indexing(min, max, ap, cint), Zero, cint);
2626 }
2627 }
2628 for (i = 0; i < ngroups; i++) {
2629 UInt nextlbl;
2630 int left_clauses = clleft + (max - group->LastClause);
2631 /* a group may end up not having clauses*/
2632
2633 if (i < ngroups - 1) {
2634 nextlbl = new_label(cint);
2635 } else {
2636 nextlbl = fail_l;
2637 }
2638 if (found_pvar && argno == 1) {
2639 purge_pvar(group);
2640 }
2641 if (group->FirstClause == group->LastClause && first && left_clauses == 0) {
2642 Yap_emit(jumpi_op, (CELL)(group->FirstClause->Code), Zero, cint);
2643 } else {
2644 if (group->VarClauses) {
2645 Yap_emit(label_op, labl, Zero, cint);
2646 do_var_group(group, cint, argno == 1, first, left_clauses, nextlbl,
2647 ap->ArityOfPE + 1);
2648 } else {
2649 do_nonvar_group(group, t, 0, NULL, 0, labl, cint, argno, first, TRUE,
2650 nextlbl, left_clauses, top);
2651 }
2652 }
2653 first = FALSE;
2654 group++;
2655 labl = nextlbl;
2656 }
2657 return lablx;
2658}
2659
2660static ClauseDef *copy_clauses(ClauseDef *max0, ClauseDef *min0, CELL *top,
2661 struct intermediates *cint) {
2662 CACHE_REGS
2663 UInt sz = ((max0 + 1) - min0) * sizeof(ClauseDef);
2664 if ((char *)top + sz >= LOCAL_TrailTop - 4096) {
2665 LOCAL_Error_Size = sz;
2666 /* grow stack */
2667 save_machine_regs();
2668 siglongjmp(cint->CompilerBotch, 4);
2669 }
2670 memcpy((void *)top, (void *)min0, sz);
2671 return (ClauseDef *)top;
2672}
2673
2674/* make sure that it is worth it to generate indexing code at that point */
2675static int several_tags(ClauseDef *min, ClauseDef *max) {
2676 CELL tag = min->Tag;
2677 while (min < max) {
2678 min++;
2679 if (!IsAtomOrIntTerm(min->Tag) || min->Tag != tag)
2680 return TRUE;
2681 }
2682 return FALSE;
2683}
2684
2685/* execute an index inside a structure */
2686static UInt do_compound_index(ClauseDef *min0, ClauseDef *max0, Term *sreg,
2687 struct intermediates *cint, UInt i, UInt arity,
2688 UInt argno, UInt fail_l, int first, int last_arg,
2689 int clleft, CELL *top, int done_work) {
2690 UInt ret_lab = 0, *newlabp;
2691 CELL *top0 = top;
2692 ClauseDef *min, *max;
2693 PredEntry *ap = cint->CurrentPred;
2694 int found_index = FALSE;
2695 pred_flags_t lu_pred = ap->PredFlags & LogUpdatePredFlag;
2696 UInt old_last_depth, old_last_depth_size;
2697
2698 newlabp = &ret_lab;
2699 if (min0 == max0) {
2700 /* base case, just commit to the current code */
2701 return emit_single_switch_case(min0, cint, first, clleft, fail_l);
2702 }
2703 if ((indexingMode() == TermSingle && ap->PredFlags & LogUpdatePredFlag) ||
2704 (indexingDepth() &&
2705 cint->term_depth - cint->last_index_new_depth > indexingDepth())) {
2706 *newlabp = do_var_clauses(min0, max0, FALSE, cint, first, clleft, fail_l,
2707 ap->ArityOfPE + 1);
2708 return ret_lab;
2709 }
2710 if (sreg == NULL) {
2711 return suspend_indexing(min0, max0, ap, cint);
2712 }
2713 cint->term_depth++;
2714 old_last_depth = cint->last_index_new_depth;
2715 old_last_depth_size = cint->last_depth_size;
2716 if (cint->last_depth_size != max0 - min0) {
2717 cint->last_index_new_depth = cint->term_depth;
2718 cint->last_depth_size = max0 - min0;
2719 }
2720 while (i < arity && !found_index) {
2721 ClauseDef *cl;
2722 GroupDef *group;
2723 UInt ngroups;
2724 int isvt = IsVarTerm(Deref(sreg[i]));
2725
2726 min = copy_clauses(max0, min0, top, cint);
2727 max = min + (max0 - min0);
2728 top = (CELL *)(max + 1);
2729 cl = min;
2730 /* search for a subargument */
2731 while (cl <= max) {
2732 add_arg_info(cl, ap, i + 1);
2733 cl++;
2734 }
2735 group = (GroupDef *)top;
2736 ngroups = groups_in(min, max, group, cint);
2737 if (ngroups == 1 && group->VarClauses == 0 &&
2738 (i < 8 || several_tags(min, max))) {
2739 /* ok, we are doing a sub-argument */
2740 /* process group */
2741
2742 found_index = TRUE;
2743 ret_lab = new_label(cint);
2744 top = (CELL *)(group + 1);
2745 if (do_nonvar_group(group, (sreg == NULL ? 0L : Deref(sreg[i])), i + 1,
2746 (isvt ? NULL : sreg), arity, *newlabp, cint, argno,
2747 first, (last_arg && i + 1 == arity), fail_l, clleft,
2748 top) == NULL) {
2749 top = top0;
2750 break;
2751 }
2752 }
2753 top = top0;
2754 i++;
2755 }
2756 if (!found_index) {
2757 if (!lu_pred || !done_work)
2758 *newlabp =
2759 do_index(min0, max0, cint, argno + 1, fail_l, first, clleft, top);
2760 else
2761 *newlabp = suspend_indexing(min0, max0, ap, cint);
2762 }
2763 cint->last_index_new_depth = old_last_depth;
2764 cint->last_depth_size = old_last_depth_size;
2765 cint->term_depth--;
2766 return ret_lab;
2767}
2768
2769static UInt do_dbref_index(ClauseDef *min, ClauseDef *max, Term t,
2770 struct intermediates *cint, UInt argno, UInt fail_l,
2771 int first, int clleft, CELL *top) {
2772 UInt ngroups;
2773 GroupDef *group;
2774 ClauseDef *cl = min;
2775
2776 group = (GroupDef *)top;
2777 cl = min;
2778
2779 while (cl <= max) {
2780 cl->Tag = cl->ucd.t_ptr;
2781 cl++;
2782 }
2783 ngroups = groups_in(min, max, group, cint);
2784 if (ngroups > 1 || group->VarClauses) {
2785 return do_index(min, max, cint, argno + 1, fail_l, first, clleft, top);
2786 } else {
2787 int labl = new_label(cint);
2788
2789 Yap_emit(label_op, labl, Zero, cint);
2790 Yap_emit(index_dbref_op, Zero, Zero, cint);
2791 sort_group(group, (CELL *)(group + 1), cint);
2792 do_blobs(group, t, cint, argno, first, fail_l, clleft, (CELL *)(group + 1));
2793 return labl;
2794 }
2795}
2796
2797static UInt do_blob_index(ClauseDef *min, ClauseDef *max, Term t,
2798 struct intermediates *cint, UInt argno, UInt fail_l,
2799 int first, int clleft, CELL *top, int blob) {
2800 UInt ngroups;
2801 GroupDef *group;
2802 ClauseDef *cl = min;
2803
2804 group = (GroupDef *)top;
2805 cl = min;
2806
2807 while (cl <= max) {
2808 if (cl->ucd.t_ptr == (CELL)NULL) { /* check whether it is a builtin */
2809 cl->Tag = Zero;
2810 } else if (blob) {
2811 cl->Tag = Yap_Double_key(cl->ucd.t_ptr);
2812 } else {
2813 cl->Tag = Yap_Int_key(cl->ucd.t_ptr);
2814 }
2815 cl++;
2816 }
2817 ngroups = groups_in(min, max, group, cint);
2818 if (ngroups > 1 || group->VarClauses) {
2819 return do_index(min, max, cint, argno + 1, fail_l, first, clleft, top);
2820 } else {
2821 int labl = new_label(cint);
2822
2823 Yap_emit(label_op, labl, Zero, cint);
2824 if (blob)
2825 Yap_emit(index_blob_op, Zero, Zero, cint);
2826 else
2827 Yap_emit(index_long_op, Zero, Zero, cint);
2828 sort_group(group, (CELL *)(group + 1), cint);
2829 do_blobs(group, t, cint, argno, first, fail_l, clleft, (CELL *)(group + 1));
2830 return labl;
2831 }
2832}
2833
2834static void init_clauses(ClauseDef *cl, PredEntry *ap) {
2835 if (ap->PredFlags & MegaClausePredFlag) {
2836 MegaClause *mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
2837 UInt nclauses = mcl->ClPred->cs.p_code.NOfClauses;
2838 yamop *end = (yamop *)((char *)mcl->ClCode + nclauses * mcl->ClItemSize);
2839 yamop *cd = mcl->ClCode;
2840 while (cd < end) {
2841 cl->Code = cl->CurrentCode = cd;
2842 cd = (yamop *)((char *)cd + mcl->ClItemSize);
2843 cl++;
2844 }
2845 } else {
2846 StaticClause *scl;
2847
2848 scl = ClauseCodeToStaticClause(ap->cs.p_code.FirstClause);
2849 do {
2850 cl->Code = cl->CurrentCode = scl->ClCode;
2851 cl++;
2852 if (scl->ClCode == ap->cs.p_code.LastClause)
2853 return;
2854 scl = scl->ClNext;
2855 } while (TRUE);
2856 }
2857}
2858
2859static void init_log_upd_clauses(ClauseDef *cl, PredEntry *ap) {
2860 LogUpdClause *lcl = ClauseCodeToLogUpdClause(ap->cs.p_code.FirstClause);
2861
2862 do {
2863 cl->Code = cl->CurrentCode = lcl->ClCode;
2864 cl++;
2865 lcl = lcl->ClNext;
2866 } while (lcl != NULL);
2867}
2868
2869static UInt compile_index(struct intermediates *cint) {
2870 CACHE_REGS
2871 PredEntry *ap = cint->CurrentPred;
2872 int NClauses = ap->cs.p_code.NOfClauses;
2873 CELL *top = (CELL *)TR;
2874 UInt res;
2875
2876 /* only global variable I use directly */
2877 cint->i_labelno = 1;
2878
2879 LOCAL_Error_Size = 0;
2880#if USE_SYSTEM_MALLOC
2881 if (!cint->cls) {
2882 cint->cls = (ClauseDef *)Yap_AllocCodeSpace(NClauses * sizeof(ClauseDef));
2883 if (!cint->cls) {
2884 /* tell how much space we need */
2885 LOCAL_Error_Size += NClauses * sizeof(ClauseDef);
2886 /* grow stack */
2887 save_machine_regs();
2888 siglongjmp(cint->CompilerBotch, 2);
2889 }
2890 }
2891 cint->freep = (char *)HR;
2892#else
2893 /* reserve double the space for compiler */
2894 cint->cls = (ClauseDef *)HR;
2895 if (cint->cls + 2 * NClauses > (ClauseDef *)(ASP - 4096)) {
2896 /* tell how much space we need */
2897 LOCAL_Error_Size += NClauses * sizeof(ClauseDef);
2898 /* grow stack */
2899 save_machine_regs();
2900 siglongjmp(cint->CompilerBotch, 3);
2901 }
2902 cint->freep = (char *)(cint->cls + NClauses);
2903#endif
2904 if (ap->PredFlags & LogUpdatePredFlag) {
2905 /* throw away a label */
2906 new_label(cint);
2907 init_log_upd_clauses(cint->cls, ap);
2908 } else if (ap->PredFlags & UDIPredFlag) {
2909 UInt lbl = new_label(cint);
2910 Yap_emit(user_switch_op, Unsigned(ap),
2911 Unsigned(&(ap->cs.p_code.ExpandCode)), cint);
2912 return lbl;
2913 } else {
2914 /* prepare basic data structures */
2915 init_clauses(cint->cls, ap);
2916 }
2917 res = do_index(cint->cls, cint->cls + (NClauses - 1), cint, 1, (UInt)FAILCODE,
2918 TRUE, 0, top);
2919 return res;
2920}
2921
2922static void CleanCls(struct intermediates *cint) {
2923#if USE_SYSTEM_MALLOC
2924 if (cint->cls) {
2925 Yap_FreeCodeSpace((ADDR)cint->cls);
2926 }
2927#endif
2928 cint->cls = NULL;
2929}
2930
2931yamop *Yap_PredIsIndexable(PredEntry *ap, UInt NSlots, yamop *next_pc) {
2932 CACHE_REGS
2933 yamop *indx_out;
2934 int setjres;
2935 struct intermediates cint;
2936
2937 cint.CurrentPred = ap;
2938 cint.code_addr = NULL;
2939 cint.blks = NULL;
2940 cint.cls = NULL;
2941 LOCAL_Error_Size = 0;
2942
2943 if ((setjres = sigsetjmp(cint.CompilerBotch, 0)) == 3) {
2944 restore_machine_regs();
2945 recover_from_failed_susp_on_cls(&cint, 0);
2946 if (!Yap_dogc(PASS_REGS1)) {
2947 CleanCls(&cint);
2948 Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
2949 return FAILCODE;
2950 }
2951 } else if (setjres == 2) {
2952 restore_machine_regs();
2953 LOCAL_Error_Size = recover_from_failed_susp_on_cls(&cint, LOCAL_Error_Size);
2954 if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
2955 CleanCls(&cint);
2956 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
2957 return NULL;
2958 }
2959 } else if (setjres == 4) {
2960 restore_machine_regs();
2961 recover_from_failed_susp_on_cls(&cint, 0);
2962 if (!Yap_growtrail(LOCAL_Error_Size, FALSE)) {
2963 CleanCls(&cint);
2964 Yap_Error(RESOURCE_ERROR_TRAIL, TermNil, LOCAL_ErrorMessage);
2965 return NULL;
2966 }
2967 } else if (setjres != 0) {
2968 restore_machine_regs();
2969 recover_from_failed_susp_on_cls(&cint, 0);
2970 if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
2971 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
2972 CleanCls(&cint);
2973 return NULL;
2974 }
2975 }
2976 restart_index:
2977 if (ap->cs.p_code.NOfClauses==0) {
2978if (ap->PredFlags & (LogUpdatePredFlag|MultiFileFlag)) {
2979 ap->OpcodeOfPred = FAIL_OPCODE;
2980 ap->cs.p_code.TrueCodeOfPred = ap->CodeOfPred =
2981 FAILCODE;
2982} else {
2983 ap->OpcodeOfPred = UNDEF_OPCODE;
2984 ap->cs.p_code.TrueCodeOfPred = ap->CodeOfPred =
2985 (yamop *)(&(ap->OpcodeOfPred));
2986 ap->PredFlags |= UndefPredFlag;
2987}
2988 ap->PredFlags &= ~IndexedPredFlag;
2989return ap->CodeOfPred;
2990
2991}
2992 if (ap->cs.p_code.NOfClauses==1) {
2993 ap->OpcodeOfPred = ap->CodeOfPred->opc;
2994 ap->cs.p_code.TrueCodeOfPred = ap->CodeOfPred =
2995 ap->cs.p_code.FirstClause;
2996 ap->PredFlags &= ~ IndexedPredFlag;
2997return ap->CodeOfPred;
2998
2999}
3000 Yap_BuildMegaClause(ap);
3001 cint.CodeStart = cint.BlobsStart = cint.cpc = cint.icpc = NULL;
3002 cint.expand_block = NULL;
3003 cint.label_offset = NULL;
3004 cint.term_depth = cint.last_index_new_depth = cint.last_depth_size = 0L;
3005 if (compile_index(&cint) == (UInt)FAILCODE) {
3006 Yap_ReleaseCMem(&cint);
3007 CleanCls(&cint);
3008 return NULL;
3009 }
3010#if DEBUG
3011 if (GLOBAL_Option['i' - 'a' + 1]) {
3012 Yap_ShowCode(&cint);
3013 }
3014#endif
3015 /* globals for assembler */
3016 LOCAL_IPredArity = ap->ArityOfPE;
3017 if (cint.CodeStart) {
3018 if ((indx_out = Yap_assemble(ASSEMBLING_INDEX, TermNil, ap, FALSE, &cint,
3019 cint.i_labelno + 1)) == NULL) {
3020 if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
3021 Yap_ReleaseCMem(&cint);
3022 CleanCls(&cint);
3023 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
3024 return NULL;
3025 }
3026 goto restart_index;
3027 }
3028 } else {
3029 Yap_ReleaseCMem(&cint);
3030 CleanCls(&cint);
3031 return NULL;
3032 }
3033 Yap_ReleaseCMem(&cint);
3034 CleanCls(&cint);
3035 if (ap->PredFlags & LogUpdatePredFlag) {
3036 LogUpdIndex *cl = ClauseCodeToLogUpdIndex(indx_out);
3037 cl->ClFlags |= SwitchRootMask;
3038 }
3039 ap->PredFlags |= IndexedPredFlag;
3040
3041 return (indx_out);
3042}
3043
3044static istack_entry *push_stack(istack_entry *sp, Int arg, Term Tag, Term extra,
3045 struct intermediates *cint) {
3046 CACHE_REGS
3047 if (sp + 1 > (istack_entry *)LOCAL_TrailTop) {
3048 save_machine_regs();
3049 siglongjmp(cint->CompilerBotch, 4);
3050 }
3051 sp->pos = arg;
3052 sp->val = Tag;
3053 sp->extra = extra;
3054 sp++;
3055 sp->pos = 0;
3056 return sp;
3057}
3058
3059static istack_entry *install_clause(ClauseDef *cls, PredEntry *ap,
3060 istack_entry *stack) {
3061 istack_entry *sp = stack;
3062 while (sp->pos) {
3063 if ((Int)(sp->pos) > 0) {
3064 add_info(cls, sp->pos);
3065 } else if (sp->pos) {
3066 UInt argno = -sp->pos;
3067 add_arg_info(cls, ap, argno);
3068 }
3069 /* if we are not talking about a variable */
3070 if (cls->Tag != sp->val) {
3071 if (sp->val == 0L) {
3072 sp++;
3073 }
3074 break;
3075 } else {
3076 if (IsApplTerm(cls->Tag)) {
3077 Functor f = (Functor)RepAppl(cls->Tag);
3078 if (IsExtensionFunctor(f)) {
3079 if (f == FunctorDBRef) {
3080 if (cls->ucd.t_ptr != sp->extra)
3081 break;
3082 } else if (f == FunctorDouble) {
3083 if (cls->ucd.t_ptr &&
3084 Yap_Double_key(sp->extra) != Yap_Double_key(cls->ucd.t_ptr))
3085 break;
3086 } else if (f == FunctorString) {
3087 if (cls->ucd.t_ptr &&
3088 Yap_String_key(sp->extra) != Yap_String_key(cls->ucd.t_ptr))
3089 break;
3090 } else {
3091 if (cls->ucd.t_ptr &&
3092 Yap_Int_key(sp->extra) != Yap_Int_key(cls->ucd.t_ptr))
3093 break;
3094 }
3095 }
3096 }
3097 if ((Int)(sp->pos) > 0) {
3098 move_next(cls, sp->pos);
3099 } else if (sp->pos) {
3100 UInt argno = -sp->pos;
3101 skip_to_arg(cls, ap, argno, FALSE);
3102 }
3103 }
3104 sp++;
3105 }
3106 return sp;
3107}
3108
3109static ClauseDef *install_clauses(ClauseDef *cls, PredEntry *ap,
3110 istack_entry *stack, yamop *beg, yamop *end) {
3111 istack_entry *sp = stack;
3112 if (ap->PredFlags & MegaClausePredFlag) {
3113 MegaClause *mcl = ClauseCodeToMegaClause(beg);
3114 UInt nclauses = mcl->ClPred->cs.p_code.NOfClauses;
3115 yamop *end = (yamop *)((char *)mcl->ClCode + nclauses * mcl->ClItemSize);
3116 yamop *cd = mcl->ClCode;
3117
3118 if (stack[0].pos == 0) {
3119 while (TRUE) {
3120 cls->Code = cls->CurrentCode = cd;
3121 cls->Tag = 0;
3122 cls++;
3123 cd = (yamop *)((char *)cd + mcl->ClItemSize);
3124 if (cd == end) {
3125 return cls - 1;
3126 }
3127 }
3128 }
3129 while (TRUE) {
3130 cls->Code = cls->CurrentCode = cd;
3131 sp = install_clause(cls, ap, stack);
3132 /* we reached a matching clause */
3133 if (!sp->pos && (sp[-1].val == 0L || cls->Tag == sp[-1].val)) {
3134 cls++;
3135 }
3136 cd = (yamop *)((char *)cd + mcl->ClItemSize);
3137 if (cd == end) {
3138 return cls - 1;
3139 }
3140 }
3141 } else {
3142 StaticClause *cl = ClauseCodeToStaticClause(beg);
3143
3144 if (stack[0].pos == 0) {
3145 while (TRUE) {
3146 cls->Code = cls->CurrentCode = cl->ClCode;
3147 cls->Tag = 0;
3148 cls++;
3149 if (cl->ClCode == end) {
3150 return cls - 1;
3151 }
3152 cl = cl->ClNext;
3153 }
3154 }
3155 while (TRUE) {
3156 cls->Code = cls->CurrentCode = cl->ClCode;
3157 sp = install_clause(cls, ap, stack);
3158 /* we reached a matching clause */
3159 if (!sp->pos && (sp[-1].val == 0L || cls->Tag == sp[-1].val)) {
3160 cls++;
3161 }
3162 if (cl->ClCode == end) {
3163 return cls - 1;
3164 }
3165 cl = cl->ClNext;
3166 }
3167 }
3168}
3169
3170static ClauseDef *install_clauseseq(ClauseDef *cls, PredEntry *ap,
3171 istack_entry *stack, yamop **beg,
3172 yamop **end) {
3173 istack_entry *sp = stack;
3174
3175 if (stack[0].pos == 0) {
3176 while (TRUE) {
3177 if (*beg) {
3178 cls->Code = cls->CurrentCode = *beg;
3179 cls->Tag = 0;
3180 cls++;
3181 }
3182 beg++;
3183 if (beg == end) {
3184 return cls - 1;
3185 }
3186 }
3187 }
3188 while (TRUE) {
3189 if (*beg) {
3190 cls->Code = cls->CurrentCode = *beg;
3191 sp = install_clause(cls, ap, stack);
3192 /* we reached a matching clause */
3193 if (!sp->pos && (sp[-1].val == 0L || cls->Tag == sp[-1].val)) {
3194 cls++;
3195 }
3196 }
3197 beg++;
3198 if (beg == end) {
3199 return cls - 1;
3200 }
3201 }
3202}
3203
3204static void reinstall_clauses(ClauseDef *cls, ClauseDef *end, PredEntry *ap,
3205 istack_entry *stack) {
3206 do {
3207 cls->CurrentCode = cls->Code;
3208 install_clause(cls, ap, stack);
3209 } while (cls++ != end);
3210}
3211
3212static istack_entry *install_log_upd_clause(ClauseDef *cls, PredEntry *ap,
3213 istack_entry *stack) {
3214 istack_entry *sp = stack;
3215 while (sp->pos) {
3216 if ((Int)(sp->pos) > 0) {
3217 add_head_info(cls, sp->pos);
3218 } else if (sp->pos) {
3219 UInt argno = -sp->pos;
3220 add_arg_info(cls, ap, argno);
3221 }
3222 /* if we are not talking about a variable */
3223 if (cls->Tag != sp->val) {
3224 if (sp->val == 0L) {
3225 sp++;
3226 }
3227 break;
3228 } else {
3229 if (IsApplTerm(cls->Tag)) {
3230 Functor f = (Functor)RepAppl(cls->Tag);
3231 if (IsExtensionFunctor(f)) {
3232 if (f == FunctorDBRef) {
3233 if (cls->ucd.t_ptr != sp->extra)
3234 break;
3235 } else if (f == FunctorDouble) {
3236 if (cls->ucd.t_ptr &&
3237 Yap_Double_key(sp->extra) != Yap_Double_key(cls->ucd.t_ptr))
3238 break;
3239 } else {
3240 if (cls->ucd.t_ptr &&
3241 Yap_Int_key(sp->extra) != Yap_Int_key(cls->ucd.t_ptr))
3242 break;
3243 }
3244 }
3245 }
3246 if ((Int)(sp->pos) > 0) {
3247 move_next(cls, sp->pos);
3248 } else if (sp->pos) {
3249 UInt argno = -sp->pos;
3250
3251 skip_to_arg(cls, ap, argno, FALSE);
3252 }
3253 }
3254 sp++;
3255 }
3256 return sp;
3257}
3258
3259static ClauseDef *install_log_upd_clauses(ClauseDef *cls, PredEntry *ap,
3260 istack_entry *stack, yamop *beg,
3261 yamop *end) {
3262 istack_entry *sp = stack;
3263
3264 if (stack[0].pos == 0) {
3265 while (TRUE) {
3266 cls->Code = cls->CurrentCode = beg;
3267 cls->Tag = 0;
3268 cls++;
3269 if (beg == end || beg == NULL) {
3270 return cls - 1;
3271 }
3272 beg = ClauseCodeToLogUpdClause(beg)->ClNext->ClCode;
3273 }
3274 }
3275 while (TRUE) {
3276 cls->Code = cls->CurrentCode = beg;
3277 sp = install_log_upd_clause(cls, ap, stack);
3278 /* we reached a matching clause */
3279 if (!sp->pos && (sp[-1].val == 0L || cls->Tag == sp[-1].val)) {
3280 cls++;
3281 }
3282 if (beg == end || beg == NULL) {
3283 return cls - 1;
3284 }
3285 beg = ClauseCodeToLogUpdClause(beg)->ClNext->ClCode;
3286 }
3287}
3288
3289static ClauseDef *install_log_upd_clauseseq(ClauseDef *cls, PredEntry *ap,
3290 istack_entry *stack, yamop **beg,
3291 yamop **end) {
3292 istack_entry *sp = stack;
3293
3294 if (stack[0].pos == 0) {
3295 while (TRUE) {
3296 if (beg) {
3297 cls->Code = cls->CurrentCode = *beg;
3298 cls->Tag = 0;
3299 cls++;
3300 }
3301 beg++;
3302 if (beg == end) {
3303 return cls - 1;
3304 }
3305 }
3306 }
3307 while (TRUE) {
3308 if (*beg) {
3309 cls->Code = cls->CurrentCode = *beg;
3310 sp = install_log_upd_clause(cls, ap, stack);
3311 /* we reached a matching clause */
3312 if (!sp->pos && (sp[-1].val == 0L || cls->Tag == sp[-1].val)) {
3313 cls++;
3314 }
3315 }
3316 beg++;
3317 if (beg == end) {
3318 return cls - 1;
3319 }
3320 }
3321}
3322
3323static void reinstall_log_upd_clauses(ClauseDef *cls, ClauseDef *end,
3324 PredEntry *ap, istack_entry *stack) {
3325 do {
3326 cls->CurrentCode = cls->Code;
3327 install_log_upd_clause(cls, ap, stack);
3328 } while (cls++ != end);
3329}
3330
3331#if PRECOMPUTE_REGADDRESS
3332
3333#define arg_from_x(I) (((CELL *)(I)) - XREGS)
3334
3335#else
3336
3337#define arg_from_x(I) (I)
3338
3339#endif /* ALIGN_LONGS */
3340
3341static AtomSwiEntry *lookup_c(Term t, yamop *tab, COUNT entries) {
3342 AtomSwiEntry *cebase = (AtomSwiEntry *)tab;
3343
3344 while (cebase->Tag != t) {
3345 entries--;
3346 cebase++;
3347 if (entries == 0)
3348 return cebase;
3349 }
3350 return cebase;
3351}
3352
3353static FuncSwiEntry *lookup_f(Functor f, yamop *tab, COUNT entries) {
3354 FuncSwiEntry *febase = (FuncSwiEntry *)tab;
3355
3356 while (febase->Tag != f) {
3357 entries--;
3358 febase++;
3359 if (entries == 0)
3360 return febase;
3361 }
3362 return febase;
3363}
3364
3365static COUNT count_clauses_left(yamop *cl, PredEntry *ap) {
3366 if (ap->PredFlags & LogUpdatePredFlag) {
3367 LogUpdClause *c = ClauseCodeToLogUpdClause(cl);
3368 COUNT i = 0;
3369
3370 while (c != NULL) {
3371 i++;
3372 c = c->ClNext;
3373 }
3374 return i;
3375 } else if (ap->PredFlags & MegaClausePredFlag) {
3376 MegaClause *mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
3377 UInt ncls = mcl->ClPred->cs.p_code.NOfClauses;
3378
3379 return (ncls - 1) - ((char *)cl - (char *)mcl->ClCode) / mcl->ClItemSize;
3380 } else {
3381 yamop *last = ap->cs.p_code.LastClause;
3382 StaticClause *c;
3383 COUNT i = 1;
3384
3385 c = ClauseCodeToStaticClause(cl);
3386 while (c->ClCode != last) {
3387 i++;
3388 c = c->ClNext;
3389 }
3390 return i;
3391 }
3392}
3393
3394/*
3395 We have jumped across indexing code. Check if we jumped within the current
3396 indexing block, if we moved back to a parent, or if we jumped to a child.
3397*/
3398static ClausePointer index_jmp(ClausePointer cur, ClausePointer parent,
3399 yamop *ipc, int is_lu, yamop *e_code) {
3400 if (cur.lui == NULL || ipc == FAILCODE || ipc == e_code ||
3401 ipc->opc == Yap_opcode(_expand_clauses))
3402 return cur;
3403 if (is_lu) {
3404 LogUpdIndex *lcur = cur.lui, *ncur;
3405 /* check myself */
3406 if (ipc >= lcur->ClCode && ipc < (yamop *)((CODEADDR)lcur + lcur->ClSize))
3407 return cur;
3408 /* check if I am returning back to a parent, eg
3409 switch with intermediate node */
3410 if (lcur->ParentIndex) {
3411 LogUpdIndex *pcur = lcur->ParentIndex;
3412 if (ipc >= pcur->ClCode &&
3413 ipc < (yamop *)((CODEADDR)pcur + pcur->ClSize)) {
3414 cur.lui = pcur;
3415 return cur;
3416 }
3417 }
3418 /* maybe I am a new group */
3419 ncur = ClauseCodeToLogUpdIndex(ipc);
3420 if (ncur->ParentIndex != lcur) {
3421#if DEBUG
3422 fprintf(stderr, "OOPS, bad parent in lu index\n");
3423#endif
3424 cur.lui = NULL;
3425 return cur;
3426 }
3427 cur.lui = ncur;
3428 return cur;
3429 } else {
3430 StaticIndex *scur = parent.si, *ncur;
3431 /* check myself */
3432 if (!scur)
3433 return cur;
3434 if (ipc >= scur->ClCode && ipc < (yamop *)((CODEADDR)scur + scur->ClSize))
3435 return cur;
3436 ncur = ClauseCodeToStaticIndex(ipc);
3437 if (ncur->ClPred == scur->ClPred) {
3438 cur.si = ncur;
3439 return cur;
3440 }
3441 /*
3442 if (parent.si != cur.si) {
3443 if (parent.si) {
3444 StaticIndex *pcur = parent.si;
3445 if (ipc >= pcur->ClCode && ipc < (yamop *)((CODEADDR)pcur+pcur->ClSize))
3446 return parent;
3447 }
3448 }
3449 cur.si = ncur;
3450 return cur;
3451 */
3452 cur.si = NULL;
3453 return cur;
3454 }
3455}
3456
3457static ClausePointer code_to_indexcl(yamop *ipc, int is_lu) {
3458 ClausePointer ret;
3459 if (is_lu)
3460 ret.lui = ClauseCodeToLogUpdIndex(ipc);
3461 else
3462 ret.si = ClauseCodeToStaticIndex(ipc);
3463 return ret;
3464}
3465
3466/* CALLED by expand when entering sub_arg */
3467static void increase_expand_depth(yamop *ipc, struct intermediates *cint) {
3468 yamop *ncode;
3469
3470 cint->term_depth++;
3471 if (ipc->opc == Yap_opcode(_switch_on_sub_arg_type) &&
3472 (ncode = ipc->y_u.sllll.l4)->opc == Yap_opcode(_expand_clauses)) {
3473 if (ncode->y_u.sssllp.s2 != cint->last_depth_size) {
3474 cint->last_index_new_depth = cint->term_depth;
3475 cint->last_depth_size = ncode->y_u.sssllp.s2;
3476 }
3477 }
3478}
3479
3480static void zero_expand_depth(PredEntry *ap, struct intermediates *cint) {
3481 cint->term_depth = cint->last_index_new_depth;
3482 cint->last_depth_size = ap->cs.p_code.NOfClauses;
3483}
3484
3485static yamop **expand_index(struct intermediates *cint) {
3486 CACHE_REGS
3487 /* first clause */
3488 PredEntry *ap = cint->CurrentPred;
3489 yamop *first, *last = NULL, *alt = NULL;
3490 istack_entry *stack, *sp;
3491 ClauseDef *max;
3492 int NClauses;
3493 /* last clause to experiment with */
3494 yamop *ipc;
3495 /* labp should point at the beginning of the sequence */
3496 yamop **labp = NULL;
3497 ClausePointer parentcl;
3498 Term t = TermNil, *s_reg = NULL;
3499 int is_last_arg = TRUE;
3500 int argno = 1;
3501 int isfirstcl = TRUE;
3502 /* this is will be used as a new PC */
3503 CELL *top = (CELL *)TR;
3504 UInt arity = 0;
3505 UInt lab, fail_l, clleft, i = 0;
3506 int is_lu = ap->PredFlags & LogUpdatePredFlag;
3507 yamop *e_code = (yamop *)&(ap->cs.p_code.ExpandCode);
3508
3509 ipc = ap->cs.p_code.TrueCodeOfPred;
3510 first = ap->cs.p_code.FirstClause;
3511 NClauses = ap->cs.p_code.NOfClauses;
3512 sp = stack = (istack_entry *)top;
3513 cint->i_labelno = 1;
3514 stack[0].pos = 0;
3515 /* try to refine the interval using the indexing code */
3516 cint->term_depth = cint->last_index_new_depth = cint->last_depth_size = 0L;
3517
3518 parentcl = code_to_indexcl(ipc, is_lu);
3519 while (ipc != NULL) {
3520 op_numbers op;
3521
3522 op = Yap_op_from_opcode(ipc->opc);
3523 switch (op) {
3524 case _try_clause:
3525 case _retry:
3526 /* this clause had no indexing */
3527 if (ap->PredFlags & LogUpdatePredFlag) {
3528 first = ClauseCodeToLogUpdClause(ipc->y_u.Otapl.d)->ClNext->ClCode;
3529 } else if (ap->PredFlags & MegaClausePredFlag) {
3530 MegaClause *mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
3531 first = (yamop *)((char *)ipc->y_u.Otapl.d) + mcl->ClItemSize;
3532 } else {
3533 first = ClauseCodeToStaticClause(ipc->y_u.Otapl.d)->ClNext->ClCode;
3534 }
3535 isfirstcl = FALSE;
3536 ipc = NEXTOP(ipc, Otapl);
3537 break;
3538#if TABLING
3539 case _table_try:
3540 case _table_retry:
3541 /* this clause had no indexing */
3542 first = ClauseCodeToStaticClause(PREVOP(ipc->y_u.Otapl.d, Otapl))
3543 ->ClNext->ClCode;
3544 isfirstcl = FALSE;
3545 ipc = NEXTOP(ipc, Otapl);
3546 break;
3547#endif /* TABLING */
3548 case _try_clause2:
3549 case _try_clause3:
3550 case _try_clause4:
3551 case _retry2:
3552 case _retry3:
3553 case _retry4:
3554 case _try_in:
3555 if (ap->PredFlags & LogUpdatePredFlag) {
3556 first = ClauseCodeToLogUpdClause(ipc->y_u.l.l)->ClNext->ClCode;
3557 } else if (ap->PredFlags & MegaClausePredFlag) {
3558 MegaClause *mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
3559 first = (yamop *)((char *)ipc->y_u.Otapl.d) + mcl->ClItemSize;
3560 } else {
3561 first = ClauseCodeToStaticClause(ipc->y_u.l.l)->ClNext->ClCode;
3562 }
3563 isfirstcl = FALSE;
3564 ipc = NEXTOP(ipc, l);
3565 break;
3566 case _retry_me:
3567#ifdef TABLING
3568 case _table_retry_me:
3569#endif
3570 isfirstcl = FALSE;
3571 case _try_me:
3572#ifdef TABLING
3573 case _table_try_me:
3574#endif
3575 /* ok, we found the start for an indexing block,
3576 but we don't if we are going to operate here or not */
3577 /* if we are to commit here, alt will tell us where */
3578 alt = ipc->y_u.Otapl.d;
3579 ipc = NEXTOP(ipc, Otapl);
3580 /* start of a group, reset stack */
3581 sp = stack;
3582 stack[0].pos = 0;
3583 break;
3584 case _profiled_trust_me:
3585 case _trust_me:
3586 case _count_trust_me:
3587#ifdef TABLING
3588 case _table_trust_me:
3589#endif /* TABLING */
3590 /* we will commit to this group for sure */
3591 ipc = NEXTOP(ipc, Otapl);
3592 alt = NULL;
3593 /* start of a group, reset stack */
3594 sp = stack;
3595 stack[0].pos = 0;
3596 break;
3597 case _trust:
3598 /* we should never be here */
3599 Yap_Error(SYSTEM_ERROR_COMPILER, TermNil, "found trust in expand_index");
3600 labp = NULL;
3601 ipc = NULL;
3602 break;
3603 /* should we ever be here ? I think not */
3604 case _try_logical:
3605 case _retry_logical:
3606 case _count_retry_logical:
3607 case _profiled_retry_logical:
3608 ipc = ipc->y_u.OtaLl.n;
3609 break;
3610 case _trust_logical:
3611 case _count_trust_logical:
3612 case _profiled_trust_logical:
3613 ipc = ipc->y_u.OtILl.n;
3614 break;
3615 case _enter_lu_pred:
3616 /* no useful info */
3617 ipc = ipc->y_u.Illss.l1;
3618 break;
3619 case _retry_profiled:
3620 case _count_retry:
3621 /* no useful info */
3622 ipc = NEXTOP(ipc, l);
3623 break;
3624 case _jump:
3625 /* just skip for now, but should worry about memory management */
3626 ipc = ipc->y_u.l.l;
3627 /* I don't know how up I will go */
3628 parentcl.si = NULL;
3629 break;
3630 case _lock_lu:
3631 case _procceed:
3632 ipc = NEXTOP(ipc, p);
3633 break;
3634 case _unlock_lu:
3635 ipc = NEXTOP(ipc, e);
3636 break;
3637 case _jump_if_var:
3638 if (IsVarTerm(Deref(ARG1))) {
3639 labp = &(ipc->y_u.l.l);
3640 ipc = ipc->y_u.l.l;
3641 parentcl = index_jmp(parentcl, parentcl, ipc, is_lu, e_code);
3642 } else {
3643 ipc = NEXTOP(ipc, l);
3644 }
3645 break;
3646 case _jump_if_nonvar:
3647 argno = arg_from_x(ipc->y_u.xll.x);
3648 t = Deref(XREGS[argno]);
3649 i = 0;
3650 /* expand_index expects to find the new argument */
3651 if (!IsVarTerm(t)) {
3652 argno--;
3653 labp = &(ipc->y_u.xll.l1);
3654 ipc = ipc->y_u.xll.l1;
3655 parentcl = index_jmp(parentcl, parentcl, ipc, is_lu, e_code);
3656
3657 } else {
3658 ipc = NEXTOP(ipc, xll);
3659 }
3660 break;
3661 /* instructions type EC */
3662 /* instructions type e */
3663 case _index_dbref:
3664 if (s_reg[-1] != (CELL)FunctorDBREF) {
3665 ipc = alt;
3666 alt = NULL;
3667 break;
3668 }
3669 t = AbsAppl(s_reg - 1);
3670 sp[-1].extra = t;
3671 s_reg = NULL;
3672 ipc = NEXTOP(ipc, e);
3673 break;
3674 case _index_blob:
3675 if (s_reg[-1] != (CELL)FunctorDouble) {
3676 ipc = alt;
3677 alt = NULL;
3678 break;
3679 }
3680 t = Yap_DoubleP_key(s_reg);
3681 sp[-1].extra = AbsAppl(s_reg - 1);
3682 s_reg = NULL;
3683 ipc = NEXTOP(ipc, e);
3684 break;
3685 case _index_long:
3686 if (s_reg[-1] != (CELL)FunctorLongInt) {
3687 ipc = alt;
3688 alt = NULL;
3689 break;
3690 }
3691 t = Yap_IntP_key(s_reg);
3692 sp[-1].extra = AbsAppl(s_reg - 1);
3693 s_reg = NULL;
3694 ipc = NEXTOP(ipc, e);
3695 break;
3696 case _user_switch:
3697 labp = &(ipc->y_u.lp.l);
3698 ipc = ipc->y_u.lp.l;
3699 break;
3700 /* instructions type e */
3701 case _switch_on_type:
3702 zero_expand_depth(ap, cint);
3703 t = Deref(ARG1);
3704 argno = 1;
3705 i = 0;
3706 if (IsVarTerm(t)) {
3707 labp = &(ipc->y_u.llll.l4);
3708 ipc = ipc->y_u.llll.l4;
3709 } else if (IsPairTerm(t)) {
3710 sp = push_stack(sp, 1, AbsPair(NULL), TermNil, cint);
3711 s_reg = RepPair(t);
3712 labp = &(ipc->y_u.llll.l1);
3713 ipc = ipc->y_u.llll.l1;
3714 increase_expand_depth(ipc, cint);
3715 } else if (IsApplTerm(t)) {
3716 sp =
3717 push_stack(sp, 1, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil, cint);
3718 ipc = ipc->y_u.llll.l3;
3719 increase_expand_depth(ipc, cint);
3720 } else {
3721 sp = push_stack(sp, argno, t, TermNil, cint);
3722 ipc = ipc->y_u.llll.l2;
3723 }
3724 parentcl = index_jmp(parentcl, parentcl, ipc, is_lu, e_code);
3725 break;
3726 case _switch_list_nl:
3727 zero_expand_depth(ap, cint);
3728 t = Deref(ARG1);
3729 argno = 1;
3730 i = 0;
3731 if (IsVarTerm(t)) {
3732 labp = &(ipc->y_u.ollll.l4);
3733 ipc = ipc->y_u.ollll.l4;
3734 } else if (IsPairTerm(t)) {
3735 s_reg = RepPair(t);
3736 labp = &(ipc->y_u.ollll.l1);
3737 sp = push_stack(sp, 1, AbsPair(NULL), TermNil, cint);
3738 ipc = ipc->y_u.ollll.l1;
3739 increase_expand_depth(ipc, cint);
3740 } else if (t == TermNil) {
3741 sp = push_stack(sp, 1, t, TermNil, cint);
3742 ipc = ipc->y_u.ollll.l2;
3743 increase_expand_depth(ipc, cint);
3744 } else {
3745 Term tn;
3746
3747 if (IsApplTerm(t)) {
3748 tn = AbsAppl((CELL *)FunctorOfTerm(t));
3749 } else {
3750 tn = t;
3751 }
3752 sp = push_stack(sp, argno, tn, TermNil, cint);
3753 ipc = ipc->y_u.ollll.l3;
3754 }
3755 parentcl = index_jmp(parentcl, parentcl, ipc, is_lu, e_code);
3756 break;
3757 case _switch_on_arg_type:
3758 zero_expand_depth(ap, cint);
3759 argno = arg_from_x(ipc->y_u.xllll.x);
3760 i = 0;
3761 t = Deref(XREGS[argno]);
3762 if (IsVarTerm(t)) {
3763 labp = &(ipc->y_u.xllll.l4);
3764 ipc = ipc->y_u.xllll.l4;
3765 } else if (IsPairTerm(t)) {
3766 s_reg = RepPair(t);
3767 sp = push_stack(sp, argno, AbsPair(NULL), TermNil, cint);
3768 labp = &(ipc->y_u.xllll.l1);
3769 ipc = ipc->y_u.xllll.l1;
3770 increase_expand_depth(ipc, cint);
3771 } else if (IsApplTerm(t)) {
3772 sp = push_stack(sp, argno, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil,
3773 cint);
3774 ipc = ipc->y_u.xllll.l3;
3775 increase_expand_depth(ipc, cint);
3776 } else {
3777 sp = push_stack(sp, argno, t, TermNil, cint);
3778 ipc = ipc->y_u.xllll.l2;
3779 }
3780 parentcl = index_jmp(parentcl, parentcl, ipc, is_lu, e_code);
3781 break;
3782 case _switch_on_sub_arg_type:
3783 i = ipc->y_u.sllll.s;
3784 t = Deref(s_reg[i]);
3785 if (i != arity - 1)
3786 is_last_arg = FALSE;
3787 t = Deref(s_reg[i]);
3788 if (IsVarTerm(t)) {
3789 labp = &(ipc->y_u.sllll.l4);
3790 ipc = ipc->y_u.sllll.l4;
3791 i++;
3792 } else if (IsPairTerm(t)) {
3793 s_reg = RepPair(t);
3794 sp = push_stack(sp, -i - 1, AbsPair(NULL), TermNil, cint);
3795 labp = &(ipc->y_u.sllll.l1);
3796 ipc = ipc->y_u.sllll.l1;
3797 i = 0;
3798 increase_expand_depth(ipc, cint);
3799 } else if (IsApplTerm(t)) {
3800 sp = push_stack(sp, -i - 1, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil,
3801 cint);
3802 ipc = ipc->y_u.sllll.l3;
3803 i = 0;
3804 increase_expand_depth(ipc, cint);
3805 } else {
3806 /* We don't push stack here, instead we go over to next argument
3807 sp = push_stack(sp, -i-1, t, cint);
3808 */
3809 sp = push_stack(sp, -i - 1, t, TermNil, cint);
3810 ipc = ipc->y_u.sllll.l2;
3811 i++;
3812 }
3813 parentcl = index_jmp(parentcl, parentcl, ipc, is_lu, e_code);
3814 break;
3815 case _if_not_then:
3816 labp = NULL;
3817 ipc = NULL;
3818 break;
3819 /* instructions type ollll */
3820 case _switch_on_func:
3821 case _if_func:
3822 case _go_on_func: {
3823 FuncSwiEntry *fe;
3824 yamop *newpc;
3825 Functor f;
3826
3827 s_reg = RepAppl(t);
3828 f = (Functor)(*s_reg++);
3829 if (op == _switch_on_func) {
3830 fe = lookup_f_hash(f, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
3831 } else {
3832 fe = lookup_f(f, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
3833 }
3834 newpc = fe->u_f.labp;
3835
3836 labp = &(fe->u_f.labp);
3837 if (newpc == e_code) {
3838 /* we found it */
3839 parentcl = code_to_indexcl(ipc->y_u.sssl.l, is_lu);
3840 ipc = NULL;
3841 } else {
3842 ClausePointer npar = code_to_indexcl(ipc->y_u.sssl.l, is_lu);
3843 ipc = newpc;
3844 parentcl = index_jmp(npar, parentcl, ipc, is_lu, e_code);
3845 }
3846 } break;
3847 case _switch_on_cons:
3848 case _if_cons:
3849 case _go_on_cons: {
3850 AtomSwiEntry *ae;
3851
3852 if (op == _switch_on_cons) {
3853 ae = lookup_c_hash(t, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
3854 } else {
3855 ae = lookup_c(t, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
3856 }
3857
3858 labp = &(ae->u_a.labp);
3859 if (ae->u_a.labp == e_code) {
3860 /* we found it */
3861 parentcl = code_to_indexcl(ipc->y_u.sssl.l, is_lu);
3862 ipc = NULL;
3863 } else {
3864 ClausePointer npar = code_to_indexcl(ipc->y_u.sssl.l, is_lu);
3865 ipc = ae->u_a.labp;
3866 parentcl = index_jmp(npar, parentcl, ipc, is_lu, e_code);
3867 }
3868 } break;
3869 case _expand_index:
3870 case _expand_clauses:
3871 if (alt != NULL && ap->PredFlags & LogUpdatePredFlag) {
3872 op_numbers fop = Yap_op_from_opcode(alt->opc);
3873 if (fop == _enter_lu_pred)
3874 alt = alt->y_u.Illss.l1;
3875 }
3876 ipc = NULL;
3877 break;
3878 case _op_fail:
3879 ipc = alt;
3880 alt = NULL;
3881 break;
3882 default:
3883 if (alt == NULL) {
3884 Yap_Error(SYSTEM_ERROR_COMPILER, t,
3885 "unexpected instruction %d at expand_index ", op);
3886 labp = NULL;
3887 ipc = NULL;
3888 } else {
3889 /* backtrack */
3890 first = alt->y_u.Otapl.d;
3891 ipc = alt;
3892 alt = NULL;
3893 }
3894 }
3895 }
3896
3897 /* if there was an overflow while generating the code, make sure
3898 S is still correct */
3899 if (is_lu) {
3900 cint->current_cl.lui = parentcl.lui;
3901 } else {
3902 cint->current_cl.si = parentcl.si;
3903 }
3904 if (s_reg != NULL)
3905 S = s_reg;
3906#ifdef TABLING
3907 /* handle tabling hack that insertes a failcode,
3908 this really corresponds to not having any more clauses */
3909 if (alt == TRUSTFAILCODE)
3910 alt = NULL;
3911#endif
3912 if (alt == NULL) {
3913 /* oops, we are at last clause */
3914 fail_l = (UInt)FAILCODE;
3915 clleft = 0;
3916 last = ap->cs.p_code.LastClause;
3917 } else {
3918 if (ap->PredFlags & LogUpdatePredFlag) {
3919 op_numbers op = Yap_op_from_opcode(alt->opc);
3920 /* can we be here */
3921 if (op >= _retry2 && op <= _retry4) {
3922 last = alt->y_u.l.l;
3923 } else {
3924 last = alt->y_u.Otapl.d;
3925 }
3926 } else {
3927 op_numbers op = Yap_op_from_opcode(alt->opc);
3928 if (op == _retry || op == _trust) {
3929 last = alt->y_u.Otapl.d;
3930#ifdef TABLING
3931 } else if (op == _table_retry || op == _table_trust) {
3932 last = PREVOP(alt->y_u.Otapl.d, Otapl);
3933#endif /* TABLING */
3934 } else if (op >= _retry2 && op <= _retry4) {
3935 last = alt->y_u.l.l;
3936 }
3937 }
3938 fail_l = (UInt)alt;
3939 clleft = count_clauses_left(last, ap);
3940 }
3941
3942 if (Yap_op_from_opcode((*labp)->opc) == _expand_clauses) {
3943 /* ok, we know how many clauses */
3944 yamop *ipc = *labp;
3945 /* check all slots, not just the ones with values */
3946 COUNT nclauses = ipc->y_u.sssllp.s1;
3947 yamop **clp = (yamop **)NEXTOP(ipc, sssllp);
3948
3949 cint->expand_block = ipc;
3950#if USE_SYSTEM_MALLOC
3951 if (!cint->cls) {
3952 cint->cls = (ClauseDef *)Yap_AllocCodeSpace(nclauses * sizeof(ClauseDef));
3953 if (!cint->cls) {
3954 /* tell how much space we need */
3955 LOCAL_Error_Size += NClauses * sizeof(ClauseDef);
3956 /* grow stack */
3957 save_machine_regs();
3958 siglongjmp(cint->CompilerBotch, 2);
3959 }
3960 }
3961#else
3962 cint->cls = (ClauseDef *)HR;
3963 if (cint->cls + 2 * nclauses > (ClauseDef *)(ASP - 4096)) {
3964 /* tell how much space we need (worst case) */
3965 LOCAL_Error_Size += 2 * NClauses * sizeof(ClauseDef);
3966 /* grow stack */
3967 save_machine_regs();
3968 siglongjmp(cint->CompilerBotch, 3);
3969 }
3970#endif
3971 if (ap->PredFlags & LogUpdatePredFlag) {
3972 max =
3973 install_log_upd_clauseseq(cint->cls, ap, stack, clp, clp + nclauses);
3974 } else {
3975 max = install_clauseseq(cint->cls, ap, stack, clp, clp + nclauses);
3976 }
3977 } else {
3978 cint->expand_block = NULL;
3979#if USE_SYSTEM_MALLOC
3980 if (!cint->cls) {
3981 cint->cls = (ClauseDef *)Yap_AllocCodeSpace(NClauses * sizeof(ClauseDef));
3982 if (!cint->cls) {
3983 /* tell how much space we need */
3984 LOCAL_Error_Size += NClauses * sizeof(ClauseDef);
3985 /* grow stack */
3986 save_machine_regs();
3987 siglongjmp(cint->CompilerBotch, 2);
3988 }
3989 }
3990#else
3991 cint->cls = (ClauseDef *)HR;
3992 if (cint->cls + 2 * NClauses > (ClauseDef *)(ASP - 4096)) {
3993 /* tell how much space we need (worst case) */
3994 LOCAL_Error_Size += 2 * NClauses * sizeof(ClauseDef);
3995 save_machine_regs();
3996 siglongjmp(cint->CompilerBotch, 3);
3997 }
3998#endif
3999 if (ap->PredFlags & LogUpdatePredFlag) {
4000 max = install_log_upd_clauses(cint->cls, ap, stack, first, last);
4001 } else {
4002 max = install_clauses(cint->cls, ap, stack, first, last);
4003 }
4004#if DEBUG_EXPAND
4005 if (ap->PredFlags & LogUpdatePredFlag) {
4006 fprintf(stderr, "vsc +");
4007 } else {
4008 fprintf(stderr, "vsc ");
4009 }
4010 fprintf(stderr, " : expanding %d out of %d\n", (max - cls) + 1, NClauses);
4011#endif
4012 }
4013 /* don't count last clause if you don't have to */
4014 if (alt && max->Code == last)
4015 max--;
4016 if (max < cint->cls && labp != NULL) {
4017 *labp = FAILCODE;
4018 return labp;
4019 }
4020#if USE_SYSTEM_MALLOC
4021 cint->freep = (char *)HR;
4022#else
4023 cint->freep = (char *)(max + 1);
4024#endif
4025 cint->CodeStart = cint->BlobsStart = cint->cpc = cint->icpc = NULL;
4026
4027 if (!IsVarTerm(sp[-1].val) && sp > stack) {
4028 if (IsAtomOrIntTerm(sp[-1].val)) {
4029 if (s_reg == NULL) { /* we have not yet looked into terms */
4030 lab = do_index(cint->cls, max, cint, argno + 1, fail_l, isfirstcl,
4031 clleft, top);
4032 } else {
4033 UInt arity = 0;
4034
4035 if (ap->PredFlags & LogUpdatePredFlag) {
4036 reinstall_log_upd_clauses(cint->cls, max, ap, stack);
4037 } else {
4038 reinstall_clauses(cint->cls, max, ap, stack);
4039 }
4040 sp--;
4041 while (sp > stack) {
4042 Term t = sp[-1].val;
4043 if (IsApplTerm(t)) {
4044 Functor f = (Functor)RepAppl(t);
4045 if (!IsExtensionFunctor(f)) {
4046 arity = ArityOfFunctor(f);
4047 break;
4048 } else {
4049 sp--;
4050 }
4051 } else if (IsPairTerm(t)) {
4052 arity = 2;
4053 break;
4054 } else {
4055 sp--;
4056 }
4057 }
4058 lab = do_compound_index(cint->cls, max, s_reg, cint, i, arity, argno,
4059 fail_l, isfirstcl, is_last_arg, clleft, top,
4060 FALSE);
4061 }
4062 } else if (IsPairTerm(sp[-1].val) && sp > stack) {
4063 lab = do_compound_index(cint->cls, max, s_reg, cint, i, 2, argno, fail_l,
4064 isfirstcl, is_last_arg, clleft, top, FALSE);
4065 } else {
4066 Functor f = (Functor)RepAppl(sp[-1].val);
4067 /* we are continuing within a compound term */
4068 if (IsExtensionFunctor(f)) {
4069 lab = do_index(cint->cls, max, cint, argno + 1, fail_l, isfirstcl,
4070 clleft, top);
4071 } else {
4072 lab = do_compound_index(cint->cls, max, s_reg, cint, i,
4073 ArityOfFunctor(f), argno, fail_l, isfirstcl,
4074 is_last_arg, clleft, top, FALSE);
4075 }
4076 }
4077 } else {
4078 if (argno == ap->ArityOfPE) {
4079 lab = do_var_clauses(cint->cls, max, FALSE, cint, isfirstcl, clleft,
4080 fail_l, ap->ArityOfPE + 1);
4081 } else {
4082 lab = do_index(cint->cls, max, cint, argno + 1, fail_l, isfirstcl, clleft,
4083 top);
4084 }
4085 }
4086 if (labp && !(lab & 1)) {
4087 *labp = (yamop *)lab; /* in case we have a single clause */
4088 }
4089 return labp;
4090}
4091
4092static yamop *ExpandIndex(PredEntry *ap, int ExtraArgs,
4093 yamop *nextop USES_REGS) {
4094 yamop *indx_out, *expand_clauses;
4095 yamop **labp;
4096 int cb;
4097 struct intermediates cint;
4098
4099 cint.blks = NULL;
4100 cint.cls = NULL;
4101 cint.code_addr = NULL;
4102 cint.label_offset = NULL;
4103 if ((cb = sigsetjmp(cint.CompilerBotch, 0)) == 3) {
4104 CACHE_REGS
4105 restore_machine_regs();
4106 /* grow stack */
4107 recover_from_failed_susp_on_cls(&cint, 0);
4108 Yap_dogc(PASS_REGS1);
4109 } else if (cb == 2) {
4110 restore_machine_regs();
4111 LOCAL_Error_Size = recover_from_failed_susp_on_cls(&cint, LOCAL_Error_Size);
4112 if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
4113 save_machine_regs();
4114 if (ap->PredFlags & LogUpdatePredFlag) {
4115 Yap_kill_iblock((ClauseUnion *)ClauseCodeToLogUpdIndex(
4116 ap->cs.p_code.TrueCodeOfPred),
4117 NULL, ap);
4118 } else {
4119 StaticIndex *cl;
4120
4121 cl = ClauseCodeToStaticIndex(ap->cs.p_code.TrueCodeOfPred);
4122 Yap_kill_iblock((ClauseUnion *)cl, NULL, ap);
4123 }
4124#if defined(YAPOR) || defined(THREADS)
4125 if (ap->PredFlags & LogUpdatePredFlag &&
4126 !(ap->PredFlags & ThreadLocalPredFlag) &&
4127 ap->ModuleOfPred != IDB_MODULE) {
4128 ap->OpcodeOfPred = LOCKPRED_OPCODE;
4129 ap->cs.p_code.TrueCodeOfPred = ap->CodeOfPred =
4130 (yamop *)(&(ap->OpcodeOfPred));
4131 } else {
4132#endif
4133 ap->OpcodeOfPred = INDEX_OPCODE;
4134 ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred =
4135 (yamop *)(&(ap->OpcodeOfPred));
4136#if defined(YAPOR) || defined(THREADS)
4137 }
4138#endif
4139 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
4140 CleanCls(&cint);
4141 return FAILCODE;
4142 }
4143 } else if (cb == 4) {
4144 restore_machine_regs();
4145 Yap_ReleaseCMem(&cint);
4146 if (!Yap_growtrail(LOCAL_Error_Size, FALSE)) {
4147 save_machine_regs();
4148 if (ap->PredFlags & LogUpdatePredFlag) {
4149 Yap_kill_iblock((ClauseUnion *)ClauseCodeToLogUpdIndex(
4150 ap->cs.p_code.TrueCodeOfPred),
4151 NULL, ap);
4152 } else {
4153 StaticIndex *cl;
4154
4155 cl = ClauseCodeToStaticIndex(ap->cs.p_code.TrueCodeOfPred);
4156 Yap_kill_iblock((ClauseUnion *)cl, NULL, ap);
4157 }
4158 CleanCls(&cint);
4159 return FAILCODE;
4160 }
4161 }
4162 restart_index:
4163 cint.CodeStart = cint.cpc = cint.BlobsStart = cint.icpc = NIL;
4164 cint.CurrentPred = ap;
4165 LOCAL_Error_TYPE = YAP_NO_ERROR;
4166 LOCAL_Error_Size = 0;
4167 if (P->opc == Yap_opcode(_expand_clauses)) {
4168 expand_clauses = P;
4169 } else {
4170 expand_clauses = NULL;
4171 }
4172#if DEBUG
4173 if (GLOBAL_Option['i' - 'a' + 1]) {
4174 Yap_DebugWriteIndicator(ap);
4175 }
4176#endif
4177 if ((labp = expand_index(&cint)) == NULL) {
4178 if (expand_clauses) {
4179 P = FAILCODE;
4180 recover_ecls_block(expand_clauses);
4181 }
4182 Yap_ReleaseCMem(&cint);
4183 CleanCls(&cint);
4184 return FAILCODE;
4185 }
4186 if (*labp == FAILCODE) {
4187 if (expand_clauses) {
4188 P = FAILCODE;
4189 recover_ecls_block(expand_clauses);
4190 }
4191 Yap_ReleaseCMem(&cint);
4192 CleanCls(&cint);
4193 return FAILCODE;
4194 }
4195#if DEBUG
4196 if (GLOBAL_Option['i' - 'a' + 1]) {
4197 Yap_ShowCode(&cint);
4198 }
4199#endif
4200 /* globals for assembler */
4201 LOCAL_IPredArity = ap->ArityOfPE;
4202 if (cint.CodeStart) {
4203 if ((indx_out = Yap_assemble(ASSEMBLING_EINDEX, TermNil, ap, FALSE, &cint,
4204 cint.i_labelno + 1)) == NULL) {
4205 if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
4206 Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
4207 Yap_ReleaseCMem(&cint);
4208 CleanCls(&cint);
4209 return FAILCODE;
4210 }
4211 goto restart_index;
4212 }
4213 } else {
4214 /* single case */
4215 if (expand_clauses) {
4216 P = *labp;
4217 recover_ecls_block(expand_clauses);
4218 }
4219 Yap_ReleaseCMem(&cint);
4220 CleanCls(&cint);
4221 return *labp;
4222 }
4223 if (indx_out == NULL) {
4224 if (expand_clauses) {
4225 P = FAILCODE;
4226 recover_ecls_block(expand_clauses);
4227 }
4228 Yap_ReleaseCMem(&cint);
4229 CleanCls(&cint);
4230 return FAILCODE;
4231 }
4232 Yap_ReleaseCMem(&cint);
4233 CleanCls(&cint);
4234 *labp = indx_out;
4235 if (ap->PredFlags & LogUpdatePredFlag) {
4236 /* add to head of current code children */
4237 LogUpdIndex *ic = cint.current_cl.lui,
4238 *nic = ClauseCodeToLogUpdIndex(indx_out);
4239 if (ic == NULL)
4240 ic = (LogUpdIndex *)Yap_find_owner_index((yamop *)labp, ap);
4241 /* insert myself in the indexing code chain */
4242 nic->SiblingIndex = ic->ChildIndex;
4243 nic->PrevSiblingIndex = NULL;
4244 if (ic->ChildIndex) {
4245 ic->ChildIndex->PrevSiblingIndex = nic;
4246 }
4247 nic->ParentIndex = ic;
4248 nic->ClFlags &= ~SwitchRootMask;
4249 ic->ChildIndex = nic;
4250 ic->ClRefCount++;
4251 } else {
4252 /* add to head of current code children */
4253 StaticIndex *ic = cint.current_cl.si,
4254 *nic = ClauseCodeToStaticIndex(indx_out);
4255 if (ic == NULL)
4256 ic = (StaticIndex *)Yap_find_owner_index((yamop *)labp, ap);
4257 /* insert myself in the indexing code chain */
4258 nic->SiblingIndex = ic->ChildIndex;
4259 ic->ChildIndex = nic;
4260 }
4261 if (expand_clauses) {
4262 P = indx_out;
4263 recover_ecls_block(expand_clauses);
4264 }
4265 return indx_out;
4266}
4267
4268yamop *Yap_ExpandIndex(PredEntry *ap, UInt nargs) {
4269 CACHE_REGS
4270 return ExpandIndex(ap, nargs, CP PASS_REGS);
4271}
4272
4273static path_stack_entry *push_path(path_stack_entry *sp, yamop **pipc,
4274 ClauseDef *clp, struct intermediates *cint) {
4275 CACHE_REGS
4276 if (sp + 1 > (path_stack_entry *)LOCAL_TrailTop) {
4277 save_machine_regs();
4278 siglongjmp(cint->CompilerBotch, 4);
4279 }
4280 sp->flag = pc_entry;
4281 sp->uip.pce.pi_pc = pipc;
4282 sp->uip.pce.code = clp->Code;
4283 sp->uip.pce.current_code = clp->CurrentCode;
4284 sp->uip.pce.work_pc = clp->ucd.WorkPC;
4285 sp->uip.pce.tag = clp->Tag;
4286 return sp + 1;
4287}
4288
4289static path_stack_entry *fetch_new_block(path_stack_entry *sp, yamop **pipc,
4290 PredEntry *ap,
4291 struct intermediates *cint) {
4292 CACHE_REGS
4293 if (sp + 1 > (path_stack_entry *)LOCAL_TrailTop) {
4294 save_machine_regs();
4295 siglongjmp(cint->CompilerBotch, 4);
4296 }
4297 /* add current position */
4298 sp->flag = block_entry;
4299 sp->uip.cle.entry_code = pipc;
4300 if (ap->PredFlags & LogUpdatePredFlag) {
4301 sp->uip.cle.block = (ClauseUnion *)ClauseCodeToLogUpdIndex(*pipc);
4302 } else {
4303 sp->uip.cle.block = (ClauseUnion *)ClauseCodeToStaticIndex(*pipc);
4304 }
4305 return sp + 1;
4306}
4307
4308static path_stack_entry *init_block_stack(path_stack_entry *sp, yamop *ipc,
4309 PredEntry *ap) {
4310 /* add current position */
4311
4312 sp->flag = block_entry;
4313 sp->uip.cle.entry_code = NULL;
4314 if (ap->PredFlags & LogUpdatePredFlag) {
4315 sp->uip.cle.block = (ClauseUnion *)ClauseCodeToLogUpdIndex(ipc);
4316 } else {
4317 sp->uip.cle.block = (ClauseUnion *)ClauseCodeToStaticIndex(ipc);
4318 }
4319 return sp + 1;
4320}
4321
4322static path_stack_entry *cross_block(path_stack_entry *sp, yamop **pipc,
4323 PredEntry *ap,
4324 struct intermediates *cint) {
4325 yamop *ipc = *pipc;
4326 path_stack_entry *tsp = sp;
4327 ClauseUnion *block;
4328
4329 do {
4330 UInt bsize;
4331 while ((--tsp)->flag != block_entry)
4332 ;
4333 block = tsp->uip.cle.block;
4334 if (block->lui.ClFlags & LogUpdMask)
4335 bsize = block->lui.ClSize;
4336 else
4337 bsize = block->si.ClSize;
4338 if (ipc > (yamop *)block && ipc < (yamop *)((CODEADDR)block + bsize)) {
4339 path_stack_entry *nsp = tsp + 1;
4340 for (; tsp < sp; tsp++) {
4341 if (tsp->flag == pc_entry) {
4342 if (nsp != tsp) {
4343 nsp->flag = pc_entry;
4344 nsp->uip.pce.pi_pc = tsp->uip.pce.pi_pc;
4345 nsp->uip.pce.code = tsp->uip.pce.code;
4346 nsp->uip.pce.current_code = tsp->uip.pce.current_code;
4347 nsp->uip.pce.work_pc = tsp->uip.pce.work_pc;
4348 nsp->uip.pce.tag = tsp->uip.pce.tag;
4349 }
4350 nsp++;
4351 }
4352 }
4353 return nsp;
4354 }
4355 } while (tsp->uip.cle.entry_code != NULL);
4356 /* moved to a new block */
4357 return fetch_new_block(sp, pipc, ap, cint);
4358}
4359
4360static yamop *pop_path(path_stack_entry **spp, ClauseDef *clp, PredEntry *ap,
4361 struct intermediates *cint) {
4362 path_stack_entry *sp = *spp;
4363 yamop *nipc;
4364
4365 while ((--sp)->flag != pc_entry)
4366 ;
4367 *spp = sp;
4368 clp->Code = sp->uip.pce.code;
4369 clp->CurrentCode = sp->uip.pce.current_code;
4370 clp->ucd.WorkPC = sp->uip.pce.work_pc;
4371 clp->Tag = sp->uip.pce.tag;
4372 if (sp->uip.pce.pi_pc == NULL) {
4373 *spp = sp;
4374 return NULL;
4375 }
4376 nipc = *(sp->uip.pce.pi_pc);
4377 *spp = cross_block(sp, sp->uip.pce.pi_pc, ap, cint);
4378 return nipc;
4379}
4380
4381static int table_fe_overflow(yamop *pc, Functor f) {
4382 if (pc->y_u.sssl.s <= MIN_HASH_ENTRIES) {
4383 /* we cannot expand otherwise */
4384 COUNT i;
4385 FuncSwiEntry *csw = (FuncSwiEntry *)pc->y_u.sssl.l;
4386
4387 for (i = 0; i < pc->y_u.sssl.s; i++, csw++) {
4388 if (csw->Tag == f)
4389 return FALSE;
4390 }
4391 return TRUE;
4392 } else {
4393 COUNT free = pc->y_u.sssl.s - pc->y_u.sssl.e;
4394 return (!free || pc->y_u.sssl.s / free > 4);
4395 }
4396}
4397
4398static int table_ae_overflow(yamop *pc, Term at) {
4399 if (pc->y_u.sssl.s <= MIN_HASH_ENTRIES) {
4400 /* check if we are already there */
4401 COUNT i;
4402 AtomSwiEntry *csw = (AtomSwiEntry *)pc->y_u.sssl.l;
4403
4404 for (i = 0; i < pc->y_u.sssl.s; i++, csw++) {
4405 if (csw->Tag == at)
4406 return FALSE;
4407 }
4408 return TRUE;
4409 } else {
4410 COUNT free = pc->y_u.sssl.s - pc->y_u.sssl.e;
4411 return (!free || pc->y_u.sssl.s / free > 4);
4412 }
4413}
4414
4415static void replace_index_block(ClauseUnion *parent_block, yamop *cod,
4416 yamop *ncod, PredEntry *ap) {
4417 if (ap->PredFlags & LogUpdatePredFlag) {
4418 LogUpdIndex *cl = ClauseCodeToLogUpdIndex(cod),
4419 *ncl = ClauseCodeToLogUpdIndex(ncod),
4420 *c = parent_block->lui.ChildIndex;
4421 ncl->SiblingIndex = cl->SiblingIndex;
4422 ncl->PrevSiblingIndex = cl->PrevSiblingIndex;
4423 ncl->ClRefCount = cl->ClRefCount;
4424 ncl->ChildIndex = cl->ChildIndex;
4425 ncl->ParentIndex = cl->ParentIndex;
4426 ncl->ClPred = cl->ClPred;
4427 // INIT_LOCK(ncl->ClLock);
4428 if (c == cl) {
4429 parent_block->lui.ChildIndex = ncl;
4430 } else {
4431 if (cl->PrevSiblingIndex)
4432 cl->PrevSiblingIndex->SiblingIndex = ncl;
4433 }
4434 if (cl->SiblingIndex) {
4435 cl->SiblingIndex->PrevSiblingIndex = ncl;
4436 }
4437 c = cl->ChildIndex;
4438 while (c != NULL) {
4439 c->ParentIndex = ncl;
4440 c = c->SiblingIndex;
4441 }
4442 Yap_InformOfRemoval(cl);
4443 Yap_LUIndexSpace_SW -= cl->ClSize;
4444 Yap_FreeCodeSpace((char *)cl);
4445 } else {
4446 StaticIndex *cl = ClauseCodeToStaticIndex(cod),
4447 *ncl = ClauseCodeToStaticIndex(ncod),
4448 *c = parent_block->si.ChildIndex;
4449 ncl->SiblingIndex = cl->SiblingIndex;
4450 ncl->ClPred = cl->ClPred;
4451 if (c == cl) {
4452 parent_block->si.ChildIndex = ncl;
4453 } else {
4454 while (c->SiblingIndex != cl) {
4455 c = c->SiblingIndex;
4456 }
4457 c->SiblingIndex = ncl;
4458 }
4459 Yap_InformOfRemoval(cl);
4460 Yap_IndexSpace_SW -= cl->ClSize;
4461 Yap_FreeCodeSpace((char *)cl);
4462 }
4463}
4464
4465static AtomSwiEntry *expand_ctable(yamop *pc, ClauseUnion *blk,
4466 struct intermediates *cint, Term at) {
4467 PredEntry *ap = cint->CurrentPred;
4468 int n = pc->y_u.sssl.s, i, i0 = n;
4469 UInt fail_l = Zero;
4470 AtomSwiEntry *old_ae = (AtomSwiEntry *)(pc->y_u.sssl.l), *target;
4471
4472 if (n > MIN_HASH_ENTRIES) {
4473 AtomSwiEntry *tmp = old_ae;
4474 int i;
4475
4476 n = 1;
4477 for (i = 0; i < pc->y_u.sssl.s; i++, tmp++) {
4478 if (tmp->Tag != Zero)
4479 n++;
4480 else
4481 fail_l = tmp->u_a.Label;
4482 }
4483 } else {
4484 fail_l = old_ae[n].u_a.Label;
4485 n++;
4486 }
4487 if (n > MIN_HASH_ENTRIES) {
4488 int cases = MIN_HASH_ENTRIES, i, n0;
4489 n0 = n + 1 + n / 4;
4490 while (cases < n0)
4491 cases *= 2;
4492 if (cases == pc->y_u.sssl.s) {
4493 return fetch_centry(old_ae, at, n - 1, n);
4494 }
4495 /* initialize */
4496 target =
4497 (AtomSwiEntry *)emit_switch_space(cases, sizeof(AtomSwiEntry), cint, 0);
4498 pc->opc = Yap_opcode(_switch_on_cons);
4499 pc->y_u.sssl.s = cases;
4500 for (i = 0; i < cases; i++) {
4501 target[i].Tag = Zero;
4502 target[i].u_a.Label = fail_l;
4503 }
4504 } else {
4505 pc->opc = Yap_opcode(_if_cons);
4506 pc->y_u.sssl.s = n;
4507 target =
4508 (AtomSwiEntry *)emit_switch_space(n + 1, sizeof(AtomSwiEntry), cint, 0);
4509 target[n].Tag = Zero;
4510 target[n].u_a.Label = fail_l;
4511 }
4512 for (i = 0; i < i0; i++, old_ae++) {
4513 Term tag = old_ae->Tag;
4514
4515 if (tag != Zero) {
4516 AtomSwiEntry *ics = fetch_centry(target, tag, i, n);
4517 ics->Tag = tag;
4518 ics->u_a.Label = old_ae->u_a.Label;
4519 }
4520 }
4521 /* support for threads */
4522 if (blk)
4523 replace_index_block(blk, pc->y_u.sssl.l, (yamop *)target, ap);
4524 pc->y_u.sssl.l = (yamop *)target;
4525 return fetch_centry(target, at, n - 1, n);
4526}
4527
4528static FuncSwiEntry *expand_ftable(yamop *pc, ClauseUnion *blk,
4529 struct intermediates *cint, Functor f) {
4530 PredEntry *ap = cint->CurrentPred;
4531 int n = pc->y_u.sssl.s, i, i0 = n;
4532 UInt fail_l = Zero;
4533 FuncSwiEntry *old_fe = (FuncSwiEntry *)(pc->y_u.sssl.l), *target;
4534
4535 if (n > MIN_HASH_ENTRIES) {
4536 FuncSwiEntry *tmp = old_fe;
4537 int i;
4538
4539 n = 1;
4540 for (i = 0; i < pc->y_u.sssl.s; i++, tmp++) {
4541 if (tmp->Tag != Zero)
4542 n++;
4543 else
4544 fail_l = tmp->u_f.Label;
4545 }
4546 } else {
4547 fail_l = old_fe[n].u_f.Label;
4548 n++;
4549 }
4550 if (n > MIN_HASH_ENTRIES) {
4551 int cases = MIN_HASH_ENTRIES, i, n0;
4552 n0 = n + 1 + n / 4;
4553 while (cases < n0)
4554 cases *= 2;
4555
4556 if (cases == pc->y_u.sssl.s) {
4557 return fetch_fentry(old_fe, f, n - 1, n);
4558 }
4559 pc->opc = Yap_opcode(_switch_on_func);
4560 pc->y_u.sssl.s = cases;
4561 pc->y_u.sssl.e = n;
4562 pc->y_u.sssl.w = 0;
4563 /* initialize */
4564 target = (FuncSwiEntry *)emit_switch_space(cases, sizeof(FuncSwiEntry),
4565 cint, FuncSwitchMask);
4566 for (i = 0; i < cases; i++) {
4567 target[i].Tag = NULL;
4568 target[i].u_f.Label = fail_l;
4569 }
4570 } else {
4571 pc->opc = Yap_opcode(_if_func);
4572 pc->y_u.sssl.s = n;
4573 pc->y_u.sssl.e = n;
4574 pc->y_u.sssl.w = 0;
4575 target = (FuncSwiEntry *)emit_switch_space(n + 1, sizeof(FuncSwiEntry),
4576 cint, FuncSwitchMask);
4577 target[n].Tag = Zero;
4578 target[n].u_f.Label = fail_l;
4579 }
4580 for (i = 0; i < i0; i++, old_fe++) {
4581 Functor f = old_fe->Tag;
4582
4583 if (f != NULL) {
4584 FuncSwiEntry *ifs = fetch_fentry(target, f, i, n);
4585 ifs->Tag = old_fe->Tag;
4586 ifs->u_f.Label = old_fe->u_f.Label;
4587 }
4588 }
4589 replace_index_block(blk, pc->y_u.sssl.l, (yamop *)target, ap);
4590 pc->y_u.sssl.l = (yamop *)target;
4591 return fetch_fentry(target, f, n - 1, n);
4592}
4593
4594static void clean_ref_to_clause(LogUpdClause *tgl) {
4595 tgl->ClRefCount--;
4596 if ((tgl->ClFlags & ErasedMask) && !(tgl->ClRefCount) &&
4597 !(tgl->ClFlags & InUseMask)) {
4598 /* last ref to the clause */
4599 Yap_ErLogUpdCl(tgl);
4600 }
4601}
4602
4603static ClauseUnion *current_block(path_stack_entry *sp) {
4604 while ((--sp)->flag != block_entry)
4605 ;
4606 return sp->uip.cle.block;
4607}
4608
4609static path_stack_entry *kill_block(path_stack_entry *sp, PredEntry *ap) {
4610 while ((--sp)->flag != block_entry)
4611 ;
4612 if (sp->uip.cle.entry_code == NULL) {
4613 Yap_kill_iblock(sp->uip.cle.block, NULL, ap);
4614 } else {
4615 path_stack_entry *nsp = sp;
4616
4617 while ((--nsp)->flag != block_entry)
4618 ;
4619 Yap_kill_iblock(sp->uip.cle.block, nsp->uip.cle.block, ap);
4620 *sp->uip.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode);
4621 }
4622 return sp;
4623}
4624
4625static LogUpdClause *find_last_clause(yamop *start) {
4626 while (start->y_u.OtaLl.d->ClFlags & ErasedMask)
4627 start = start->y_u.OtaLl.n;
4628 /* this should be the available clause */
4629 return start->y_u.OtaLl.d;
4630}
4631
4632static void remove_clause_from_index(yamop *header, LogUpdClause *cl) {
4633 yamop **prevp = &(header->y_u.Illss.l1);
4634 yamop *curp = header->y_u.Illss.l1;
4635
4636 if (curp->y_u.OtaLl.d == cl) {
4637 yamop *newp = curp->y_u.OtaLl.n;
4638 newp->opc = curp->opc;
4639 *prevp = newp;
4640 } else {
4641 yamop *ocurp = NULL, *ocurp0 = curp;
4642
4643 while (curp->y_u.OtaLl.d != cl) {
4644 ocurp = curp;
4645 curp = curp->y_u.OtaLl.n;
4646 }
4647 /* in case we were the last */
4648 if (curp == header->y_u.Illss.l2)
4649 header->y_u.Illss.l2 = ocurp;
4650 if (ocurp != ocurp0)
4651 ocurp->opc = curp->opc;
4652 ocurp->y_u.OtILl.n = curp->y_u.OtaLl.n;
4653 ocurp->y_u.OtILl.block = curp->y_u.OtILl.block;
4654 }
4655 header->y_u.Illss.e--;
4656#if DEBUG
4657 Yap_DirtyCps--;
4658 Yap_FreedCps++;
4659#endif
4660 clean_ref_to_clause(cl);
4661 Yap_LUIndexSpace_CP -= (UInt)NEXTOP((yamop *)NULL, OtILl);
4662 Yap_FreeCodeSpace((ADDR)curp);
4663}
4664
4665static void remove_dirty_clauses_from_index(yamop *header) {
4666 LogUpdClause *cl;
4667 yamop *previouscurp;
4668 OPCODE endop = Yap_opcode(_trust_logical);
4669 yamop **prevp = &(header->y_u.Illss.l1), *curp = header->y_u.Illss.l1;
4670 OPCODE startopc = curp->opc;
4671 PredEntry *ap = curp->y_u.OtaLl.d->ClPred;
4672
4673 if (ap->PredFlags & CountPredFlag)
4674 endop = Yap_opcode(_count_trust_logical);
4675 else if (ap->PredFlags & ProfiledPredFlag)
4676 endop = Yap_opcode(_profiled_trust_logical);
4677 while ((cl = curp->y_u.OtaLl.d) && (cl->ClFlags & ErasedMask)) {
4678 yamop *ocurp = curp;
4679
4680 header->y_u.Illss.e--;
4681#if DEBUG
4682 Yap_DirtyCps--;
4683 Yap_FreedCps++;
4684#endif
4685 // if (ap->ModuleOfPred!=IDB_MODULE &&
4686 // !strcmp(RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE,
4687 // "$lgt_send_to_obj_ne_"))
4688 // printf(" L %p %p %d %p\n", curp, curp->y_u.OtaLl.n, header->y_u.Illss.e,
4689 // curp->opc);
4690 clean_ref_to_clause(cl);
4691 curp = curp->y_u.OtaLl.n;
4692 Yap_LUIndexSpace_CP -= (UInt)NEXTOP((yamop *)NULL, OtaLl);
4693 Yap_FreeCodeSpace((ADDR)ocurp);
4694 if (ocurp == header->y_u.Illss.l2) {
4695 LogUpdIndex *clau = header->y_u.Illss.I;
4696 /* no clauses left */
4697 if (clau->ClFlags & ErasedMask) {
4698 Yap_ErLogUpdIndex(clau);
4699 return;
4700 }
4701 header->y_u.Illss.l1 = header->y_u.Illss.l2 = NULL;
4702 header->y_u.Illss.s = header->y_u.Illss.e = 0;
4703 return;
4704 }
4705 }
4706 *prevp = curp;
4707 curp->opc = startopc;
4708 if (curp->opc == endop)
4709 return;
4710 // don't try to follow the chain if there is no chain.
4711 if (header->y_u.Illss.e <= 1)
4712 return;
4713 previouscurp = curp;
4714 curp = curp->y_u.OtaLl.n;
4715 while (TRUE) {
4716 if ((cl = curp->y_u.OtaLl.d)->ClFlags & ErasedMask) {
4717 yamop *ocurp = curp;
4718
4719 header->y_u.Illss.e--;
4720#if DEBUG
4721 Yap_DirtyCps--;
4722 Yap_FreedCps++;
4723#endif
4724 clean_ref_to_clause(cl);
4725 if (curp->opc == endop) {
4726 previouscurp->opc = endop;
4727 previouscurp->y_u.OtILl.block = curp->y_u.OtILl.block;
4728 previouscurp->y_u.OtILl.n = NULL;
4729 header->y_u.Illss.l2 = previouscurp;
4730 Yap_LUIndexSpace_CP -= (UInt)NEXTOP((yamop *)NULL, OtILl);
4731 Yap_FreeCodeSpace((ADDR)curp);
4732 return;
4733 }
4734 previouscurp->y_u.OtaLl.n = curp->y_u.OtaLl.n;
4735 curp = curp->y_u.OtaLl.n;
4736 Yap_LUIndexSpace_CP -= (UInt)NEXTOP((yamop *)NULL, OtaLl);
4737 Yap_FreeCodeSpace((ADDR)ocurp);
4738 if (!header->y_u.Illss.e)
4739 return;
4740 } else {
4741 previouscurp = curp;
4742 if (curp->opc == endop) {
4743 curp->y_u.OtILl.n = NULL;
4744 return;
4745 }
4746 curp = curp->y_u.OtaLl.n;
4747 }
4748 }
4749}
4750
4751static path_stack_entry *kill_clause(yamop *ipc, yamop *bg, yamop *lt,
4752 path_stack_entry *sp0, PredEntry *ap) {
4753 LogUpdIndex *blk;
4754 yamop *start;
4755 op_numbers op0;
4756 path_stack_entry *sp = sp0;
4757
4758 while ((--sp)->flag != block_entry)
4759 ;
4760 blk = (LogUpdIndex *)(sp->uip.cle.block);
4761 start = blk->ClCode;
4762 op0 = Yap_op_from_opcode(start->opc);
4763 while (op0 == _lock_lu) {
4764 start = NEXTOP(start, p);
4765 op0 = Yap_op_from_opcode(start->opc);
4766 }
4767 while (op0 == _jump_if_nonvar) {
4768 start = NEXTOP(start, xll);
4769 op0 = Yap_op_from_opcode(start->opc);
4770 }
4771 if (op0 != _enter_lu_pred) {
4772 /* static code */
4773 return kill_block(sp + 1, ap);
4774 }
4775 /* weird case ????? */
4776 if (!start->y_u.Illss.s) {
4777 /* ERROR */
4778 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "Illss.s == 0 %p", ipc);
4779 return sp;
4780 }
4781 if (start->y_u.Illss.s == 1) {
4782 /* we need to discover which clause is left and then die */
4783 path_stack_entry *nsp;
4784 find_last_clause(start->y_u.Illss.l1);
4785
4786 nsp = sp;
4787 while ((--nsp)->flag != block_entry)
4788 ;
4789 /* make us point straight at clause */
4790 *sp->uip.cle.entry_code = FAILCODE;
4791 Yap_kill_iblock(sp->uip.cle.block, nsp->uip.cle.block, ap);
4792 return sp;
4793 } else {
4794 if (
4795#if MULTIPLE_STACKS
4796 blk->ClRefCount == 0
4797#else
4798 !(blk->ClFlags & InUseMask)
4799#endif
4800 ) {
4801 remove_clause_from_index(start, ClauseCodeToLogUpdClause(bg));
4802 } else {
4803 blk->ClFlags |= DirtyMask;
4804 }
4805 return sp;
4806 }
4807}
4808
4809static path_stack_entry *expanda_block(path_stack_entry *sp, PredEntry *ap,
4810 ClauseDef *cls, int group1, yamop *alt,
4811 struct intermediates *cint) {
4812 while ((--sp)->flag != block_entry)
4813 ;
4814 Yap_kill_iblock(sp->uip.cle.block, NULL, ap);
4815 return sp;
4816}
4817
4818static path_stack_entry *expandz_block(path_stack_entry *sp, PredEntry *ap,
4819 ClauseDef *cls, int group1, yamop *alt,
4820 struct intermediates *cint) {
4821 while ((--sp)->flag != block_entry)
4822 ;
4823 Yap_kill_iblock(sp->uip.cle.block, NULL, ap);
4824 return sp;
4825}
4826
4827static LogUpdClause *lu_clause(yamop *ipc, PredEntry *ap) {
4828 if (ipc == FAILCODE)
4829 return NULL;
4830 if (ipc == (yamop *)(&(ap->OpcodeOfPred)))
4831 return NULL;
4832 return ClauseCodeToLogUpdClause(ipc);
4833}
4834
4835static StaticClause *find_static_clause(PredEntry *ap, yamop *ipc) {
4836 StaticClause *cl = ClauseCodeToStaticClause(ap->cs.p_code.FirstClause);
4837 while (ipc < cl->ClCode || ipc > (yamop *)((char *)cl + cl->ClSize)) {
4838 cl = cl->ClNext;
4839 if (!cl)
4840 return NULL;
4841 }
4842 return cl;
4843}
4844
4845static StaticClause *static_clause(yamop *ipc, PredEntry *ap, int trust) {
4846 CELL *p;
4847
4848 if (ipc == FAILCODE)
4849 return NULL;
4850 if (ipc == (yamop *)(&(ap->OpcodeOfPred)))
4851 return NULL;
4852 if (ap->PredFlags & MegaClausePredFlag)
4853 return (StaticClause *)ipc;
4854 if (ap->PredFlags & TabledPredFlag)
4855 ipc = PREVOP(ipc, Otapl);
4856 p = (CELL *)ipc;
4857 if (trust) {
4858 return ClauseCodeToStaticClause(p);
4859 } else {
4860 op_numbers op = Yap_op_from_opcode(ipc->opc);
4861 UInt j;
4862
4863 /* unbound call, so we cannot optimise instructions */
4864 switch (op) {
4865 case _p_db_ref_x:
4866 case _p_float_x:
4867 j = Yap_regnotoreg(ipc->y_u.xl.x);
4868 break;
4869 case _get_list:
4870 j = Yap_regnotoreg(ipc->y_u.x.x);
4871 break;
4872 case _get_atom:
4873 j = Yap_regnotoreg(ipc->y_u.xc.x);
4874 break;
4875 case _get_float:
4876 j = Yap_regnotoreg(ipc->y_u.xd.x);
4877 break;
4878 case _get_struct:
4879 j = Yap_regnotoreg(ipc->y_u.xd.x);
4880 break;
4881 case _get_2atoms:
4882 case _get_3atoms:
4883 case _get_4atoms:
4884 case _get_5atoms:
4885 case _get_6atoms:
4886 return ClauseCodeToStaticClause(p);
4887 default:
4888 return find_static_clause(ap, ipc);
4889 }
4890 if (j == 1) /* must be the first instruction */
4891 return ClauseCodeToStaticClause(p);
4892 return find_static_clause(ap, ipc);
4893 }
4894 return NULL;
4895}
4896
4897static StaticClause *simple_static_clause(yamop *ipc, PredEntry *ap) {
4898 if (ipc == (yamop *)(&(ap->OpcodeOfPred)))
4899 return NULL;
4900 if (ipc == FAILCODE)
4901 return NULL;
4902 return ClauseCodeToStaticClause(ipc);
4903}
4904
4905/* this code should be called when we jumped to clauses */
4906static path_stack_entry *kill_unsafe_block(path_stack_entry *sp, op_numbers op,
4907 PredEntry *ap, int first, int remove,
4908 ClauseDef *cls) {
4909 yamop *ipc;
4910 while ((--sp)->flag != block_entry)
4911 ;
4912 if (sp->uip.cle.entry_code == NULL) {
4913 /* we have reached the top */
4914 Yap_RemoveIndexation(ap);
4915 return sp;
4916 }
4917 ipc = *sp->uip.cle.entry_code;
4918 if (Yap_op_from_opcode(ipc->opc) == op) {
4919 /* the new block was the current clause */
4920 ClauseDef cld[2];
4921
4922 if (remove) {
4923 *sp->uip.cle.entry_code = FAILCODE;
4924 return sp;
4925 }
4926 if (ap->PredFlags & LogUpdatePredFlag) {
4927 struct intermediates intrs;
4928 LogUpdClause *lc = lu_clause(ipc, ap);
4929
4930 if (first) {
4931 cld[0].Code = cls[0].Code;
4932 cld[1].Code = lc->ClCode;
4933 } else {
4934 cld[0].Code = lc->ClCode;
4935 cld[1].Code = cls[0].Code;
4936 }
4937 intrs.expand_block = NULL;
4938 *sp->uip.cle.entry_code =
4939 (yamop *)suspend_indexing(cld, cld + 1, ap, &intrs);
4940 } else {
4941 /* static predicate, shouldn't do much, just suspend the code here */
4942 *sp->uip.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode);
4943 return sp;
4944 }
4945 return sp;
4946 }
4947 /* we didn't have protection, should kill now */
4948 return kill_block(sp + 1, ap);
4949}
4950
4951static int compacta_expand_clauses(yamop *ipc) {
4952 /* expand clauses so that you have a hole at the beginning */
4953 /* we know that there is at least one element here */
4954 yamop **start = (yamop **)(NEXTOP(ipc, sssllp));
4955 yamop **ptr, **end;
4956
4957 ptr = end = start + ipc->y_u.sssllp.s1;
4958
4959 while (ptr > start) {
4960 yamop *next = *--ptr;
4961 if (next)
4962 *--end = next;
4963 }
4964 if (ptr != end) {
4965 while (end > start) {
4966 *--end = NULL;
4967 }
4968 return TRUE;
4969 }
4970 return FALSE;
4971}
4972
4973static int compactz_expand_clauses(yamop *ipc) {
4974 /* expand clauses so that you have a hole at the beginning */
4975 /* we know that there is at least one element here */
4976 yamop **start = (yamop **)(NEXTOP(ipc, sssllp));
4977 yamop **ptr, **end;
4978
4979 end = start + ipc->y_u.sssllp.s1;
4980 ptr = start;
4981
4982 while (ptr < end) {
4983 yamop *next = *ptr++;
4984 if (next)
4985 *start++ = next;
4986 }
4987 /* reset empty slots at end */
4988 if (start != end) {
4989 while (start < end) {
4990 *start++ = NULL;
4991 }
4992 return TRUE;
4993 }
4994 return FALSE;
4995}
4996
4997/* this code should be called when we jumped to clauses */
4998static yamop *add_to_expand_clauses(path_stack_entry **spp, yamop *ipc,
4999 ClauseDef *cls, PredEntry *ap, int first,
5000 struct intermediates *cint) {
5001 path_stack_entry *sp = *spp;
5002 yamop **clar;
5003
5004 if (first) {
5005
5006 do {
5007 clar = (yamop **)NEXTOP(ipc, sssllp);
5008
5009 if (*clar == NULL || clar[0] == cls->Code) {
5010 while (*clar == NULL)
5011 clar++;
5012 if (clar[0] != cls->Code) {
5013 clar[-1] = cls->Code;
5014 ipc->y_u.sssllp.s2++;
5015 }
5016 return pop_path(spp, cls, ap, cint);
5017 }
5018 } while (compacta_expand_clauses(ipc));
5019 } else {
5020 do {
5021 clar = (yamop **)NEXTOP(ipc, sssllp) + ipc->y_u.sssllp.s1;
5022 if (clar[-1] == NULL || clar[-1] == cls->Code) {
5023 while (*--clar == NULL)
5024 ;
5025 if (clar[0] != cls->Code) {
5026 clar[1] = cls->Code;
5027 ipc->y_u.sssllp.s2++;
5028 }
5029 return pop_path(spp, cls, ap, cint);
5030 }
5031 } while (compactz_expand_clauses(ipc));
5032 }
5033 while ((--sp)->flag != block_entry)
5034 ;
5035 if (sp->uip.cle.entry_code) {
5036 *sp->uip.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode);
5037 }
5038 recover_ecls_block(ipc);
5039 return pop_path(spp, cls, ap, cint);
5040}
5041
5042/* this code should be called when we jumped to clauses */
5043static void nullify_expand_clause(yamop *ipc, path_stack_entry *sp,
5044 ClauseDef *cls) {
5045 yamop **st = (yamop **)NEXTOP(ipc, sssllp);
5046 yamop **max = st + ipc->y_u.sssllp.s1;
5047
5048 /* make sure we get rid of the reference */
5049 while (st < max) {
5050 if (*st && *st == cls->Code) {
5051 *st = NULL;
5052 ipc->y_u.sssllp.s2--;
5053 break;
5054 }
5055 st++;
5056 }
5057 /* if the block has a single element */
5058 if (ipc->y_u.sssllp.s2 == 1) {
5059 yamop **st = (yamop **)NEXTOP(ipc, sssllp);
5060 while ((--sp)->flag != block_entry)
5061 ;
5062 while (TRUE) {
5063 if (*st && *st != cls->Code) {
5064 *sp->uip.cle.entry_code = *st;
5065 recover_ecls_block(ipc);
5066 return;
5067 }
5068 st++;
5069 }
5070 }
5071}
5072
5073static yamop *add_try(PredEntry *ap, ClauseDef *cls, yamop *next,
5074 struct intermediates *cint) {
5075 yamop *newcp;
5076 UInt size = (UInt)NEXTOP((yamop *)NULL, OtaLl);
5077 LogUpdClause *lcl = ClauseCodeToLogUpdClause(cls->Code);
5078
5079 if ((newcp = (yamop *)Yap_AllocCodeSpace(size)) == NULL) {
5080 /* OOOPS, got in trouble, must do a siglongjmp and recover space */
5081 save_machine_regs();
5082 siglongjmp(cint->CompilerBotch, 2);
5083 }
5084 Yap_LUIndexSpace_CP += size;
5085#if DEBUG
5086 Yap_NewCps++;
5087 Yap_LiveCps++;
5088#endif
5089 newcp->opc = Yap_opcode(_try_logical);
5090 newcp->y_u.OtaLl.s = ap->ArityOfPE;
5091 newcp->y_u.OtaLl.n = next;
5092 newcp->y_u.OtaLl.d = lcl;
5093 lcl->ClRefCount++;
5094 return newcp;
5095}
5096
5097static yamop *add_trust(LogUpdIndex *icl, ClauseDef *cls,
5098 struct intermediates *cint) {
5099 yamop *newcp;
5100 UInt size = (UInt)NEXTOP((yamop *)NULL, OtILl);
5101 LogUpdClause *lcl = ClauseCodeToLogUpdClause(cls->Code);
5102 PredEntry *ap = lcl->ClPred;
5103
5104 if ((newcp = (yamop *)Yap_AllocCodeSpace(size)) == NULL) {
5105 /* OOOPS, got in trouble, must do a siglongjmp and recover space */
5106 save_machine_regs();
5107 siglongjmp(cint->CompilerBotch, 2);
5108 }
5109 Yap_LUIndexSpace_CP += size;
5110#if DEBUG
5111 Yap_NewCps++;
5112 Yap_LiveCps++;
5113#endif
5114 if (ap->PredFlags & CountPredFlag)
5115 newcp->opc = Yap_opcode(_count_trust_logical);
5116 else if (ap->PredFlags & ProfiledPredFlag)
5117 newcp->opc = Yap_opcode(_profiled_trust_logical);
5118 else
5119 newcp->opc = Yap_opcode(_trust_logical);
5120 newcp->y_u.OtILl.block = icl;
5121 newcp->y_u.OtILl.n = NULL;
5122 newcp->y_u.OtILl.d = lcl;
5123 lcl->ClRefCount++;
5124 return newcp;
5125}
5126
5127static void add_to_index(struct intermediates *cint, int first,
5128 path_stack_entry *sp, ClauseDef *cls) {
5129 /* last clause to experiment with */
5130 PredEntry *ap = cint->CurrentPred;
5131 yamop *ipc = ap->cs.p_code.TrueCodeOfPred;
5132 int group1 = TRUE;
5133 yamop *alt = NULL;
5134 UInt current_arity = 0;
5135 LogUpdIndex *icl = NULL;
5136
5137 sp = init_block_stack(sp, ipc, ap);
5138 /* try to refine the interval using the indexing code */
5139 while (ipc != NULL) {
5140 op_numbers op = Yap_op_from_opcode(ipc->opc);
5141
5142 switch (op) {
5143 case _try_logical:
5144 case _retry_logical:
5145 case _count_retry_logical:
5146 case _profiled_retry_logical:
5147 case _trust_logical:
5148 case _count_trust_logical:
5149 case _profiled_trust_logical:
5150 /* ERROR */
5151 break;
5152 case _enter_lu_pred:
5153 ipc->y_u.Illss.s++;
5154 icl = ipc->y_u.Illss.I;
5155 if (first) {
5156 if (ap->PredFlags & CountPredFlag)
5157 ipc->y_u.Illss.l1->opc = Yap_opcode(_count_retry_logical);
5158 else if (ap->PredFlags & ProfiledPredFlag)
5159 ipc->y_u.Illss.l1->opc = Yap_opcode(_profiled_retry_logical);
5160 else
5161 ipc->y_u.Illss.l1->opc = Yap_opcode(_retry_logical);
5162 ipc->y_u.Illss.l1 = add_try(ap, cls, ipc->y_u.Illss.l1, cint);
5163 } else {
5164 /* just go to next instruction */
5165 yamop *end = add_trust(icl, cls, cint), *old = ipc->y_u.Illss.l2;
5166
5167 /* we used to have two clauses */
5168 if (ap->PredFlags & CountPredFlag)
5169 old->opc = Yap_opcode(_count_retry_logical);
5170 else if (ap->PredFlags & ProfiledPredFlag)
5171 old->opc = Yap_opcode(_profiled_retry_logical);
5172 else
5173 old->opc = Yap_opcode(_retry_logical);
5174 old->y_u.OtaLl.n = end;
5175 old->y_u.OtaLl.s = ap->ArityOfPE;
5176 ipc->y_u.Illss.l2 = end;
5177 }
5178 ipc = pop_path(&sp, cls, ap, cint);
5179 break;
5180 case _try_clause:
5181 /* I cannot expand a predicate that starts on a variable,
5182 have to expand the index.
5183 */
5184 if (first) {
5185 sp = expanda_block(sp, ap, cls, group1, alt, cint);
5186 ipc = pop_path(&sp, cls, ap, cint);
5187 } else {
5188 /* just go to next instruction */
5189 ipc = NEXTOP(ipc, Otapl);
5190 }
5191 break;
5192 case _try_clause2:
5193 case _try_clause3:
5194 case _try_clause4:
5195 /* I cannot expand a predicate that starts on a variable,
5196 have to expand the index.
5197 */
5198 if (first) {
5199 sp = expanda_block(sp, ap, cls, group1, alt, cint);
5200 ipc = pop_path(&sp, cls, ap, cint);
5201 } else {
5202 /* just go to next instruction */
5203 ipc = NEXTOP(ipc, l);
5204 }
5205 break;
5206 case _retry:
5207 /* this clause had no indexing */
5208 ipc = NEXTOP(ipc, Otapl);
5209 break;
5210 case _retry2:
5211 case _retry3:
5212 case _retry4:
5213 /* this clause had no indexing */
5214 ipc = NEXTOP(ipc, l);
5215 break;
5216 /* instructions type l */
5217 case _retry_me:
5218 /* should never be reached both for asserta */
5219 group1 = FALSE;
5220 ipc = ipc->y_u.Otapl.d;
5221 break;
5222 case _try_me:
5223 if (first) {
5224 ipc = NEXTOP(ipc, Otapl);
5225 alt = ipc->y_u.Otapl.d;
5226 } else {
5227 ipc = ipc->y_u.Otapl.d;
5228 group1 = FALSE;
5229 }
5230 break;
5231 case _retry_profiled:
5232 case _count_retry:
5233 ipc = NEXTOP(ipc, Otapl);
5234 break;
5235 case _profiled_trust_me:
5236 case _trust_me:
5237 case _count_trust_me:
5238 group1 = FALSE;
5239 ipc = NEXTOP(ipc, Otapl);
5240 break;
5241 case _trust:
5242 sp = expandz_block(sp, ap, cls, group1, alt, cint);
5243 ipc = pop_path(&sp, cls, ap, cint);
5244 break;
5245 case _jump:
5246 sp = cross_block(sp, &ipc->y_u.l.l, ap, cint);
5247 /* just skip for now, but should worry about memory management */
5248 ipc = ipc->y_u.l.l;
5249 break;
5250 case _jump_if_var:
5251 sp = push_path(sp, &(ipc->y_u.l.l), cls, cint);
5252 ipc = NEXTOP(ipc, l);
5253 break;
5254 case _jump_if_nonvar:
5255 sp = push_path(sp, &(ipc->y_u.xll.l2), cls, cint);
5256 sp = cross_block(sp, &ipc->y_u.xll.l1, ap, cint);
5257 ipc = ipc->y_u.xll.l1;
5258 break;
5259 /* instructions type EC */
5260 case _try_in:
5261 /* we are done */
5262 if (first) {
5263 sp = kill_block(sp, ap);
5264 ipc = pop_path(&sp, cls, ap, cint);
5265 } else {
5266 ipc = NEXTOP(ipc, l);
5267 }
5268 break;
5269 case _user_switch:
5270 ipc = ipc->y_u.lp.l;
5271 break;
5272 /* instructions type e */
5273 case _switch_on_type:
5274 sp = push_path(sp, &(ipc->y_u.llll.l4), cls, cint);
5275 if (ap->PredFlags & LogUpdatePredFlag) {
5276 add_head_info(cls, 1);
5277 } else {
5278 add_info(cls, 1);
5279 }
5280 if (IsPairTerm(cls->Tag)) {
5281 yamop *nipc = ipc->y_u.llll.l1;
5282
5283 current_arity = 2;
5284 move_next(cls, 1);
5285 if (nipc == FAILCODE) {
5286 /* jump straight to clause */
5287 if (ap->PredFlags & LogUpdatePredFlag) {
5288 ipc->y_u.llll.l1 = cls->Code;
5289 } else {
5290 ipc->y_u.llll.l1 = cls->CurrentCode;
5291 }
5292 ipc = pop_path(&sp, cls, ap, cint);
5293 } else {
5294 /* go on */
5295 sp = cross_block(sp, &ipc->y_u.llll.l1, ap, cint);
5296 ipc = nipc;
5297 }
5298 } else if (IsAtomOrIntTerm(cls->Tag)) {
5299 yamop *nipc = ipc->y_u.llll.l2;
5300 move_next(cls, 1);
5301 if (nipc == FAILCODE) {
5302 /* need to expand the block */
5303 sp = kill_block(sp, ap);
5304 ipc = pop_path(&sp, cls, ap, cint);
5305 } else {
5306 /* I do not have to worry about crossing a block here */
5307 ipc = nipc;
5308 }
5309 } else if (IsApplTerm(cls->Tag)) {
5310 yamop *nipc = ipc->y_u.llll.l3;
5311 if (nipc == FAILCODE) {
5312 /* need to expand the block */
5313 sp = kill_block(sp, ap);
5314 ipc = pop_path(&sp, cls, ap, cint);
5315 } else {
5316 /* I do not have to worry about crossing a block here */
5317 ipc = nipc;
5318 }
5319 } else {
5320 /* we can't separate into four groups,
5321 need to restart.
5322 */
5323 sp = kill_block(sp, ap);
5324 ipc = pop_path(&sp, cls, ap, cint);
5325 }
5326 break;
5327 case _switch_list_nl:
5328 sp = kill_block(sp, ap);
5329 ipc = pop_path(&sp, cls, ap, cint);
5330 break;
5331 case _switch_on_arg_type:
5332 sp = push_path(sp, &(ipc->y_u.xllll.l4), cls, cint);
5333 if (ap->PredFlags & LogUpdatePredFlag) {
5334 add_head_info(cls, Yap_regtoregno(ipc->y_u.xllll.x));
5335 } else {
5336 add_info(cls, Yap_regtoregno(ipc->y_u.xllll.x));
5337 }
5338 if (IsPairTerm(cls->Tag)) {
5339 yamop *nipc = ipc->y_u.xllll.l1;
5340
5341 current_arity = 2;
5342 move_next(cls, Yap_regtoregno(ipc->y_u.xllll.x));
5343 if (nipc == FAILCODE) {
5344 /* jump straight to clause */
5345 if (ap->PredFlags & LogUpdatePredFlag) {
5346 ipc->y_u.xllll.l1 = cls->Code;
5347 } else {
5348 ipc->y_u.xllll.l1 = cls->CurrentCode;
5349 }
5350 ipc = pop_path(&sp, cls, ap, cint);
5351 } else {
5352 /* go on */
5353 sp = cross_block(sp, &ipc->y_u.xllll.l1, ap, cint);
5354 ipc = nipc;
5355 }
5356 } else if (IsAtomOrIntTerm(cls->Tag)) {
5357 yamop *nipc = ipc->y_u.xllll.l2;
5358 move_next(cls, Yap_regtoregno(ipc->y_u.xllll.x));
5359 if (nipc == FAILCODE) {
5360 /* need to expand the block */
5361 sp = kill_block(sp, ap);
5362 ipc = pop_path(&sp, cls, ap, cint);
5363 } else {
5364 /* I do not have to worry about crossing a block here */
5365 ipc = nipc;
5366 }
5367 } else if (IsApplTerm(cls->Tag)) {
5368 yamop *nipc = ipc->y_u.xllll.l3;
5369 move_next(cls, Yap_regtoregno(ipc->y_u.xllll.x));
5370 if (nipc == FAILCODE) {
5371 /* need to expand the block */
5372 sp = kill_block(sp, ap);
5373 ipc = pop_path(&sp, cls, ap, cint);
5374 } else {
5375 /* I do not have to worry about crossing a block here */
5376 ipc = nipc;
5377 }
5378 } else {
5379 /* we can't separate into four groups,
5380 need to restart.
5381 */
5382 sp = kill_block(sp, ap);
5383 ipc = pop_path(&sp, cls, ap, cint);
5384 }
5385 break;
5386 case _switch_on_sub_arg_type:
5387 sp = push_path(sp, &(ipc->y_u.sllll.l4), cls, cint);
5388 add_arg_info(cls, ap, ipc->y_u.sllll.s + 1);
5389 if (IsPairTerm(cls->Tag)) {
5390 yamop *nipc = ipc->y_u.sllll.l1;
5391 current_arity = 2;
5392 skip_to_arg(cls, ap, ipc->y_u.sllll.s, current_arity);
5393 if (nipc == FAILCODE) {
5394 /* jump straight to clause */
5395 if (ap->PredFlags & LogUpdatePredFlag) {
5396 ipc->y_u.sllll.l1 = cls->Code;
5397 } else {
5398 ipc->y_u.sllll.l1 = cls->CurrentCode;
5399 }
5400 ipc = pop_path(&sp, cls, ap, cint);
5401 } else {
5402 /* go on */
5403 sp = cross_block(sp, &ipc->y_u.sllll.l1, ap, cint);
5404 ipc = nipc;
5405 }
5406 } else if (IsAtomOrIntTerm(cls->Tag)) {
5407 yamop *nipc = ipc->y_u.sllll.l2;
5408 skip_to_arg(cls, ap, ipc->y_u.sllll.s, current_arity);
5409 if (nipc == FAILCODE) {
5410 /* need to expand the block */
5411 sp = kill_block(sp, ap);
5412 ipc = pop_path(&sp, cls, ap, cint);
5413 } else {
5414 /* I do not have to worry about crossing a block here */
5415 ipc = nipc;
5416 }
5417 } else if (IsApplTerm(cls->Tag)) {
5418 yamop *nipc = ipc->y_u.sllll.l3;
5419 skip_to_arg(cls, ap, ipc->y_u.sllll.s, current_arity);
5420 if (nipc == FAILCODE) {
5421 /* need to expand the block */
5422 sp = kill_block(sp, ap);
5423 ipc = pop_path(&sp, cls, ap, cint);
5424 } else {
5425 /* I do not have to worry about crossing a block here */
5426 ipc = nipc;
5427 }
5428 } else {
5429 /* we can't separate into four groups,
5430 need to restart.
5431 */
5432 sp = kill_block(sp, ap);
5433 ipc = pop_path(&sp, cls, ap, cint);
5434 }
5435 break;
5436 case _if_not_then:
5437 ipc = pop_path(&sp, cls, ap, cint);
5438 break;
5439 /* instructions type ollll */
5440 case _switch_on_func:
5441 case _if_func:
5442 case _go_on_func: {
5443 FuncSwiEntry *fe;
5444 yamop *newpc;
5445 Functor f = (Functor)RepAppl(cls->Tag);
5446
5447 if (op == _switch_on_func) {
5448 fe = lookup_f_hash(f, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
5449 } else {
5450 fe = lookup_f(f, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
5451 }
5452 if (!IsExtensionFunctor(f)) {
5453 current_arity = ArityOfFunctor(f);
5454 }
5455 newpc = fe->u_f.labp;
5456 if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) {
5457 /* we found it */
5458 ipc = pop_path(&sp, cls, ap, cint);
5459 } else if (newpc == FAILCODE) {
5460 /* oops, nothing there */
5461 if (fe->Tag != f) {
5462 if (IsExtensionFunctor(f)) {
5463 sp = kill_unsafe_block(sp, op, ap, first, FALSE, cls);
5464 ipc = pop_path(&sp, cls, ap, cint);
5465 break;
5466 }
5467 if (table_fe_overflow(ipc, f)) {
5468 fe = expand_ftable(ipc, current_block(sp), cint, f);
5469 }
5470 fe->Tag = f;
5471 ipc->y_u.sssl.e++;
5472 }
5473 if (ap->PredFlags & LogUpdatePredFlag) {
5474 fe->u_f.labp = cls->Code;
5475 } else {
5476 fe->u_f.labp = cls->CurrentCode;
5477 }
5478 ipc = pop_path(&sp, cls, ap, cint);
5479 } else {
5480 yamop *newpc = fe->u_f.labp;
5481 sp = fetch_new_block(sp, &(ipc->y_u.sssl.l), ap, cint);
5482 sp = cross_block(sp, &(fe->u_f.labp), ap, cint);
5483 ipc = newpc;
5484 }
5485 } break;
5486 case _index_dbref:
5487 cls->Tag = cls->ucd.t_ptr;
5488 ipc = NEXTOP(ipc, e);
5489 break;
5490 case _index_blob:
5491 cls->Tag = Yap_Double_key(cls->ucd.t_ptr);
5492 ipc = NEXTOP(ipc, e);
5493 break;
5494 case _index_long:
5495 cls->Tag = Yap_Int_key(cls->ucd.t_ptr);
5496 ipc = NEXTOP(ipc, e);
5497 break;
5498 case _switch_on_cons:
5499 case _if_cons:
5500 case _go_on_cons: {
5501 AtomSwiEntry *ae;
5502 yamop *newpc;
5503 Term at = cls->Tag;
5504
5505 if (op == _switch_on_cons) {
5506 ae = lookup_c_hash(at, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
5507 } else {
5508 ae = lookup_c(at, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
5509 }
5510 newpc = ae->u_a.labp;
5511
5512 if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) {
5513 /* nothing more to do */
5514 ipc = pop_path(&sp, cls, ap, cint);
5515 } else if (newpc == FAILCODE) {
5516 /* oops, nothing there */
5517 if (ae->Tag != at) {
5518 if (table_ae_overflow(ipc, at)) {
5519 ae = expand_ctable(ipc, current_block(sp), cint, at);
5520 }
5521 ae->Tag = at;
5522 ipc->y_u.sssl.e++;
5523 }
5524 if (ap->PredFlags & LogUpdatePredFlag) {
5525 ae->u_a.labp = cls->Code;
5526 } else {
5527 ae->u_a.labp = cls->CurrentCode;
5528 }
5529 ipc = pop_path(&sp, cls, ap, cint);
5530 } else {
5531 yamop *newpc = ae->u_a.labp;
5532
5533 sp = fetch_new_block(sp, &(ipc->y_u.sssl.l), ap, cint);
5534 sp = cross_block(sp, &(ae->u_a.labp), ap, cint);
5535 ipc = newpc;
5536 }
5537 } break;
5538 case _expand_clauses:
5539 ipc = add_to_expand_clauses(&sp, ipc, cls, ap, first, cint);
5540 break;
5541 case _expand_index:
5542 ipc = pop_path(&sp, cls, ap, cint);
5543 break;
5544 case _lock_lu:
5545 ipc = NEXTOP(ipc, p);
5546 break;
5547 case _op_fail:
5548 while ((--sp)->flag != block_entry)
5549 ;
5550 *sp->uip.cle.entry_code = cls->Code;
5551 ipc = pop_path(&sp, cls, ap, cint);
5552 break;
5553 default:
5554 sp = kill_unsafe_block(sp, op, ap, first, FALSE, cls);
5555 ipc = pop_path(&sp, cls, ap, cint);
5556 }
5557 }
5558}
5559
5560void Yap_AddClauseToIndex(PredEntry *ap, yamop *beg, int first) {
5561 CACHE_REGS
5562 ClauseDef cl;
5563 /* first clause */
5564 path_stack_entry *stack, *sp;
5565 int cb;
5566 struct intermediates cint;
5567
5568 if (!(ap->PredFlags & LogUpdatePredFlag)) {
5569 if (ap->PredFlags & IndexedPredFlag)
5570 Yap_RemoveIndexation(ap);
5571 return;
5572 }
5573 cint.CurrentPred = ap;
5574 cint.expand_block = NULL;
5575 cint.CodeStart = cint.BlobsStart = cint.cpc = cint.icpc = NIL;
5576 cint.term_depth = cint.last_index_new_depth = cint.last_depth_size = 0L;
5577 if ((cb = sigsetjmp(cint.CompilerBotch, 0)) == 3) {
5578 restore_machine_regs();
5579 Yap_dogc(PASS_REGS1);
5580 save_machine_regs();
5581 } else if (cb == 2) {
5582 restore_machine_regs();
5583 Yap_growheap(FALSE, LOCAL_Error_Size, NULL);
5584 save_machine_regs();
5585 } else if (cb == 4) {
5586 restore_machine_regs();
5587 Yap_growtrail(LOCAL_Error_Size, FALSE);
5588 save_machine_regs();
5589 }
5590 if (cb) {
5591 Yap_RemoveIndexation(ap);
5592 return;
5593 }
5594 LOCAL_Error_TYPE = YAP_NO_ERROR;
5595#if DEBUG
5596 if (GLOBAL_Option['i' - 'a' + 1]) {
5597 Yap_DebugPutc(stderr, '+');
5598 Yap_DebugWriteIndicator(ap);
5599 }
5600#endif
5601 stack = (path_stack_entry *)TR;
5602 cl.Code = cl.CurrentCode = beg;
5603 sp = push_path(stack, NULL, &cl, &cint);
5604 add_to_index(&cint, first, sp, &cl);
5605}
5606
5607static void contract_ftable(yamop *ipc, ClauseUnion *blk, PredEntry *ap,
5608 Functor f) {
5609 int n = ipc->y_u.sssl.s;
5610 FuncSwiEntry *fep;
5611
5612 if (n > MIN_HASH_ENTRIES) {
5613 fep = lookup_f_hash(f, ipc->y_u.sssl.l, n);
5614 } else {
5615 fep = (FuncSwiEntry *)(ipc->y_u.sssl.l);
5616 while (fep->Tag != f)
5617 fep++;
5618 }
5619 fep->u_f.labp = FAILCODE;
5620}
5621
5622static void contract_ctable(yamop *ipc, ClauseUnion *blk, PredEntry *ap,
5623 Term at) {
5624 int n = ipc->y_u.sssl.s;
5625 AtomSwiEntry *cep;
5626
5627 if (n > MIN_HASH_ENTRIES) {
5628 cep = lookup_c_hash(at, ipc->y_u.sssl.l, n);
5629 } else {
5630 cep = (AtomSwiEntry *)(ipc->y_u.sssl.l);
5631 while (cep->Tag != at)
5632 cep++;
5633 }
5634 cep->u_a.labp = FAILCODE;
5635}
5636
5637static void remove_from_index(PredEntry *ap, path_stack_entry *sp,
5638 ClauseDef *cls, yamop *bg, yamop *lt,
5639 struct intermediates *cint) {
5640 /* last clause to experiment with */
5641 yamop *ipc = ap->cs.p_code.TrueCodeOfPred;
5642
5643 if (ap->cs.p_code.NOfClauses == 1) {
5644 if (ap->PredFlags & IndexedPredFlag) {
5645 Yap_RemoveIndexation(ap);
5646 return;
5647 }
5648 ap->cs.p_code.TrueCodeOfPred = ap->cs.p_code.FirstClause;
5649 if (ap->PredFlags & (SpiedPredFlag | CountPredFlag | ProfiledPredFlag)) {
5650 ap->OpcodeOfPred = Yap_opcode(_spy_pred);
5651 ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
5652#if defined(YAPOR) || defined(THREADS)
5653 } else if (ap->PredFlags & LogUpdatePredFlag &&
5654 !(ap->PredFlags & ThreadLocalPredFlag) &&
5655 ap->ModuleOfPred != IDB_MODULE) {
5656 ap->cs.p_code.TrueCodeOfPred = FAILCODE;
5657 ap->OpcodeOfPred = LOCKPRED_OPCODE;
5658 ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
5659#endif
5660 } else {
5661 ap->OpcodeOfPred = ap->cs.p_code.FirstClause->opc;
5662 ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
5663 }
5664 return;
5665 }
5666 sp = init_block_stack(sp, ipc, ap);
5667 /* try to refine the interval using the indexing code */
5668 while (ipc != NULL) {
5669 op_numbers op = Yap_op_from_opcode(ipc->opc);
5670
5671 switch (op) {
5672 case _retry_profiled:
5673 case _count_retry:
5674 ipc = NEXTOP(ipc, p);
5675 break;
5676 case _try_in:
5677 /* I cannot expand a predicate that starts on a variable,
5678 have to expand the index.
5679 */
5680 if (IN_BETWEEN(bg, ipc->y_u.l.l, lt)) {
5681 sp = kill_clause(ipc, bg, lt, sp, ap);
5682 ipc = pop_path(&sp, cls, ap, cint);
5683 } else {
5684 /* just go to next instruction */
5685 ipc = NEXTOP(ipc, l);
5686 }
5687 break;
5688 case _try_clause:
5689 case _retry:
5690 /* I cannot expand a predicate that starts on a variable,
5691 have to expand the index.
5692 */
5693 if (IN_BETWEEN(bg, ipc->y_u.Otapl.d, lt)) {
5694 sp = kill_clause(ipc, bg, lt, sp, ap);
5695 ipc = pop_path(&sp, cls, ap, cint);
5696 } else {
5697 /* just go to next instruction */
5698 ipc = NEXTOP(ipc, Otapl);
5699 }
5700 break;
5701 case _try_clause2:
5702 case _try_clause3:
5703 case _try_clause4:
5704 case _retry2:
5705 case _retry3:
5706 case _retry4:
5707 /* I cannot expand a predicate that starts on a variable,
5708 have to expand the index.
5709 */
5710 if (IN_BETWEEN(bg, ipc->y_u.l.l, lt)) {
5711 sp = kill_clause(ipc, bg, lt, sp, ap);
5712 ipc = pop_path(&sp, cls, ap, cint);
5713 } else {
5714 /* just go to next instruction */
5715 ipc = NEXTOP(ipc, l);
5716 }
5717 break;
5718 case _trust:
5719 if (IN_BETWEEN(bg, ipc->y_u.Otapl.d, lt)) {
5720 sp = kill_clause(ipc, bg, lt, sp, ap);
5721 }
5722 ipc = pop_path(&sp, cls, ap, cint);
5723 break;
5724 case _enter_lu_pred:
5725 ipc->y_u.Illss.s--;
5726 ipc->y_u.Illss.e++;
5727#if DEBUG
5728 Yap_DirtyCps++;
5729 Yap_LiveCps--;
5730#endif
5731 sp = kill_clause(ipc, bg, lt, sp, ap);
5732 ipc = pop_path(&sp, cls, ap, cint);
5733 break;
5734 /* instructions type l */
5735 case _try_me:
5736 case _retry_me:
5737 sp = push_path(sp, &(ipc->y_u.Otapl.d), cls, cint);
5738 ipc = NEXTOP(ipc, Otapl);
5739 break;
5740 case _profiled_trust_me:
5741 case _trust_me:
5742 case _count_trust_me:
5743 ipc = NEXTOP(ipc, Otapl);
5744 break;
5745 case _jump:
5746 sp = cross_block(sp, &ipc->y_u.l.l, ap, cint);
5747 /* just skip for now, but should worry about memory management */
5748 ipc = ipc->y_u.l.l;
5749 break;
5750 case _jump_if_var:
5751 sp = push_path(sp, &(ipc->y_u.l.l), cls, cint);
5752 ipc = NEXTOP(ipc, l);
5753 break;
5754 case _jump_if_nonvar:
5755 sp = push_path(sp, &(ipc->y_u.xll.l2), cls, cint);
5756 sp = cross_block(sp, &ipc->y_u.xll.l1, ap, cint);
5757 ipc = ipc->y_u.xll.l1;
5758 break;
5759 case _user_switch:
5760 ipc = ipc->y_u.lp.l;
5761 break;
5762 /* instructions type e */
5763 case _switch_on_type:
5764 sp = push_path(sp, &(ipc->y_u.llll.l4), cls, cint);
5765 if (ap->PredFlags & LogUpdatePredFlag) {
5766 add_head_info(cls, 1);
5767 } else {
5768 add_info(cls, 1);
5769 }
5770 if (IsPairTerm(cls->Tag)) {
5771 yamop *nipc = ipc->y_u.llll.l1;
5772 if (IN_BETWEEN(bg, nipc, lt)) {
5773 /* jump straight to clause */
5774 ipc->y_u.llll.l1 = FAILCODE;
5775 ipc = pop_path(&sp, cls, ap, cint);
5776 } else {
5777 /* go on */
5778 sp = cross_block(sp, &ipc->y_u.llll.l1, ap, cint);
5779 ipc = nipc;
5780 }
5781 } else if (IsAtomOrIntTerm(cls->Tag)) {
5782 yamop *nipc = ipc->y_u.llll.l2;
5783 if (IN_BETWEEN(bg, nipc, lt)) {
5784 /* jump straight to clause */
5785 ipc->y_u.llll.l2 = FAILCODE;
5786 ipc = pop_path(&sp, cls, ap, cint);
5787 } else {
5788 /* I do not have to worry about crossing a block here */
5789 ipc = nipc;
5790 }
5791 } else if (IsApplTerm(cls->Tag)) {
5792 yamop *nipc = ipc->y_u.llll.l3;
5793 if (IN_BETWEEN(bg, nipc, lt)) {
5794 /* jump straight to clause */
5795 ipc->y_u.llll.l3 = FAILCODE;
5796 ipc = pop_path(&sp, cls, ap, cint);
5797 } else {
5798 /* I do not have to worry about crossing a block here */
5799 ipc = nipc;
5800 }
5801 } else {
5802 /* we can't separate into four groups,
5803 need to restart.
5804 */
5805 sp = kill_block(sp, ap);
5806 ipc = pop_path(&sp, cls, ap, cint);
5807 }
5808 break;
5809 case _switch_list_nl:
5810 sp = kill_block(sp, ap);
5811 ipc = pop_path(&sp, cls, ap, cint);
5812 break;
5813 case _switch_on_arg_type:
5814 sp = push_path(sp, &(ipc->y_u.xllll.l4), cls, cint);
5815 if (ap->PredFlags & LogUpdatePredFlag) {
5816 add_head_info(cls, Yap_regtoregno(ipc->y_u.xllll.x));
5817 } else {
5818 add_info(cls, Yap_regtoregno(ipc->y_u.xllll.x));
5819 }
5820 if (IsPairTerm(cls->Tag)) {
5821 yamop *nipc = ipc->y_u.xllll.l1;
5822 if (IN_BETWEEN(bg, nipc, lt)) {
5823 /* jump straight to clause */
5824 ipc->y_u.xllll.l1 = FAILCODE;
5825 ipc = pop_path(&sp, cls, ap, cint);
5826 } else {
5827 /* go on */
5828 sp = cross_block(sp, &ipc->y_u.xllll.l1, ap, cint);
5829 ipc = nipc;
5830 }
5831 } else if (IsAtomOrIntTerm(cls->Tag)) {
5832 yamop *nipc = ipc->y_u.xllll.l2;
5833 if (IN_BETWEEN(bg, nipc, lt)) {
5834 /* jump straight to clause */
5835 ipc->y_u.xllll.l2 = FAILCODE;
5836 ipc = pop_path(&sp, cls, ap, cint);
5837 } else {
5838 /* I do not have to worry about crossing a block here */
5839 ipc = nipc;
5840 }
5841 } else if (IsApplTerm(cls->Tag)) {
5842 yamop *nipc = ipc->y_u.xllll.l3;
5843 if (IN_BETWEEN(bg, nipc, lt)) {
5844 /* jump straight to clause */
5845 ipc->y_u.xllll.l3 = FAILCODE;
5846 ipc = pop_path(&sp, cls, ap, cint);
5847 } else {
5848 /* I do not have to worry about crossing a block here */
5849 ipc = nipc;
5850 }
5851 } else {
5852 /* we can't separate into four groups,
5853 need to restart.
5854 */
5855 sp = kill_block(sp, ap);
5856 ipc = pop_path(&sp, cls, ap, cint);
5857 }
5858 break;
5859 case _switch_on_sub_arg_type:
5860 sp = push_path(sp, &(ipc->y_u.sllll.l4), cls, cint);
5861 add_arg_info(cls, ap, ipc->y_u.sllll.s + 1);
5862 if (IsPairTerm(cls->Tag)) {
5863 yamop *nipc = ipc->y_u.sllll.l1;
5864 if (IN_BETWEEN(bg, nipc, lt)) {
5865 /* jump straight to clause */
5866 ipc->y_u.sllll.l1 = FAILCODE;
5867 ipc = pop_path(&sp, cls, ap, cint);
5868 } else {
5869 /* go on */
5870 sp = cross_block(sp, &ipc->y_u.sllll.l1, ap, cint);
5871 ipc = nipc;
5872 }
5873 } else if (IsAtomOrIntTerm(cls->Tag)) {
5874 yamop *nipc = ipc->y_u.sllll.l2;
5875 if (IN_BETWEEN(bg, nipc, lt)) {
5876 /* jump straight to clause */
5877 ipc->y_u.sllll.l2 = FAILCODE;
5878 ipc = pop_path(&sp, cls, ap, cint);
5879 } else {
5880 /* I do not have to worry about crossing a block here */
5881 ipc = nipc;
5882 }
5883 } else if (IsApplTerm(cls->Tag)) {
5884 yamop *nipc = ipc->y_u.sllll.l3;
5885 if (IN_BETWEEN(bg, nipc, lt)) {
5886 /* jump straight to clause */
5887 ipc->y_u.sllll.l3 = FAILCODE;
5888 ipc = pop_path(&sp, cls, ap, cint);
5889 } else {
5890 /* I do not have to worry about crossing a block here */
5891 ipc = nipc;
5892 }
5893 } else {
5894 /* we can't separate into four groups,
5895 need to restart.
5896 */
5897 sp = kill_block(sp, ap);
5898 ipc = pop_path(&sp, cls, ap, cint);
5899 }
5900 break;
5901 case _if_not_then:
5902 ipc = pop_path(&sp, cls, ap, cint);
5903 break;
5904 /* instructions type ollll */
5905 case _switch_on_func:
5906 case _if_func:
5907 case _go_on_func: {
5908 FuncSwiEntry *fe;
5909 yamop *newpc;
5910 Functor f = (Functor)RepAppl(cls->Tag);
5911
5912 if (op == _switch_on_func) {
5913 fe = lookup_f_hash(f, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
5914 } else {
5915 fe = lookup_f(f, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
5916 }
5917 newpc = fe->u_f.labp;
5918
5919 if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) {
5920 /* we found it */
5921 ipc = pop_path(&sp, cls, ap, cint);
5922 } else if (newpc == FAILCODE) {
5923 ipc = pop_path(&sp, cls, ap, cint);
5924 } else if (IN_BETWEEN(bg, fe->u_f.Label, lt)) {
5925 /* oops, nothing there */
5926 contract_ftable(ipc, current_block(sp), ap, f);
5927 ipc = pop_path(&sp, cls, ap, cint);
5928 } else {
5929 yamop *newpc = fe->u_f.labp;
5930 sp = fetch_new_block(sp, &(ipc->y_u.sssl.l), ap, cint);
5931 sp = cross_block(sp, &(fe->u_f.labp), ap, cint);
5932 ipc = newpc;
5933 }
5934 } break;
5935 case _index_dbref:
5936 cls->Tag = cls->ucd.t_ptr;
5937 ipc = NEXTOP(ipc, e);
5938 break;
5939 case _index_blob:
5940 cls->Tag = Yap_Double_key(cls->ucd.t_ptr);
5941 ipc = NEXTOP(ipc, e);
5942 break;
5943 case _index_long:
5944 cls->Tag = Yap_Int_key(cls->ucd.t_ptr);
5945 ipc = NEXTOP(ipc, e);
5946 break;
5947 case _switch_on_cons:
5948 case _if_cons:
5949 case _go_on_cons: {
5950 AtomSwiEntry *ae;
5951 yamop *newpc;
5952 Term at = cls->Tag;
5953
5954 if (op == _switch_on_cons) {
5955 ae = lookup_c_hash(at, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
5956 } else {
5957 ae = lookup_c(at, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
5958 }
5959 newpc = ae->u_a.labp;
5960
5961 if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) {
5962 /* we found it */
5963 ipc = pop_path(&sp, cls, ap, cint);
5964 } else if (newpc == FAILCODE) {
5965 ipc = pop_path(&sp, cls, ap, cint);
5966 } else if (IN_BETWEEN(bg, ae->u_a.Label, lt)) {
5967 /* oops, nothing there */
5968 contract_ctable(ipc, current_block(sp), ap, at);
5969 ipc = pop_path(&sp, cls, ap, cint);
5970 } else {
5971 yamop *newpc = ae->u_a.labp;
5972
5973 sp = fetch_new_block(sp, &(ipc->y_u.sssl.l), ap, cint);
5974 sp = cross_block(sp, &(ae->u_a.labp), ap, cint);
5975 ipc = newpc;
5976 }
5977 } break;
5978 case _expand_index:
5979 ipc = pop_path(&sp, cls, ap, cint);
5980 break;
5981 case _expand_clauses:
5982 nullify_expand_clause(ipc, sp, cls);
5983 ipc = pop_path(&sp, cls, ap, cint);
5984 break;
5985 case _lock_lu:
5986 ipc = NEXTOP(ipc, p);
5987 break;
5988 default:
5989 if (IN_BETWEEN(bg, ipc, lt)) {
5990 sp = kill_unsafe_block(sp, op, ap, TRUE, TRUE, cls);
5991 }
5992 ipc = pop_path(&sp, cls, ap, cint);
5993 }
5994 }
5995}
5996
5997/* clause is locked */
5998void Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) {
5999 CACHE_REGS
6000 ClauseDef cl;
6001 /* first clause */
6002 path_stack_entry *stack, *sp;
6003 int cb;
6004 yamop *last;
6005 struct intermediates cint;
6006
6007 if (ap->PredFlags & MegaClausePredFlag) {
6008 return;
6009 }
6010 cint.expand_block = NULL;
6011 cint.CodeStart = cint.BlobsStart = cint.cpc = cint.icpc = NULL;
6012 if ((cb = sigsetjmp(cint.CompilerBotch, 0)) == 3) {
6013 restore_machine_regs();
6014 Yap_dogc(PASS_REGS1);
6015 save_machine_regs();
6016 } else if (cb == 2) {
6017 restore_machine_regs();
6018 Yap_growheap(FALSE, LOCAL_Error_Size, NULL);
6019 save_machine_regs();
6020 } else if (cb == 4) {
6021 restore_machine_regs();
6022 Yap_growtrail(LOCAL_Error_Size, FALSE);
6023 save_machine_regs();
6024 }
6025 LOCAL_Error_TYPE = YAP_NO_ERROR;
6026 cint.term_depth = cint.last_index_new_depth = cint.last_depth_size = 0L;
6027 if (cb || (ap->cs.p_code.NOfClauses == 2 &&
6028 ap->PredFlags & IndexedPredFlag)) {
6029 /* cannot rely on the code */
6030 if (ap->PredFlags & LogUpdatePredFlag) {
6031 Yap_kill_iblock(
6032 (ClauseUnion *)ClauseCodeToLogUpdIndex(ap->cs.p_code.TrueCodeOfPred),
6033 NULL, ap);
6034 } else {
6035 StaticIndex *cl;
6036 ap->PredFlags &= ~LogUpdatePredFlag;
6037 cl = ClauseCodeToStaticIndex(ap->cs.p_code.TrueCodeOfPred);
6038 Yap_kill_iblock((ClauseUnion *)cl, NULL, ap);
6039 }
6040 ap->PredFlags &= ~IndexedPredFlag;
6041 return;
6042 }
6043#if DEBUG
6044 if (GLOBAL_Option['i' - 'a' + 1]) {
6045 Term tmod = ap->ModuleOfPred;
6046
6047 if (!tmod)
6048 tmod = TermProlog;
6049 Yap_DebugPutc(stderr, '-');
6050 Yap_DebugPutc(stderr, '\t');
6051 Yap_DebugPlWrite(tmod);
6052 Yap_DebugPutc(stderr, ':');
6053 if (ap->ModuleOfPred != IDB_MODULE) {
6054 if (ap->ArityOfPE == 0) {
6055 Atom At = (Atom)ap->FunctorOfPred;
6056 Yap_DebugPlWrite(MkAtomTerm(At));
6057 } else {
6058 Functor f = ap->FunctorOfPred;
6059 Atom At = NameOfFunctor(f);
6060 Yap_DebugPlWrite(MkAtomTerm(At));
6061 Yap_DebugPutc(stderr, '/');
6062 Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f)));
6063 }
6064 } else {
6065 if (ap->PredFlags & NumberDBPredFlag) {
6066 Int id = ap->src.IndxId;
6067 Yap_DebugPlWrite(MkIntegerTerm(id));
6068 } else if (ap->PredFlags & AtomDBPredFlag) {
6069 Atom At = (Atom)ap->FunctorOfPred;
6070 Yap_DebugPlWrite(MkAtomTerm(At));
6071 } else {
6072 Functor f = ap->FunctorOfPred;
6073 Atom At = NameOfFunctor(f);
6074 Yap_DebugPlWrite(MkAtomTerm(At));
6075 Yap_DebugPutc(stderr, '/');
6076 Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f)));
6077 }
6078 }
6079 Yap_DebugPutc(stderr, '\n');
6080 }
6081#endif
6082 stack = (path_stack_entry *)TR;
6083 if (ap->PredFlags & LogUpdatePredFlag) {
6084 LogUpdClause *c = ClauseCodeToLogUpdClause(beg);
6085 cl.Code = cl.CurrentCode = beg;
6086 last = (yamop *)((CODEADDR)c + c->ClSize);
6087 } else {
6088 StaticClause *c = ClauseCodeToStaticClause(beg);
6089 cl.Code = cl.CurrentCode = beg;
6090 last = (yamop *)((CODEADDR)c + c->ClSize);
6091 }
6092 sp = push_path(stack, NULL, &cl, &cint);
6093 if (ap->cs.p_code.NOfClauses == 0) {
6094 /* there was no indexing code */
6095#if defined(YAPOR) || defined(THREADS)
6096 if (ap->PredFlags & LogUpdatePredFlag && ap->ModuleOfPred != IDB_MODULE) {
6097 ap->cs.p_code.TrueCodeOfPred = FAILCODE;
6098 ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
6099 } else {
6100#endif
6101 ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = FAILCODE;
6102#if defined(YAPOR) || defined(THREADS)
6103 }
6104#endif
6105 ap->OpcodeOfPred = Yap_opcode(_op_fail);
6106 } else if (ap->PredFlags & IndexedPredFlag) {
6107 remove_from_index(ap, sp, &cl, beg, last, &cint);
6108 } else if (ap->cs.p_code.NOfClauses == 1) {
6109 ap->cs.p_code.TrueCodeOfPred = ap->cs.p_code.FirstClause;
6110 ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
6111 }
6112}
6113
6114static void store_clause_choice_point(Term t1, Term tb, Term tr, yamop *ipc,
6115 PredEntry *pe, yamop *ap_pc,
6116 yamop *cp_pc USES_REGS) {
6117 Term tpc = MkIntegerTerm((Int)ipc);
6118 Term tpe = MkIntegerTerm((Int)pe);
6119 CELL *tsp = ASP - 5;
6120 choiceptr bptr = ((choiceptr)tsp) - 1;
6121
6122 tsp[0] = tpe;
6123 tsp[1] = tpc;
6124 tsp[2] = t1;
6125 tsp[3] = tb;
6126 tsp[4] = tr;
6127 bptr->cp_tr = TR;
6128 HB = bptr->cp_h = HR;
6129#ifdef DEPTH_LIMIT
6130 bptr->cp_depth = DEPTH;
6131#endif
6132 bptr->cp_b = B;
6133 bptr->cp_cp = cp_pc;
6134 bptr->cp_ap = ap_pc;
6135 bptr->cp_env = ENV;
6136 /* now, install the new YREG */
6137 ASP = (CELL *)bptr;
6138 ASP[E_CB] = (CELL)bptr;
6139 B = bptr;
6140#ifdef YAPOR
6141 SCH_set_load(B);
6142#endif /* YAPOR */
6143 SET_BB(bptr);
6144}
6145
6146static void update_clause_choice_point(yamop *ipc, yamop *ap_pc USES_REGS) {
6147 Term tpc = MkIntegerTerm((Int)ipc);
6148 B->cp_args[1] = tpc;
6149 B->cp_h = HR;
6150 B->cp_ap = ap_pc;
6151}
6152
6153static LogUpdClause *to_clause(yamop *ipc, PredEntry *ap) {
6154 if (ap->PredFlags & LogUpdatePredFlag)
6155 return lu_clause(ipc, ap);
6156 else if (ap->PredFlags & MegaClausePredFlag)
6157 return (LogUpdClause *)ipc;
6158 else
6159 return (LogUpdClause *)simple_static_clause(ipc, ap);
6160}
6161
6162LogUpdClause *Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, yhandle_t yht,
6163 yamop *ap_pc, yamop *cp_pc) {
6164 CACHE_REGS
6165 CELL *s_reg = NULL;
6166 Term t = TermNil;
6167 int blob_term = FALSE;
6168 choiceptr b0 = NULL;
6169#if defined(YAPOR) || defined(THREADS)
6170 yamop **jlbl = NULL;
6171#endif
6172 pred_flags_t lu_pred = ap->PredFlags & LogUpdatePredFlag;
6173 int unbounded = TRUE;
6174
6175 if (ap->ModuleOfPred != IDB_MODULE) {
6176 if (ap->ArityOfPE) {
6177 CELL *tar = RepAppl(Deref(Yap_GetFromHandle(yht)));
6178 UInt i;
6179
6180 for (i = 1; i <= ap->ArityOfPE; i++) {
6181 XREGS[i] = tar[i];
6182 }
6183 }
6184 }
6185 /* try to refine the interval using the indexing code */
6186 while (ipc != NULL) {
6187 op_numbers op = Yap_op_from_opcode(ipc->opc);
6188 switch (op) {
6189 case _try_in:
6190 update_clause_choice_point(NEXTOP(ipc, l), ap_pc PASS_REGS);
6191 if (lu_pred)
6192 return lu_clause(ipc->y_u.l.l, ap);
6193 else
6194 return (LogUpdClause *)static_clause(ipc->y_u.l.l, ap, unbounded);
6195 break;
6196 case _try_clause:
6197#if TABLING
6198 case _table_try:
6199#endif
6200 if (b0 == NULL)
6201 store_clause_choice_point(Yap_GetFromHandle(yht),
6202 Yap_GetFromHandle(yht+1),
6203 Yap_GetFromHandle(yht+2),
6204 NEXTOP(ipc, Otapl), ap, ap_pc,
6205 cp_pc PASS_REGS);
6206 else {
6207 B = b0;
6208 b0 = NULL;
6209 update_clause_choice_point(NEXTOP(ipc, Otapl), ap_pc PASS_REGS);
6210 }
6211 if (lu_pred)
6212 return lu_clause(ipc->y_u.Otapl.d, ap);
6213 else
6214 return (LogUpdClause *)static_clause(ipc->y_u.Otapl.d, ap, unbounded);
6215 case _try_clause2:
6216 case _try_clause3:
6217 case _try_clause4:
6218 if (b0 == NULL)
6219 store_clause_choice_point(Yap_GetFromHandle(yht),
6220 Yap_GetFromHandle(yht+1),
6221 Yap_GetFromHandle(yht+2),
6222 NEXTOP(ipc, l),
6223 ap, ap_pc, cp_pc PASS_REGS);
6224 else {
6225 B = b0;
6226 b0 = NULL;
6227 update_clause_choice_point(NEXTOP(ipc, l), ap_pc PASS_REGS);
6228 }
6229 if (lu_pred)
6230 return lu_clause(ipc->y_u.l.l, ap);
6231 else
6232 return (LogUpdClause *)static_clause(ipc->y_u.l.l, ap, unbounded);
6233 case _try_me:
6234#if TABLING
6235 case _table_try_me:
6236#endif
6237 if (b0 == NULL)
6238 store_clause_choice_point(Yap_GetFromHandle(yht),
6239 Yap_GetFromHandle(yht+1),
6240 Yap_GetFromHandle(yht+2),
6241 ipc->y_u.Otapl.d, ap, ap_pc, cp_pc PASS_REGS);
6242 else {
6243 B = b0;
6244 b0 = NULL;
6245 update_clause_choice_point(ipc->y_u.Otapl.d, ap_pc PASS_REGS);
6246 }
6247 ipc = NEXTOP(ipc, Otapl);
6248 break;
6249 case _retry_profiled:
6250 case _count_retry:
6251 ipc = NEXTOP(ipc, p);
6252 break;
6253 case _retry:
6254#if TABLING
6255 case _table_retry:
6256#endif
6257 update_clause_choice_point(NEXTOP(ipc, Otapl), ap_pc PASS_REGS);
6258 if (lu_pred)
6259 return lu_clause(ipc->y_u.Otapl.d, ap);
6260 else
6261 return (LogUpdClause *)static_clause(ipc->y_u.Otapl.d, ap, TRUE);
6262 case _retry2:
6263 case _retry3:
6264 case _retry4:
6265 update_clause_choice_point(NEXTOP(ipc, l), ap_pc PASS_REGS);
6266 if (lu_pred)
6267 return lu_clause(ipc->y_u.l.l, ap);
6268 else
6269 return (LogUpdClause *)static_clause(ipc->y_u.l.l, ap, TRUE);
6270 case _retry_me:
6271 update_clause_choice_point(ipc->y_u.Otapl.d, ap_pc PASS_REGS);
6272 ipc = NEXTOP(ipc, Otapl);
6273 break;
6274 case _trust:
6275#if TABLING
6276 case _table_trust:
6277#endif
6278 {
6279 while (POP_CHOICE_POINT(B->cp_b)) {
6280 POP_EXECUTE();
6281 }
6282 }
6283#ifdef YAPOR
6284 {
6285 choiceptr cut_pt;
6286 cut_pt = B->cp_b;
6287 CUT_prune_to(cut_pt);
6288 B = cut_pt;
6289 }
6290#else
6291 B = B->cp_b;
6292#endif /* YAPOR */
6293 b0 = B;
6294 if (lu_pred)
6295 return lu_clause(ipc->y_u.Otapl.d, ap);
6296 else
6297 return (LogUpdClause *)static_clause(ipc->y_u.Otapl.d, ap, TRUE);
6298 case _profiled_trust_me:
6299 case _trust_me:
6300 case _count_trust_me:
6301#if TABLING
6302 case _table_trust_me:
6303#endif
6304 b0 = B;
6305 {
6306 while (POP_CHOICE_POINT(B->cp_b)) {
6307 POP_EXECUTE();
6308 }
6309 }
6310#ifdef YAPOR
6311 {
6312 choiceptr cut_pt;
6313 cut_pt = B->cp_b;
6314 CUT_prune_to(cut_pt);
6315 B = cut_pt;
6316 }
6317#else
6318 B = B->cp_b;
6319#endif /* YAPOR */
6320 ipc = NEXTOP(ipc, Otapl);
6321 break;
6322 case _enter_lu_pred: {
6323 LogUpdIndex *cl = ipc->y_u.Illss.I;
6324 PredEntry *ap = cl->ClPred;
6325
6326 if (!cl)
6327 return NULL; /* in case the index is empty */
6328 if (ap->LastCallOfPred != LUCALL_EXEC) {
6329 /*
6330 only increment time stamp if we are working on current time
6331 stamp
6332 */
6333 if (ap->TimeStampOfPred >= TIMESTAMP_RESET)
6334 Yap_UpdateTimestamps(ap);
6335 ap->TimeStampOfPred++;
6336 /* fprintf(stderr,"R
6337 * %x--%d--%ul\n",ap,ap->TimeStampOfPred,ap->ArityOfPE);*/
6338 ap->LastCallOfPred = LUCALL_EXEC;
6339 }
6340 *--ASP = MkIntegerTerm(ap->TimeStampOfPred);
6341 /* indicate the indexing code is being used */
6342#if MULTIPLE_STACKS
6343 /* just store a reference */
6344 INC_CLREF_COUNT(cl);
6345 TRAIL_CLREF(cl);
6346#else
6347 if (!(cl->ClFlags & InUseMask)) {
6348 cl->ClFlags |= InUseMask;
6349 TRAIL_CLREF(cl);
6350 }
6351#endif
6352 }
6353 ipc = ipc->y_u.Illss.l1;
6354 break;
6355 case _try_logical:
6356 if (b0 == NULL)
6357 store_clause_choice_point(Yap_GetFromHandle(yht),
6358 Yap_GetFromHandle(yht+1),
6359 Yap_GetFromHandle(yht+2),
6360 ipc->y_u.OtaLl.n, ap, ap_pc, cp_pc PASS_REGS);
6361 else {
6362 B = b0;
6363 b0 = NULL;
6364 update_clause_choice_point(ipc->y_u.OtaLl.n, ap_pc PASS_REGS);
6365 }
6366 {
6367 UInt timestamp = IntegerOfTerm(((CELL *)(B + 1))[5]);
6368
6369 if (!VALID_TIMESTAMP(timestamp, ipc->y_u.OtaLl.d)) {
6370 /* jump to next instruction */
6371 ipc = ipc->y_u.OtaLl.n;
6372 break;
6373 }
6374 }
6375 return ipc->y_u.OtaLl.d;
6376 case _retry_logical:
6377 case _profiled_retry_logical:
6378 case _count_retry_logical: {
6379 UInt timestamp = IntegerOfTerm(((CELL *)(B + 1))[5]);
6380 if (!VALID_TIMESTAMP(timestamp, ipc->y_u.OtaLl.d)) {
6381 /* jump to next instruction */
6382 ipc = ipc->y_u.OtaLl.n;
6383 break;
6384 }
6385 }
6386 update_clause_choice_point(ipc->y_u.OtaLl.n, ap_pc PASS_REGS);
6387 return ipc->y_u.OtaLl.d;
6388#if TABLING
6389 case _table_try_single:
6390 return (LogUpdClause *)ClauseCodeToStaticClause(ipc);
6391#endif
6392 case _trust_logical:
6393 case _count_trust_logical:
6394 case _profiled_trust_logical: {
6395 UInt timestamp = IntegerOfTerm(((CELL *)(B + 1))[5]);
6396 LogUpdIndex *cl = ipc->y_u.OtILl.block;
6397 LogUpdClause *newpc;
6398
6399 if (!VALID_TIMESTAMP(timestamp, ipc->y_u.OtILl.d)) {
6400 /* jump to next instruction */
6401 newpc = NULL;
6402 } else {
6403 newpc = ipc->y_u.OtILl.d;
6404 }
6405#if MULTIPLE_STACKS
6406 DEC_CLREF_COUNT(cl);
6407 B->cp_tr--;
6408 TR--;
6409 /* actually get rid of the code */
6410 if (cl->ClRefCount == 0 && cl->ClFlags & (ErasedMask | DirtyMask)) {
6411 /* I am the last one using this clause, hence I don't need a lock
6412 to dispose of it. But on the other hand I need to make sure
6413 the clause is still there when I am back.
6414 */
6415 LogUpdClause *lcl = ipc->y_u.OtILl.d;
6416 if (newpc) {
6417 if (lcl->ClRefCount == 1) {
6418 /* make sure the clause isn't destroyed */
6419 /* always add an extra reference */
6420 INC_CLREF_COUNT(lcl);
6421 TRAIL_CLREF(lcl);
6422 B->cp_tr = TR;
6423 }
6424 }
6425 if (cl->ClFlags & ErasedMask) {
6426 Yap_ErLogUpdIndex(cl);
6427 } else {
6428 Yap_CleanUpIndex(cl);
6429 }
6430 }
6431#else
6432 if (TrailTerm(B->cp_tr - 1) == CLREF_TO_TRENTRY(cl) &&
6433 B->cp_tr != B->cp_b->cp_tr) {
6434
6435 B->cp_tr--;
6436 TR--;
6437 cl->ClFlags &= ~InUseMask;
6438 /* next, recover space for the indexing code if it was erased */
6439 if (cl->ClFlags & (ErasedMask | DirtyMask)) {
6440 LogUpdClause *lcl = ipc->y_u.OtILl.d;
6441 /* make sure we don't erase the clause we are jumping to, notice that
6442 ErLogUpdIndex may remove several references in one go.
6443 Notice we only need to do this if we´ re jumping to the clause.
6444 */
6445 if (newpc && !(lcl->ClFlags & (DirtyMask | InUseMask))) {
6446 lcl->ClFlags |= InUseMask;
6447 TRAIL_CLREF(lcl);
6448 }
6449 if (cl->ClFlags & ErasedMask) {
6450 Yap_ErLogUpdIndex(cl);
6451 } else {
6452 Yap_CleanUpIndex(cl);
6453 }
6454 }
6455 }
6456#endif
6457 {
6458 while (POP_CHOICE_POINT(B->cp_b)) {
6459 POP_EXECUTE();
6460 }
6461 }
6462#ifdef YAPOR
6463 {
6464 choiceptr cut_pt;
6465 cut_pt = B->cp_b;
6466 CUT_prune_to(cut_pt);
6467 B = cut_pt;
6468 }
6469#else
6470 B = B->cp_b;
6471#endif /* YAPOR */
6472 b0 = B;
6473 return newpc;
6474 }
6475 case _jump:
6476 ipc = ipc->y_u.l.l;
6477 break;
6478 case _jump_if_var: {
6479 Term t = Deref(ARG1);
6480 if (IsVarTerm(t)) {
6481 SET_JLBL(l.l);
6482 ipc = ipc->y_u.l.l;
6483 } else {
6484 ipc = NEXTOP(ipc, l);
6485 }
6486 } break;
6487 case _jump_if_nonvar: {
6488 Term t = Deref(XREGS[arg_from_x(ipc->y_u.xll.x)]);
6489 if (!IsVarTerm(t)) {
6490 SET_JLBL(xll.l1);
6491 ipc = ipc->y_u.xll.l1;
6492 } else {
6493 ipc = NEXTOP(ipc, xll);
6494 }
6495 } break;
6496 case _user_switch:
6497 ipc = ipc->y_u.lp.l;
6498 break;
6499 /* instructions type e */
6500 case _switch_on_type:
6501 t = Deref(ARG1);
6502 blob_term = FALSE;
6503 if (IsVarTerm(t)) {
6504 SET_JLBL(llll.l4);
6505 ipc = ipc->y_u.llll.l4;
6506 } else if (IsPairTerm(t)) {
6507 unbounded = FALSE;
6508 SET_JLBL(llll.l1);
6509 ipc = ipc->y_u.llll.l1;
6510 S = s_reg = RepPair(t);
6511 } else if (IsAtomOrIntTerm(t)) {
6512 SET_JLBL(llll.l2);
6513 ipc = ipc->y_u.llll.l2;
6514 } else {
6515 SET_JLBL(llll.l3);
6516 ipc = ipc->y_u.llll.l3;
6517 S = RepAppl(t);
6518 }
6519 break;
6520 case _switch_list_nl:
6521 t = Deref(ARG1);
6522 blob_term = FALSE;
6523 if (IsVarTerm(t)) {
6524 SET_JLBL(ollll.l4);
6525 ipc = ipc->y_u.ollll.l4;
6526 } else if (IsPairTerm(t)) {
6527 unbounded = FALSE;
6528 SET_JLBL(ollll.l1);
6529 ipc = ipc->y_u.ollll.l1;
6530 S = s_reg = RepPair(t);
6531 } else if (t == TermNil) {
6532 unbounded = FALSE;
6533 SET_JLBL(ollll.l2);
6534 ipc = ipc->y_u.ollll.l2;
6535 } else {
6536 SET_JLBL(ollll.l3);
6537 ipc = ipc->y_u.ollll.l3;
6538 S = RepAppl(t);
6539 }
6540 break;
6541 case _switch_on_arg_type:
6542 t = Deref(XREGS[arg_from_x(ipc->y_u.xllll.x)]);
6543 blob_term = FALSE;
6544 if (IsVarTerm(t)) {
6545 SET_JLBL(xllll.l4);
6546 ipc = ipc->y_u.xllll.l4;
6547 } else if (IsPairTerm(t)) {
6548 unbounded = FALSE;
6549 SET_JLBL(xllll.l1);
6550 ipc = ipc->y_u.xllll.l1;
6551 S = s_reg = RepPair(t);
6552 } else if (IsAtomOrIntTerm(t)) {
6553 SET_JLBL(xllll.l2);
6554 ipc = ipc->y_u.xllll.l2;
6555 } else {
6556 SET_JLBL(xllll.l3);
6557 ipc = ipc->y_u.xllll.l3;
6558 S = RepAppl(t);
6559 }
6560 break;
6561 case _switch_on_sub_arg_type:
6562 t = Deref(s_reg[ipc->y_u.sllll.s]);
6563 blob_term = FALSE;
6564 if (IsVarTerm(t)) {
6565 SET_JLBL(sllll.l4);
6566 ipc = ipc->y_u.sllll.l4;
6567 } else if (IsPairTerm(t)) {
6568 unbounded = FALSE;
6569 SET_JLBL(sllll.l1);
6570 S = s_reg = RepPair(t);
6571 ipc = ipc->y_u.sllll.l1;
6572 } else if (IsAtomOrIntTerm(t)) {
6573 SET_JLBL(sllll.l2);
6574 ipc = ipc->y_u.sllll.l2;
6575 } else {
6576 SET_JLBL(sllll.l3);
6577 ipc = ipc->y_u.sllll.l3;
6578 S = RepAppl(t);
6579 }
6580 break;
6581 case _if_not_then:
6582 t = Deref(ARG1);
6583 blob_term = FALSE;
6584 if (IsVarTerm(t)) {
6585 SET_JLBL(clll.l3);
6586 ipc = ipc->y_u.clll.l3;
6587 } else if (!IsVarTerm(t) && t != ipc->y_u.clll.c) {
6588 SET_JLBL(clll.l1);
6589 ipc = ipc->y_u.clll.l1;
6590 } else {
6591 SET_JLBL(clll.l2);
6592 ipc = ipc->y_u.clll.l2;
6593 }
6594 break;
6595 /* instructions type ollll */
6596 case _switch_on_func:
6597 case _if_func:
6598 case _go_on_func: {
6599 FuncSwiEntry *fe;
6600 Functor f;
6601
6602 unbounded = FALSE;
6603 s_reg = RepAppl(t);
6604 f = (Functor)s_reg[0];
6605 s_reg++;
6606 S = s_reg;
6607 if (op == _switch_on_func) {
6608 fe = lookup_f_hash(f, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
6609 } else {
6610 fe = lookup_f(f, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
6611 }
6612#if defined(YAPOR) || defined(THREADS)
6613 jlbl = &(fe->u_f.labp);
6614#endif
6615 ipc = fe->u_f.labp;
6616 } break;
6617 case _index_dbref:
6618 if (s_reg[-1] != (CELL)FunctorDBREF) {
6619 ipc = FAILCODE;
6620 break;
6621 }
6622 t = AbsAppl(s_reg - 1);
6623 blob_term = FALSE;
6624 ipc = NEXTOP(ipc, e);
6625 break;
6626 case _index_blob:
6627 if (s_reg[-1] != (CELL)FunctorDouble) {
6628 ipc = FAILCODE;
6629 break;
6630 }
6631 t = Yap_DoubleP_key(s_reg);
6632 blob_term = TRUE;
6633 ipc = NEXTOP(ipc, e);
6634 break;
6635 case _index_long:
6636 if (s_reg[-1] != (CELL)FunctorLongInt) {
6637 ipc = FAILCODE;
6638 break;
6639 }
6640 t = Yap_IntP_key(s_reg);
6641 blob_term = TRUE;
6642 ipc = NEXTOP(ipc, e);
6643 break;
6644 case _switch_on_cons:
6645 case _if_cons:
6646 case _go_on_cons: {
6647 AtomSwiEntry *ae;
6648
6649 unbounded = FALSE;
6650 if (op == _switch_on_cons) {
6651 ae = lookup_c_hash(t, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
6652 } else {
6653 ae = lookup_c(t, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
6654 }
6655#if defined(YAPOR) || defined(THREADS)
6656 jlbl = &(ae->u_a.labp);
6657#endif
6658 ipc = ae->u_a.labp;
6659 } break;
6660 case _expand_index:
6661 case _expand_clauses:
6662 {
6663 yhandle_t h1, h2;
6664 if (blob_term) { /* protect garbage collector */
6665 h1 = Yap_InitHandle( (CELL)&XREGS[ap->ArityOfPE + 1] );
6666 h2 = Yap_InitHandle( TermNil );
6667 } else {
6668 h1 = Yap_InitHandle( AbsPair(s_reg) );
6669 h2 = Yap_InitHandle( t );
6670 }
6671#if defined(YAPOR) || defined(THREADS)
6672 if (!same_lu_block(jlbl, ipc)) {
6673 ipc = *jlbl;
6674 break;
6675 }
6676#endif
6677 ipc = ExpandIndex(ap, 5, cp_pc PASS_REGS);
6678 if (!blob_term) { /* protect garbage collector */
6679 t = Yap_PopHandle(h2);
6680 s_reg = (CELL *)RepPair(Yap_PopHandle(h1));
6681 } else {
6682 Yap_PopHandle(h2);
6683 Yap_PopHandle(h1);
6684 }
6685 blob_term = FALSE;
6686 }
6687 break;
6688 case _undef_p:
6689 return NULL;
6690 case _lock_lu:
6691 ipc = NEXTOP(ipc, p);
6692 break;
6693#if THREADS
6694 case _thread_local:
6695 ap = Yap_GetThreadPred(ap PASS_REGS);
6696 ipc = ap->CodeOfPred;
6697 break;
6698#endif
6699 case _spy_pred:
6700 case _lock_pred:
6701 if ((ap->PredFlags & IndexedPredFlag) || ap->cs.p_code.NOfClauses <= 1) {
6702 ipc = ap->cs.p_code.TrueCodeOfPred;
6703 break;
6704 }
6705 case _index_pred:
6706 {
6707 yhandle_t h1, h2;
6708 if (blob_term) { /* protect garbage collector */
6709 h1 = Yap_InitHandle( (CELL)&XREGS[ap->ArityOfPE + 1] );
6710 h2 = Yap_InitHandle( TermNil );
6711 } else {
6712 h1 = Yap_InitHandle( (CELL)s_reg );
6713 h2 = Yap_InitHandle( t );
6714 }
6715#if defined(YAPOR) || defined(THREADS)
6716 if (!same_lu_block(jlbl, ipc)) {
6717 ipc = *jlbl;
6718 break;
6719 }
6720#endif
6721 Yap_IPred(ap, 5, cp_pc);
6722 ipc = ap->cs.p_code.TrueCodeOfPred;
6723 if (!blob_term) { /* protect garbage collector */
6724 t = Yap_PopHandle(h2);
6725 s_reg = (CELL *)Yap_PopHandle(h1);
6726 } else {
6727 Yap_PopHandle(h2);
6728 Yap_PopHandle(h1);
6729 }
6730 blob_term = FALSE;
6731 }
6732 break;
6733 case _op_fail:
6734 if (ipc == FAILCODE)
6735 return NULL;
6736 default:
6737 if (b0) {
6738 {
6739 while (POP_CHOICE_POINT(B->cp_b)) {
6740 POP_EXECUTE();
6741 }
6742 }
6743#ifdef YAPOR
6744 {
6745 choiceptr cut_pt;
6746 cut_pt = B->cp_b;
6747 CUT_prune_to(cut_pt);
6748 B = cut_pt;
6749 }
6750#else
6751 B = B->cp_b;
6752#endif /* YAPOR */
6753 /* I did a trust */
6754 }
6755 if (op == _op_fail)
6756 return NULL;
6757 if (lu_pred)
6758 return lu_clause(ipc, ap);
6759 else
6760 return (LogUpdClause *)static_clause(ipc, ap, unbounded);
6761 }
6762 }
6763 if (b0) {
6764 /* I did a trust */
6765 {
6766 while (POP_CHOICE_POINT(B->cp_b)) {
6767 POP_EXECUTE();
6768 }
6769 }
6770#ifdef YAPOR
6771 {
6772 choiceptr cut_pt;
6773 cut_pt = B->cp_b;
6774 CUT_prune_to(cut_pt);
6775 B = cut_pt;
6776 }
6777#else
6778 B = B->cp_b;
6779#endif /* YAPOR */
6780 }
6781 return NULL;
6782}
6783
6784LogUpdClause *Yap_NthClause(PredEntry *ap, Int ncls) {
6785 CACHE_REGS
6786 yamop *ipc = ap->cs.p_code.TrueCodeOfPred, *alt = NULL;
6787#if defined(YAPOR) || defined(THREADS)
6788 yamop **jlbl = NULL;
6789#endif
6790
6791 /* search every clause */
6792 if (ncls > ap->cs.p_code.NOfClauses)
6793 return NULL;
6794 else if (ncls == 1)
6795 return to_clause(ap->cs.p_code.FirstClause, ap);
6796 else if (ap->PredFlags & MegaClausePredFlag) {
6797 MegaClause *mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
6798 /* fast access to nth element, all have same size */
6799 return (LogUpdClause *)((char *)mcl->ClCode + (ncls - 1) * mcl->ClItemSize);
6800 } else if (ncls == ap->cs.p_code.NOfClauses) {
6801 return to_clause(ap->cs.p_code.LastClause, ap);
6802 } else if (ncls < 0)
6803 return NULL;
6804
6805 if (ap->ModuleOfPred != IDB_MODULE) {
6806 if (ap->ArityOfPE) {
6807 UInt i;
6808
6809 for (i = 1; i <= ap->ArityOfPE; i++) {
6810 XREGS[i] = MkVarTerm();
6811 }
6812 }
6813 } else {
6814 ARG2 = MkVarTerm();
6815 }
6816 while (TRUE) {
6817 op_numbers op = Yap_op_from_opcode(ipc->opc);
6818
6819 switch (op) {
6820 case _try_in:
6821 if (ncls == 1)
6822 return to_clause(ipc->y_u.l.l, ap);
6823 ncls--;
6824 ipc = NEXTOP(ipc, l);
6825 break;
6826 case _retry_profiled:
6827 case _count_retry:
6828 ipc = NEXTOP(ipc, p);
6829 case _try_clause:
6830 case _retry:
6831 if (ncls == 1)
6832 return to_clause(ipc->y_u.Otapl.d, ap);
6833 else if (alt == NULL) {
6834 ncls--;
6835 /* get there in a fell swoop */
6836 if (ap->PredFlags & ProfiledPredFlag) {
6837 if (ap->PredFlags & CountPredFlag) {
6838 ipc = (yamop *)((char *)ipc +
6839 ncls * (UInt)NEXTOP(
6840 NEXTOP(NEXTOP((yamop *)NULL, Otapl), p),
6841 p));
6842 } else {
6843 ipc =
6844 (yamop *)((char *)ipc +
6845 ncls * (UInt)NEXTOP(NEXTOP((yamop *)NULL, Otapl), p));
6846 }
6847 } else if (ap->PredFlags & CountPredFlag) {
6848 ipc = (yamop *)((char *)ipc +
6849 ncls * (UInt)NEXTOP(NEXTOP((yamop *)NULL, Otapl), p));
6850 } else {
6851 ipc = (yamop *)((char *)ipc +
6852 ncls * (UInt)NEXTOP((yamop *)NULL, Otapl));
6853 }
6854 return to_clause(ipc->y_u.Otapl.d, ap);
6855 } else {
6856 ncls--;
6857 }
6858 ipc = NEXTOP(ipc, Otapl);
6859 break;
6860 case _try_clause2:
6861 case _try_clause3:
6862 case _try_clause4:
6863 case _retry2:
6864 case _retry3:
6865 case _retry4:
6866 if (ncls == 1)
6867 return to_clause(ipc->y_u.l.l, ap);
6868 else if (alt == NULL) {
6869 ncls--;
6870 /* get there in a fell swoop */
6871 if (ap->PredFlags & ProfiledPredFlag) {
6872 if (ap->PredFlags & CountPredFlag) {
6873 ipc = (yamop *)((char *)ipc +
6874 ncls * (UInt)NEXTOP(
6875 NEXTOP(NEXTOP((yamop *)NULL, l), p), p));
6876 } else {
6877 ipc = (yamop *)((char *)ipc +
6878 ncls * (UInt)NEXTOP(NEXTOP((yamop *)NULL, l), p));
6879 }
6880 } else if (ap->PredFlags & CountPredFlag) {
6881 ipc = (yamop *)((char *)ipc +
6882 ncls * (UInt)NEXTOP(NEXTOP((yamop *)NULL, l), p));
6883 } else {
6884 ipc = (yamop *)((char *)ipc + ncls * (UInt)NEXTOP((yamop *)NULL, l));
6885 }
6886 return to_clause(ipc->y_u.l.l, ap);
6887 } else {
6888 ncls--;
6889 }
6890 ipc = NEXTOP(ipc, l);
6891 break;
6892 case _trust:
6893 if (ncls == 1)
6894 return to_clause(ipc->y_u.l.l, ap);
6895 ncls--;
6896 ipc = alt;
6897 break;
6898 case _try_me:
6899 case _retry_me:
6900 alt = ipc->y_u.Otapl.d;
6901 ipc = NEXTOP(ipc, Otapl);
6902 break;
6903 case _profiled_trust_me:
6904 case _trust_me:
6905 case _count_trust_me:
6906 alt = NULL;
6907 ipc = NEXTOP(ipc, Otapl);
6908 break;
6909 case _try_logical:
6910 case _retry_logical:
6911 case _count_retry_logical:
6912 case _profiled_retry_logical:
6913 if (VALID_TIMESTAMP(ap->TimeStampOfPred, ipc->y_u.OtaLl.d)) {
6914 if (ncls == 1)
6915 return ipc->y_u.OtaLl.d;
6916 ncls--;
6917 }
6918 ipc = ipc->y_u.OtaLl.n;
6919 break;
6920 case _trust_logical:
6921 case _count_trust_logical:
6922 case _profiled_trust_logical:
6923 if (VALID_TIMESTAMP(ap->TimeStampOfPred, ipc->y_u.OtILl.d)) {
6924 if (ncls == 1)
6925 return ipc->y_u.OtILl.d;
6926 }
6927 return NULL;
6928 case _enter_lu_pred:
6929 SET_JLBL(Illss.l1);
6930 ipc = ipc->y_u.Illss.l1;
6931 break;
6932 case _lock_lu:
6933 ipc = NEXTOP(ipc, p);
6934 break;
6935 case _jump:
6936 SET_JLBL(l.l);
6937 ipc = ipc->y_u.l.l;
6938 break;
6939 case _jump_if_var:
6940 SET_JLBL(l.l);
6941 ipc = ipc->y_u.l.l;
6942 break;
6943 case _jump_if_nonvar:
6944 ipc = NEXTOP(ipc, xll);
6945 break;
6946 case _user_switch:
6947 SET_JLBL(l.l);
6948 ipc = ipc->y_u.lp.l;
6949 break;
6950 /* instructions type e */
6951 case _switch_on_type:
6952 SET_JLBL(llll.l4);
6953 ipc = ipc->y_u.llll.l4;
6954 break;
6955 case _switch_list_nl:
6956 SET_JLBL(ollll.l4);
6957 ipc = ipc->y_u.ollll.l4;
6958 break;
6959 case _switch_on_arg_type:
6960 SET_JLBL(xllll.l4);
6961 ipc = ipc->y_u.xllll.l4;
6962 break;
6963 case _switch_on_sub_arg_type:
6964 SET_JLBL(sllll.l4);
6965 ipc = ipc->y_u.sllll.l4;
6966 break;
6967 case _if_not_then:
6968 SET_JLBL(clll.l3);
6969 ipc = ipc->y_u.clll.l3;
6970 break;
6971 case _expand_index:
6972 case _expand_clauses:
6973#if defined(YAPOR) || defined(THREADS)
6974 if (*jlbl != (yamop *)&(ap->cs.p_code.ExpandCode)) {
6975 ipc = *jlbl;
6976 break;
6977 }
6978#endif
6979 ipc = ExpandIndex(ap, 0, CP PASS_REGS);
6980
6981 break;
6982 case _op_fail:
6983 ipc = alt;
6984 break;
6985 case _lock_pred:
6986 case _index_pred:
6987 case _spy_pred:
6988 Yap_IPred(ap, 0, CP);
6989 ipc = ap->cs.p_code.TrueCodeOfPred;
6990 break;
6991 case _undef_p:
6992 default:
6993 return NULL;
6994 }
6995 }
6996}
6997
6998void Yap_CleanUpIndex(LogUpdIndex *blk) {
6999 /* just compact the code */
7000 yamop *start = blk->ClCode;
7001 op_numbers op = Yap_op_from_opcode(start->opc);
7002
7003 blk->ClFlags &= ~DirtyMask;
7004 while (op == _lock_lu) {
7005 start = NEXTOP(start, p);
7006 op = Yap_op_from_opcode(start->opc);
7007 }
7008 while (op == _jump_if_nonvar) {
7009 start = NEXTOP(start, xll);
7010 op = Yap_op_from_opcode(start->opc);
7011 }
7012 remove_dirty_clauses_from_index(start);
7013}
source
@ source
If true maintain the source for all clauses.
Definition: YapGFlagInfo.h:601
GroupDef
Definition: index.h:55
istack_entry
Definition: index.h:93
logic_upd_clause
Definition: clause.h:64
logic_upd_index
Definition: clause.h:46
path_stack_entry
Definition: index.h:101
pred_entry
Definition: Yatom.h:544
static_clause
Definition: clause.h:127
static_index
Definition: clause.h:116
static_mega_clause
Definition: clause.h:140
yami
Definition: amidefs.h:264
clause_obj
Definition: clause.h:152
clause_ptr
Definition: clause.h:161