YAP 7.1.0
tab.tries.c
1/************************************************************************
2** **
3** The YapTab/YapOr/OPTYap systems **
4** **
5** YapTab extends the Yap Prolog engine to support sequential tabling **
6** YapOr extends the Yap Prolog engine to support or-parallelism **
7** OPTYap extends the Yap Prolog engine to support or-parallel tabling **
8** **
9** **
10** Yap Prolog was developed at University of Porto, Portugal **
11** **
12************************************************************************/
13
14/************************************
15** Includes & Prototypes **
16************************************/
17
18#include "Yap.h"
19#ifdef TABLING
20#include "Yatom.h"
21#include "YapHeap.h"
22#include "YapEval.h"
23#include "tab.macros.h"
24
25static inline sg_node_ptr
26subgoal_trie_check_insert_entry(tab_ent_ptr, sg_node_ptr, Term USES_REGS);
27static inline sg_node_ptr
28subgoal_trie_check_insert_gt_entry(tab_ent_ptr, sg_node_ptr, Term USES_REGS);
29static inline ans_node_ptr
30answer_trie_check_insert_entry(sg_fr_ptr, ans_node_ptr, Term, int USES_REGS);
31static inline ans_node_ptr
32answer_trie_check_insert_gt_entry(sg_fr_ptr, ans_node_ptr, Term, int USES_REGS);
33static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr,
34 Term USES_REGS);
35#ifdef GLOBAL_TRIE_FOR_SUBTERMS
36static inline gt_node_ptr global_trie_check_insert_gt_entry(gt_node_ptr,
37 Term USES_REGS);
38#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
39static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr, sg_node_ptr, Term,
40 int *, CELL **USES_REGS);
41static inline sg_node_ptr subgoal_search_terms_loop(tab_ent_ptr, sg_node_ptr,
42 Term, int *,
43 CELL **USES_REGS);
44static inline ans_node_ptr answer_search_loop(sg_fr_ptr, ans_node_ptr, Term,
45 int *USES_REGS);
46static inline ans_node_ptr answer_search_terms_loop(sg_fr_ptr, ans_node_ptr,
47 Term, int *USES_REGS);
48#ifdef GLOBAL_TRIE_FOR_SUBTERMS
49static inline gt_node_ptr
50subgoal_search_global_trie_terms_loop(Term, int *, CELL **, CELL *USES_REGS);
51static inline gt_node_ptr answer_search_global_trie_terms_loop(Term, int *,
52 CELL *USES_REGS);
53#else
54static inline gt_node_ptr subgoal_search_global_trie_loop(Term, int *,
55 CELL **USES_REGS);
56static inline gt_node_ptr answer_search_global_trie_loop(Term, int *USES_REGS);
57#endif /* GLOBAL_TRIE_MODE */
58static inline CELL *load_answer_loop(ans_node_ptr USES_REGS);
59static inline CELL *load_substitution_loop(gt_node_ptr, int *, CELL *USES_REGS);
60static inline CELL *exec_substitution_loop(gt_node_ptr, CELL **,
61 CELL *USES_REGS);
62#ifdef MODE_DIRECTED_TABLING
63static inline ans_node_ptr answer_search_min_max(sg_fr_ptr, ans_node_ptr, Term,
64 int USES_REGS);
65static inline ans_node_ptr answer_search_sum(sg_fr_ptr, ans_node_ptr,
66 Term USES_REGS);
67static void invalidate_answer_trie(ans_node_ptr, sg_fr_ptr, int USES_REGS);
68#endif /* MODE_DIRECTED_TABLING */
69
70#ifdef YAPOR
71#ifdef TABLING_INNER_CUTS
72static int update_answer_trie_branch(ans_node_ptr, ans_node_ptr);
73#else /* YAPOR && ! TABLING_INNER_CUTS */
74static int update_answer_trie_branch(ans_node_ptr);
75#endif
76#else /* ! YAPOR */
77static void update_answer_trie_branch(ans_node_ptr, int);
78#endif
79#ifdef GLOBAL_TRIE_FOR_SUBTERMS
80static void free_global_trie_branch(gt_node_ptr, int USES_REGS);
81#else
82static void free_global_trie_branch(gt_node_ptr USES_REGS);
83#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
84static void traverse_subgoal_trie(sg_node_ptr, char *, int, int *, int,
85 int USES_REGS);
86static void traverse_answer_trie(ans_node_ptr, char *, int, int *, int, int,
87 int USES_REGS);
88static void traverse_global_trie(gt_node_ptr, char *, int, int *, int,
89 int USES_REGS);
90static void traverse_global_trie_for_term(gt_node_ptr, char *, int *, int *,
91 int *, int USES_REGS);
92static inline void traverse_trie_node(Term, char *, int *, int *, int *,
93 int USES_REGS);
94static inline void traverse_update_arity(char *, int *, int *);
95
96/*******************************
97** Structs & Macros **
98*******************************/
99
100static struct trie_statistics {
101 FILE *out;
102 int show;
103 long subgoals;
104 long subgoals_incomplete;
105 long subgoal_trie_nodes;
106 long answers;
107#ifdef TABLING_INNER_CUTS
108 long answers_pruned;
109#endif /* TABLING_INNER_CUTS */
110 long answers_true;
111 long answers_no;
112 long answer_trie_nodes;
113 long global_trie_terms;
114 long global_trie_nodes;
115 long global_trie_references;
116}
117#ifdef THREADS
118trie_stats[MAX_THREADS];
119
120#define TrStat_out trie_stats[worker_id].out
121#define TrStat_show trie_stats[worker_id].show
122#define TrStat_subgoals trie_stats[worker_id].subgoals
123#define TrStat_sg_incomplete trie_stats[worker_id].subgoals_incomplete
124#define TrStat_sg_nodes trie_stats[worker_id].subgoal_trie_nodes
125#define TrStat_answers trie_stats[worker_id].answers
126#define TrStat_answers_true trie_stats[worker_id].answers_true
127#define TrStat_answers_no trie_stats[worker_id].answers_no
128#define TrStat_answers_pruned trie_stats[worker_id].answers_pruned
129#define TrStat_ans_nodes trie_stats[worker_id].answer_trie_nodes
130#define TrStat_gt_terms trie_stats[worker_id].global_trie_terms
131#define TrStat_gt_nodes trie_stats[worker_id].global_trie_nodes
132#define TrStat_gt_refs trie_stats[worker_id].global_trie_references
133#else
134trie_stats;
135
136#define TrStat_out trie_stats.out
137#define TrStat_show trie_stats.show
138#define TrStat_subgoals trie_stats.subgoals
139#define TrStat_sg_incomplete trie_stats.subgoals_incomplete
140#define TrStat_sg_nodes trie_stats.subgoal_trie_nodes
141#define TrStat_answers trie_stats.answers
142#define TrStat_answers_true trie_stats.answers_true
143#define TrStat_answers_no trie_stats.answers_no
144#define TrStat_answers_pruned trie_stats.answers_pruned
145#define TrStat_ans_nodes trie_stats.answer_trie_nodes
146#define TrStat_gt_terms trie_stats.global_trie_terms
147#define TrStat_gt_nodes trie_stats.global_trie_nodes
148#define TrStat_gt_refs trie_stats.global_trie_references
149#endif /*THREADS */
150
151#if defined(THREADS_SUBGOAL_SHARING) || defined(THREADS_FULL_SHARING) || \
152 defined(THREADS_CONSUMER_SHARING)
153#define IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES \
154 if (GLOBAL_NOfThreads == 1)
155#else
156#define IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES
157#endif /* THREADS_SUBGOAL_SHARING || THREADS_FULL_SHARING || \
158 THREADS_CONSUMER_SHARING */
159
160#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
161#define IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES \
162 if (GLOBAL_NOfThreads == 1)
163#else
164#define IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES
165#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
166
167#define SHOW_TABLE_STR_ARRAY_SIZE 100000
168#define SHOW_TABLE_ARITY_ARRAY_SIZE 10000
169#define SHOW_TABLE_STRUCTURE( ...) \
170 if (TrStat_show == SHOW_MODE_STRUCTURE) \
171 fprintf(TrStat_out, __VA_ARGS__ )
172
173#define CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF, MODE) \
174 if (MODE == TRAVERSE_MODE_NORMAL && IsVarTerm(REF) && \
175 REF > VarIndexOfTableTerm(MAX_TABLE_VARS)) { \
176 register gt_node_ptr gt_node = (gt_node_ptr)(REF); \
177 TrNode_child(gt_node) = \
178 (gt_node_ptr)((uintptr_t)TrNode_child(gt_node) - 1); \
179 if (TrNode_child(gt_node) == 0) \
180 FREE_GLOBAL_TRIE_BRANCH(gt_node, TRAVERSE_MODE_NORMAL); \
181 }
182#ifdef GLOBAL_TRIE_FOR_SUBTERMS
183#define CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(REF, MODE) \
184 CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF, MODE)
185#define FREE_GLOBAL_TRIE_BRANCH(NODE, MODE) \
186 free_global_trie_branch(NODE, MODE PASS_REGS)
187#else
188#define CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(REF, MODE)
189#define FREE_GLOBAL_TRIE_BRANCH(NODE, MODE) \
190 free_global_trie_branch(NODE PASS_REGS)
191#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
192
193/******************************
194** Rational Terms Support **
195******************************/
196#ifdef TRIE_RATIONAL_TERMS
197#include "tab.rational.h"
198#endif /* RATIONAL TERM SUPPORT FOR TRIES */
199
200/******************************
201** Local functions **
202******************************/
203
204#define INCLUDE_SUBGOAL_TRIE_CHECK_INSERT /* subgoal_trie_check_insert_entry \
205 */
206#define INCLUDE_ANSWER_TRIE_CHECK_INSERT /* answer_trie_check_insert_entry */
207#define INCLUDE_GLOBAL_TRIE_CHECK_INSERT /* global_trie_check_insert_entry */
208#include "tab.tries.h"
209#undef INCLUDE_GLOBAL_TRIE_CHECK_INSERT
210#undef INCLUDE_ANSWER_TRIE_CHECK_INSERT
211#undef INCLUDE_SUBGOAL_TRIE_CHECK_INSERT
212
213#define MODE_GLOBAL_TRIE_ENTRY
214#define INCLUDE_SUBGOAL_TRIE_CHECK_INSERT /* subgoal_trie_check_insert_gt_entry \
215 */
216#define INCLUDE_ANSWER_TRIE_CHECK_INSERT /* answer_trie_check_insert_gt_entry \
217 */
218#ifdef GLOBAL_TRIE_FOR_SUBTERMS
219#define INCLUDE_GLOBAL_TRIE_CHECK_INSERT /* global_trie_check_insert_gt_entry \
220 */
221#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
222#include "tab.tries.h"
223#undef INCLUDE_GLOBAL_TRIE_CHECK_INSERT
224#undef INCLUDE_ANSWER_TRIE_CHECK_INSERT
225#undef INCLUDE_SUBGOAL_TRIE_CHECK_INSERT
226#undef MODE_GLOBAL_TRIE_ENTRY
227
228#define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_loop */
229#define INCLUDE_ANSWER_SEARCH_LOOP /* answer_search_loop */
230#define INCLUDE_LOAD_ANSWER_LOOP /* load_answer_loop */
231#include "tab.tries.h"
232#undef INCLUDE_LOAD_ANSWER_LOOP
233#undef INCLUDE_ANSWER_SEARCH_LOOP
234#undef INCLUDE_SUBGOAL_SEARCH_LOOP
235
236#define MODE_TERMS_LOOP
237#define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_terms_loop */
238#define INCLUDE_ANSWER_SEARCH_LOOP /* answer_search_terms_loop */
239#ifdef TRIE_RATIONAL_TERMS
240#undef TRIE_RATIONAL_TERMS
241#include "tab.tries.h"
242#define TRIE_RATIONAL_TERMS
243#else
244#include "tab.tries.h"
245#endif
246#undef INCLUDE_ANSWER_SEARCH_LOOP
247#undef INCLUDE_SUBGOAL_SEARCH_LOOP
248#undef MODE_TERMS_LOOP
249
250#define MODE_GLOBAL_TRIE_LOOP
251#define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_global_trie_(terms)_loop \
252 */
253#define INCLUDE_ANSWER_SEARCH_LOOP /* answer_search_global_trie_(terms)_loop \
254 */
255#define INCLUDE_LOAD_ANSWER_LOOP /* load_substitution_loop */
256#ifdef TRIE_RATIONAL_TERMS
257#undef TRIE_RATIONAL_TERMS
258#include "tab.tries.h"
259#define TRIE_RATIONAL_TERMS
260#else
261#include "tab.tries.h"
262#endif
263#undef INCLUDE_LOAD_ANSWER_LOOP
264#undef INCLUDE_ANSWER_SEARCH_LOOP
265#undef INCLUDE_SUBGOAL_SEARCH_LOOP
266#undef MODE_GLOBAL_TRIE_LOOP
267
268#ifdef MODE_DIRECTED_TABLING
269#define INCLUDE_ANSWER_SEARCH_MODE_DIRECTED
270#include "tab.tries.h" /* answer_search_min_max + answer_search_sum + invalidate_answer_trie */
271#undef INCLUDE_ANSWER_SEARCH_MODE_DIRECTED
272#endif /* MODE_DIRECTED_TABLING */
273
274static inline CELL *exec_substitution_loop(gt_node_ptr current_node,
275 CELL **stack_vars_ptr,
276 CELL *stack_terms USES_REGS) {
277 /************************************************************************
278 ===========
279 | |
280 | ... |
281 | |
282 -----------
283 YENV --> | N+1 | <-- stack_vars
284 -----------
285 | VAR_N |
286 -----------
287 | ... |
288 -----------
289 | VAR_0 |
290 -----------
291 | |
292 | ... |
293 | |
294 ===========
295 | |
296 | ... |
297 | |
298 -----------
299 TR --> | | <-- stack_terms_limit
300 -----------
301 | |
302 | ... |
303 | |
304 ----------|
305 | TERM_N | <-- stack_terms
306 ----------| *
307 | ... | /|\
308 ----------| | stack_terms_pair_offset
309 (TRIE_COMPACT_PAIRS)
310 | TERM_1 | \|/
311 =========== *
312 LOCAL_TrailTop --> | | <-- stack_terms_base (TRIE_COMPACT_PAIRS)
313 -----------
314 ************************************************************************/
315 CELL *stack_vars = *stack_vars_ptr;
316 CELL *stack_terms_limit = (CELL *)TR;
317#ifdef TRIE_COMPACT_PAIRS
318#define stack_terms_base ((CELL *)LOCAL_TrailTop)
319 int stack_terms_pair_offset = 0;
320#endif /* TRIE_COMPACT_PAIRS */
321 Term t = TrNode_entry(current_node);
322 current_node = TrNode_parent(current_node);
323
324 do {
325 if (IsVarTerm(t)) {
326#ifdef GLOBAL_TRIE_FOR_SUBTERMS
327 if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) {
328 stack_terms = exec_substitution_loop((gt_node_ptr)t, &stack_vars,
329 stack_terms PASS_REGS);
330 } else
331#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
332 {
333 int var_index = VarIndexOfTableTerm(t);
334 int vars_arity = *stack_vars;
335 t = MkVarTerm();
336 if (var_index >= vars_arity) {
337 while (vars_arity < var_index) {
338 *stack_vars-- = 0;
339 vars_arity++;
340 }
341 *stack_vars-- = t;
342 vars_arity++;
343 *stack_vars = vars_arity;
344 } else {
345 /* do the same as in macro stack_trie_val_instr() */
346 CELL aux_sub, aux_var, *vars_ptr;
347 vars_ptr = stack_vars + vars_arity - var_index;
348 aux_sub = *((CELL *)t);
349 aux_var = *vars_ptr;
350 if (aux_var == 0) {
351 *vars_ptr = t;
352 } else {
353 if (aux_sub > aux_var) {
354 if ((CELL *)aux_sub <= HR) {
355 Bind_Global((CELL *)aux_sub, aux_var);
356 } else if ((CELL *)aux_var <= HR) {
357 Bind_Local((CELL *)aux_sub, aux_var);
358 } else {
359 Bind_Local((CELL *)aux_var, aux_sub);
360 *vars_ptr = aux_sub;
361 }
362 } else {
363 if ((CELL *)aux_var <= HR) {
364 Bind_Global((CELL *)aux_var, aux_sub);
365 *vars_ptr = aux_sub;
366 } else if ((CELL *)aux_sub <= HR) {
367 Bind_Local((CELL *)aux_var, aux_sub);
368 *vars_ptr = aux_sub;
369 } else {
370 Bind_Local((CELL *)aux_sub, aux_var);
371 }
372 }
373 }
374 }
375 AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit);
376 STACK_PUSH_UP(t, stack_terms);
377 }
378 } else if (IsAtomOrIntTerm(t)) {
379 AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit);
380 STACK_PUSH_UP(t, stack_terms);
381 } else if (IsPairTerm(t)) {
382#ifdef TRIE_COMPACT_PAIRS
383 if (t == CompactPairInit) {
384 Term *stack_aux = stack_terms_base - stack_terms_pair_offset;
385 Term head, tail = STACK_POP_UP(stack_aux);
386 while (STACK_NOT_EMPTY(stack_aux, stack_terms)) {
387 head = STACK_POP_UP(stack_aux);
388 tail = MkPairTerm(head, tail);
389 }
390 stack_terms = stack_terms_base - stack_terms_pair_offset;
391 stack_terms_pair_offset = (int)STACK_POP_DOWN(stack_terms);
392 STACK_PUSH_UP(tail, stack_terms);
393 } else { /* CompactPairEndList / CompactPairEndTerm */
394 Term last;
395 AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1);
396 last = STACK_POP_DOWN(stack_terms);
397 STACK_PUSH_UP(stack_terms_pair_offset, stack_terms);
398 stack_terms_pair_offset = (int)(stack_terms_base - stack_terms);
399 if (t == CompactPairEndList)
400 STACK_PUSH_UP(TermNil, stack_terms);
401 STACK_PUSH_UP(last, stack_terms);
402 }
403#else
404 Term head = STACK_POP_DOWN(stack_terms);
405 Term tail = STACK_POP_DOWN(stack_terms);
406 t = MkPairTerm(head, tail);
407 STACK_PUSH_UP(t, stack_terms);
408#endif /* TRIE_COMPACT_PAIRS */
409 } else if (IsApplTerm(t)) {
410 Functor f = (Functor)RepAppl(t);
411 if (f == FunctorDouble) {
412 union {
413 Term t_dbl[sizeof(Float) / sizeof(Term)];
414 Float dbl;
415 } u;
416 t = TrNode_entry(current_node);
417 current_node = TrNode_parent(current_node);
418 u.t_dbl[0] = t;
419#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
420 t = TrNode_entry(current_node);
421 current_node = TrNode_parent(current_node);
422 u.t_dbl[1] = t;
423#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
424 current_node = TrNode_parent(current_node);
425 t = MkFloatTerm(u.dbl);
426 } else if (f == FunctorLongInt) {
427 Int li = TrNode_entry(current_node);
428 current_node = TrNode_parent(current_node);
429 current_node = TrNode_parent(current_node);
430 t = MkLongIntTerm(li);
431 } else {
432 int f_arity = ArityOfFunctor(f);
433 t = Yap_MkApplTerm(f, f_arity, stack_terms);
434 stack_terms += f_arity;
435 }
436 AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit);
437 STACK_PUSH_UP(t, stack_terms);
438 }
439 t = TrNode_entry(current_node);
440 current_node = TrNode_parent(current_node);
441 } while (current_node);
442
443 *stack_vars_ptr = stack_vars;
444 return stack_terms;
445
446#ifdef TRIE_COMPACT_PAIRS
447#undef stack_terms_base
448#endif /* TRIE_COMPACT_PAIRS */
449}
450
451#ifdef YAPOR
452#ifdef TABLING_INNER_CUTS
453static int update_answer_trie_branch(ans_node_ptr previous_node,
454 ans_node_ptr current_node) {
455 int ltt;
456 if (!IS_ANSWER_LEAF_NODE(current_node)) {
457 if (TrNode_child(current_node)) {
458 TrNode_instr(TrNode_child(current_node)) -= 1; /* retry --> try */
459 update_answer_trie_branch(NULL, TrNode_child(current_node));
460 if (TrNode_child(current_node))
461 goto update_next_trie_branch;
462 }
463 /* node belonging to a pruned answer */
464 if (previous_node) {
465 TrNode_next(previous_node) = TrNode_next(current_node);
466 FREE_ANSWER_TRIE_NODE(current_node);
467 if (TrNode_next(previous_node)) {
468 return update_answer_trie_branch(previous_node,
469 TrNode_next(previous_node));
470 } else {
471 TrNode_instr(previous_node) -= 2; /* retry --> trust : try --> do */
472 return 0;
473 }
474 } else {
475 TrNode_child(TrNode_parent(current_node)) = TrNode_next(current_node);
476 if (TrNode_next(current_node)) {
477 TrNode_instr(TrNode_next(current_node)) -= 1; /* retry --> try */
478 update_answer_trie_branch(NULL, TrNode_next(current_node));
479 }
480 FREE_ANSWER_TRIE_NODE(current_node);
481 return 0;
482 }
483 }
484update_next_trie_branch:
485 if (TrNode_next(current_node)) {
486 ltt =
487 1 + update_answer_trie_branch(current_node, TrNode_next(current_node));
488 } else {
489 TrNode_instr(current_node) -= 2; /* retry --> trust : try --> do */
490 ltt = 1;
491 }
492
493 TrNode_or_arg(current_node) = ltt;
494 TrNode_instr(current_node) = Yap_opcode(TrNode_instr(current_node));
495 return ltt;
496}
497#else /* YAPOR && ! TABLING_INNER_CUTS */
498static int update_answer_trie_branch(ans_node_ptr current_node) {
499 int ltt;
500 if (!IS_ANSWER_LEAF_NODE(current_node)) {
501 TrNode_instr(TrNode_child(current_node)) -= 1; /* retry --> try */
502 update_answer_trie_branch(TrNode_child(current_node));
503 }
504 if (TrNode_next(current_node)) {
505 ltt = 1 + update_answer_trie_branch(TrNode_next(current_node));
506 } else {
507 TrNode_instr(current_node) -= 2; /* retry --> trust : try --> do */
508 ltt = 1;
509 }
510 TrNode_or_arg(current_node) = ltt;
511 TrNode_instr(current_node) = Yap_opcode(TrNode_instr(current_node));
512 return ltt;
513}
514#endif
515#else /* ! YAPOR */
516static void update_answer_trie_branch(ans_node_ptr current_node, int position) {
517 if (!IS_ANSWER_LEAF_NODE(current_node))
518 update_answer_trie_branch(TrNode_child(current_node),
519 TRAVERSE_POSITION_FIRST); /* retry --> try */
520 if (position == TRAVERSE_POSITION_FIRST) {
521 ans_node_ptr next = TrNode_next(current_node);
522 if (next) {
523 while (TrNode_next(next)) {
524 update_answer_trie_branch(next,
525 TRAVERSE_POSITION_NEXT); /* retry --> retry */
526 next = TrNode_next(next);
527 }
528 update_answer_trie_branch(next,
529 TRAVERSE_POSITION_LAST); /* retry --> trust */
530 } else
531 position += TRAVERSE_POSITION_LAST; /* try --> do */
532 }
533 TrNode_instr(current_node) =
534 Yap_opcode(TrNode_instr(current_node) - position);
535 return;
536}
537
538#endif /* YAPOR */
539
540#ifdef GLOBAL_TRIE_FOR_SUBTERMS
541static void free_global_trie_branch(gt_node_ptr current_node,
542 int mode USES_REGS) {
543 Term t = TrNode_entry(current_node);
544#else
545static void free_global_trie_branch(gt_node_ptr current_node USES_REGS) {
546#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
547 gt_node_ptr parent_node, child_node;
548
549 parent_node = TrNode_parent(current_node);
550 child_node = TrNode_child(parent_node);
551 if (IS_GLOBAL_TRIE_HASH(child_node)) {
552 gt_hash_ptr hash = (gt_hash_ptr)child_node;
553 gt_node_ptr *bucket =
554 Hash_buckets(hash) +
555 HASH_ENTRY(TrNode_entry(current_node), Hash_num_buckets(hash));
556 int num_nodes = --Hash_num_nodes(hash);
557 child_node = *bucket;
558 if (child_node != current_node) {
559 while (TrNode_next(child_node) != current_node)
560 child_node = TrNode_next(child_node);
561 TrNode_next(child_node) = TrNode_next(current_node);
562 CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode);
563 FREE_GLOBAL_TRIE_NODE(current_node);
564 } else {
565 *bucket = TrNode_next(current_node);
566 CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode);
567 FREE_GLOBAL_TRIE_NODE(current_node);
568 if (num_nodes == 0) {
569 FREE_BUCKETS(Hash_buckets(hash));
570 FREE_GLOBAL_TRIE_HASH(hash);
571 if (parent_node != GLOBAL_root_gt) {
572#ifdef GLOBAL_TRIE_FOR_SUBTERMS
573 if (mode == TRAVERSE_MODE_NORMAL) {
574 if (IsApplTerm(t)) {
575 Functor f = (Functor)RepAppl(t);
576 if (f == FunctorDouble)
577 mode = TRAVERSE_MODE_DOUBLE;
578 else if (f == FunctorLongInt)
579 mode = TRAVERSE_MODE_LONGINT;
580 else if (f == FunctorBigInt || f == FunctorString)
581 mode = TRAVERSE_MODE_BIGINT_OR_STRING;
582 else
583 mode = TRAVERSE_MODE_NORMAL;
584 } else
585 mode = TRAVERSE_MODE_NORMAL;
586 } else if (mode == TRAVERSE_MODE_LONGINT)
587 mode = TRAVERSE_MODE_LONGINT_END;
588 } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING)
589 mode = TRAVERSE_MODE_BIGINT_OR_STRING_END;
590 else if (mode == TRAVERSE_MODE_DOUBLE)
591#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
592 mode = TRAVERSE_MODE_DOUBLE2;
593 else if (mode == TRAVERSE_MODE_DOUBLE2)
594#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
595 mode = TRAVERSE_MODE_DOUBLE_END;
596 else
597 mode = TRAVERSE_MODE_NORMAL;
598#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
599 FREE_GLOBAL_TRIE_BRANCH(parent_node, mode);
600 } else
601 TrNode_child(parent_node) = NULL;
602 }
603 }
604}
605else if (child_node != current_node) {
606 while (TrNode_next(child_node) != current_node)
607 child_node = TrNode_next(child_node);
608 TrNode_next(child_node) = TrNode_next(current_node);
609 CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode);
610 FREE_GLOBAL_TRIE_NODE(current_node);
611}
612else if (TrNode_next(current_node) == NULL) {
613 CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode);
614 FREE_GLOBAL_TRIE_NODE(current_node);
615 if (parent_node != GLOBAL_root_gt) {
616#ifdef GLOBAL_TRIE_FOR_SUBTERMS
617 if (mode == TRAVERSE_MODE_NORMAL) {
618 if (IsApplTerm(t)) {
619 Functor f = (Functor)RepAppl(t);
620 if (f == FunctorDouble)
621 mode = TRAVERSE_MODE_DOUBLE;
622 else if (f == FunctorLongInt)
623 mode = TRAVERSE_MODE_LONGINT;
624 else if (f == FunctorBigInt || f == FunctorString)
625 mode = TRAVERSE_MODE_BIGINT_OR_STRING;
626 else
627 mode = TRAVERSE_MODE_NORMAL;
628 } else
629 mode = TRAVERSE_MODE_NORMAL;
630 } else if (mode == TRAVERSE_MODE_LONGINT) {
631 mode = TRAVERSE_MODE_LONGINT_END;
632 } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) {
633 mode = TRAVERSE_MODE_BIGINT_OR_STRING_END;
634 } else if (mode == TRAVERSE_MODE_DOUBLE)
635#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
636 mode = TRAVERSE_MODE_DOUBLE2;
637 else if (mode == TRAVERSE_MODE_DOUBLE2)
638#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
639 mode = TRAVERSE_MODE_DOUBLE_END;
640 else
641 mode = TRAVERSE_MODE_NORMAL;
642#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
643 FREE_GLOBAL_TRIE_BRANCH(parent_node, mode);
644 } else
645 TrNode_child(parent_node) = NULL;
646}
647else {
648 TrNode_child(parent_node) = TrNode_next(current_node);
649 CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode);
650 FREE_GLOBAL_TRIE_NODE(current_node);
651}
652return;
653}
654
655static void traverse_subgoal_trie(sg_node_ptr current_node, char *str,
656 int str_index, int *arity, int mode,
657 int position USES_REGS) {
658 int *current_arity = NULL, current_str_index = 0, current_mode = 0;
659
660 /* test if hashing */
661 if (IS_SUBGOAL_TRIE_HASH(current_node)) {
662 sg_node_ptr *bucket, *last_bucket;
663 sg_hash_ptr hash;
664 hash = (sg_hash_ptr)current_node;
665 bucket = Hash_buckets(hash);
666 last_bucket = bucket + Hash_num_buckets(hash);
667 current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1));
668 memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
669 do {
670 if (*bucket) {
671 traverse_subgoal_trie(*bucket, str, str_index, arity, mode,
672 TRAVERSE_POSITION_FIRST PASS_REGS);
673 memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
674#ifdef TRIE_COMPACT_PAIRS
675 if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
676 str[str_index - 1] = ',';
677#else
678 if (arity[arity[0]] == -1)
679 str[str_index - 1] = '|';
680#endif /* TRIE_COMPACT_PAIRS */
681 }
682 } while (++bucket != last_bucket);
683 free(current_arity);
684 return;
685 }
686
687 /* save current state if first sibling node */
688 if (position == TRAVERSE_POSITION_FIRST) {
689 current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1));
690 memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
691 current_str_index = str_index;
692 current_mode = mode;
693 }
694
695 /* process current trie node */
696 TrStat_sg_nodes++;
697 traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode,
698 TRAVERSE_TYPE_SUBGOAL PASS_REGS);
699
700 /* show answers ... */
701 if (IS_SUBGOAL_LEAF_NODE(current_node)) {
702 sg_fr_ptr sg_fr = get_subgoal_frame(current_node);
703 if (sg_fr) {
704 TrStat_subgoals++;
705 str[str_index] = 0;
706 SHOW_TABLE_STRUCTURE("%s.\n", str);
707 TrStat_ans_nodes++;
708 if (SgFr_first_answer(sg_fr) == NULL) {
709 if (SgFr_state(sg_fr) < complete) {
710 TrStat_sg_incomplete++;
711 SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n");
712 } else {
713 TrStat_answers_no++;
714 SHOW_TABLE_STRUCTURE(" NO\n");
715 }
716 } else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
717 TrStat_answers_true++;
718 SHOW_TABLE_STRUCTURE(" TRUE\n");
719 } else {
720 arity[0] = 0;
721 traverse_answer_trie(TrNode_child(SgFr_answer_trie(sg_fr)),
722 &str[str_index], 0, arity, 0, TRAVERSE_MODE_NORMAL,
723 TRAVERSE_POSITION_FIRST PASS_REGS);
724 if (SgFr_state(sg_fr) < complete) {
725 TrStat_sg_incomplete++;
726 SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n");
727 }
728 }
729 }
730 } else
731 /* ... or continue with child node */
732 traverse_subgoal_trie(TrNode_child(current_node), str, str_index, arity,
733 mode, TRAVERSE_POSITION_FIRST PASS_REGS);
734 /* restore the initial state and continue with sibling nodes */
735 if (position == TRAVERSE_POSITION_FIRST) {
736 str_index = current_str_index;
737 mode = current_mode;
738 current_node = TrNode_next(current_node);
739 while (current_node) {
740 memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
741#ifdef TRIE_COMPACT_PAIRS
742 if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
743 str[str_index - 1] = ',';
744#else
745 if (arity[arity[0]] == -1)
746 str[str_index - 1] = '|';
747#endif /* TRIE_COMPACT_PAIRS */
748 traverse_subgoal_trie(current_node, str, str_index, arity, mode,
749 TRAVERSE_POSITION_NEXT PASS_REGS);
750 current_node = TrNode_next(current_node);
751 }
752 free(current_arity);
753 }
754 return;
755}
756
757static void traverse_answer_trie(ans_node_ptr current_node, char *str,
758 int str_index, int *arity, int var_index,
759 int mode, int position USES_REGS) {
760 int *current_arity = NULL, current_str_index = 0, current_var_index = 0,
761 current_mode = 0;
762
763 /* test if hashing */
764 if (IS_ANSWER_TRIE_HASH(current_node)) {
765 ans_node_ptr *bucket, *last_bucket;
766 ans_hash_ptr hash;
767 hash = (ans_hash_ptr)current_node;
768 bucket = Hash_buckets(hash);
769 last_bucket = bucket + Hash_num_buckets(hash);
770 current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1));
771 memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
772 do {
773 if (*bucket) {
774 traverse_answer_trie(*bucket, str, str_index, arity, var_index, mode,
775 TRAVERSE_POSITION_FIRST PASS_REGS);
776 memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
777#ifdef TRIE_COMPACT_PAIRS
778 if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
779 str[str_index - 1] = ',';
780#else
781 if (arity[arity[0]] == -1)
782 str[str_index - 1] = '|';
783#endif /* TRIE_COMPACT_PAIRS */
784 }
785 } while (++bucket != last_bucket);
786 free(current_arity);
787 return;
788 }
789
790 /* save current state if first sibling node */
791 if (position == TRAVERSE_POSITION_FIRST) {
792 current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1));
793 memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
794 current_str_index = str_index;
795 current_var_index = var_index;
796 current_mode = mode;
797 }
798
799 /* print VAR if starting a term */
800 if (arity[0] == 0 && mode == TRAVERSE_MODE_NORMAL) {
801 str_index += sprintf(&str[str_index], " VAR%d: ", var_index);
802 var_index++;
803 }
804
805 /* process current trie node */
806 TrStat_ans_nodes++;
807 traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode,
808 TRAVERSE_TYPE_ANSWER PASS_REGS);
809
810 /* show answer .... */
811 if (IS_ANSWER_LEAF_NODE(current_node)) {
812 TrStat_answers++;
813 str[str_index] = 0;
814 SHOW_TABLE_STRUCTURE("%s\n", str);
815 }
816#ifdef TABLING_INNER_CUTS
817 /* ... or continue with pruned node */
818 else if (TrNode_child(current_node) == NULL) {
819 TrStat_answers++;
820 TrStat_answers_pruned++;
821 }
822#endif /* TABLING_INNER_CUTS */
823 /* ... or continue with child node */
824 else
825 traverse_answer_trie(TrNode_child(current_node), str, str_index, arity,
826 var_index, mode, TRAVERSE_POSITION_FIRST PASS_REGS);
827
828 /* restore the initial state and continue with sibling nodes */
829 if (position == TRAVERSE_POSITION_FIRST) {
830 str_index = current_str_index;
831 var_index = current_var_index;
832 mode = current_mode;
833 current_node = TrNode_next(current_node);
834 while (current_node) {
835 memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
836#ifdef TRIE_COMPACT_PAIRS
837 if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
838 str[str_index - 1] = ',';
839#else
840 if (arity[arity[0]] == -1)
841 str[str_index - 1] = '|';
842#endif /* TRIE_COMPACT_PAIRS */
843 traverse_answer_trie(current_node, str, str_index, arity, var_index, mode,
844 TRAVERSE_POSITION_NEXT PASS_REGS);
845 current_node = TrNode_next(current_node);
846 }
847 free(current_arity);
848 }
849
850 return;
851}
852
853static void traverse_global_trie(gt_node_ptr current_node, char *str,
854 int str_index, int *arity, int mode,
855 int position USES_REGS) {
856 int *current_arity = NULL, current_str_index = 0, current_mode = 0;
857
858 /* test if hashing */
859 if (IS_GLOBAL_TRIE_HASH(current_node)) {
860 gt_node_ptr *bucket, *last_bucket;
861 gt_hash_ptr hash;
862 hash = (gt_hash_ptr)current_node;
863 bucket = Hash_buckets(hash);
864 last_bucket = bucket + Hash_num_buckets(hash);
865 current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1));
866 memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
867 do {
868 if (*bucket) {
869 traverse_global_trie(*bucket, str, str_index, arity, mode,
870 TRAVERSE_POSITION_FIRST PASS_REGS);
871 memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
872#ifdef TRIE_COMPACT_PAIRS
873 if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
874 str[str_index - 1] = ',';
875#else
876 if (arity[arity[0]] == -1)
877 str[str_index - 1] = '|';
878#endif /* TRIE_COMPACT_PAIRS */
879 }
880 } while (++bucket != last_bucket);
881 free(current_arity);
882 return;
883 }
884
885 /* save current state if first sibling node */
886 if (position == TRAVERSE_POSITION_FIRST) {
887 current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1));
888 memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
889 current_str_index = str_index;
890 current_mode = mode;
891 }
892
893 /* process current trie node */
894 TrStat_gt_nodes++;
895 traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode,
896 TRAVERSE_TYPE_GT_SUBGOAL PASS_REGS);
897
898 /* continue with child node ... */
899 if (arity[0] != 0 || mode != TRAVERSE_MODE_NORMAL)
900 traverse_global_trie(TrNode_child(current_node), str, str_index, arity,
901 mode, TRAVERSE_POSITION_FIRST PASS_REGS);
902 /* ... or show term */
903 else {
904 TrStat_gt_terms++;
905 str[str_index] = 0;
906 SHOW_TABLE_STRUCTURE(" TERMx" UInt_FORMAT ": %s\n",
907 (CELL)TrNode_child(current_node), str);
908 }
909
910 /* restore the initial state and continue with sibling nodes */
911 if (position == TRAVERSE_POSITION_FIRST) {
912 str_index = current_str_index;
913 mode = current_mode;
914 current_node = TrNode_next(current_node);
915 while (current_node) {
916 memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
917#ifdef TRIE_COMPACT_PAIRS
918 if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
919 str[str_index - 1] = ',';
920#else
921 if (arity[arity[0]] == -1)
922 str[str_index - 1] = '|';
923#endif /* TRIE_COMPACT_PAIRS */
924 traverse_global_trie(current_node, str, str_index, arity, mode,
925 TRAVERSE_POSITION_NEXT PASS_REGS);
926 current_node = TrNode_next(current_node);
927 }
928 free(current_arity);
929 }
930
931 return;
932}
933
934static void traverse_global_trie_for_term(gt_node_ptr current_node, char *str,
935 int *str_index, int *arity, int *mode,
936 int type USES_REGS) {
937 if (TrNode_parent(current_node) != GLOBAL_root_gt)
938 traverse_global_trie_for_term(TrNode_parent(current_node), str, str_index,
939 arity, mode, type PASS_REGS);
940 traverse_trie_node(TrNode_entry(current_node), str, str_index, arity, mode,
941 type PASS_REGS);
942 return;
943}
944
945static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr,
946 int *arity, int *mode_ptr,
947 int type USES_REGS) {
948 int mode = *mode_ptr;
949 int str_index = *str_index_ptr;
950
951 /* test the node type */
952 if (mode == TRAVERSE_MODE_DOUBLE) {
953#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
954 arity[0]++;
955 arity[arity[0]] = (int)t;
956 mode = TRAVERSE_MODE_DOUBLE2;
957 } else if (mode == TRAVERSE_MODE_DOUBLE2) {
958 union {
959 Term t_dbl[sizeof(Float) / sizeof(Term)];
960 Float dbl;
961 } u;
962 u.dbl = 0.0;
963 u.t_dbl[0] = t;
964 u.t_dbl[1] = (Term)arity[arity[0]];
965 arity[0]--;
966#else /* SIZEOF_DOUBLE == SIZEOF_INT_P */
967 union {
968 Term t_dbl[sizeof(Float) / sizeof(Term)];
969 Float dbl;
970 } u;
971 u.t_dbl[0] = t;
972#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
973 str_index += sprintf(&str[str_index], "%.15g", u.dbl);
974 traverse_update_arity(str, &str_index, arity);
975 if (type == TRAVERSE_TYPE_SUBGOAL)
976 mode = TRAVERSE_MODE_NORMAL;
977 else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_SUBGOAL ||
978 TRAVERSE_TYPE_GT_ANSWER */
979 mode = TRAVERSE_MODE_DOUBLE_END;
980 } else if (mode == TRAVERSE_MODE_DOUBLE_END) {
981 mode = TRAVERSE_MODE_NORMAL;
982 } else if (mode == TRAVERSE_MODE_LONGINT) {
983 Int li = (Int)t;
984 str_index += sprintf(&str[str_index], Int_FORMAT, li);
985 traverse_update_arity(str, &str_index, arity);
986 if (type == TRAVERSE_TYPE_SUBGOAL)
987 mode = TRAVERSE_MODE_NORMAL;
988 else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_SUBGOAL ||
989 TRAVERSE_TYPE_GT_ANSWER */
990 mode = TRAVERSE_MODE_LONGINT_END;
991 } else if (mode == TRAVERSE_MODE_LONGINT_END) {
992 mode = TRAVERSE_MODE_NORMAL;
993 } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) {
994 str_index += Yap_OpaqueTermToString(AbsAppl((CELL *)t), str + str_index, 0);
995 traverse_update_arity(str, &str_index, arity);
996 if (type == TRAVERSE_TYPE_SUBGOAL)
997 mode = TRAVERSE_MODE_NORMAL;
998 else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_SUBGOAL ||
999 TRAVERSE_TYPE_GT_ANSWER */
1000 mode = TRAVERSE_MODE_BIGINT_OR_STRING_END;
1001 } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING_END) {
1002 mode = TRAVERSE_MODE_NORMAL;
1003 } else if (IsVarTerm(t)) {
1004#ifdef TRIE_RATIONAL_TERMS
1005 if (t > VarIndexOfTableTerm(MAX_TABLE_VARS) &&
1006 TrNode_child((gt_node_ptr)t) !=
1007 (gt_node_ptr)1) { // TODO: substitute the != 1 test to something
1008 // more appropriate
1009 /* Rational term */
1010 str_index += sprintf(&str[str_index], "**");
1011 traverse_update_arity(str, &str_index, arity);
1012 } else
1013#endif /* RATIONAL TERM SUPPORT FOR TRIES */
1014 if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) {
1015 TrStat_gt_refs++;
1016 /* (type % 2 + 2): TRAVERSE_TYPE_ANSWER --> TRAVERSE_TYPE_GT_ANSWER */
1017 /* (type % 2 + 2): TRAVERSE_TYPE_SUBGOAL --> TRAVERSE_TYPE_GT_SUBGOAL */
1018 traverse_global_trie_for_term((gt_node_ptr)t, str, &str_index, arity,
1019 &mode, type % 2 + 2 PASS_REGS);
1020 } else {
1021 if (type == TRAVERSE_TYPE_SUBGOAL || type == TRAVERSE_TYPE_GT_SUBGOAL)
1022 str_index += sprintf(&str[str_index], "VAR%d", VarIndexOfTableTerm(t));
1023 else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_ANSWER */
1024 str_index +=
1025 sprintf(&str[str_index], "ANSVAR%d", VarIndexOfTableTerm(t));
1026 traverse_update_arity(str, &str_index, arity);
1027 }
1028 } else if (IsIntTerm(t)) {
1029 str_index += sprintf(&str[str_index], Int_FORMAT, IntOfTerm(t));
1030 traverse_update_arity(str, &str_index, arity);
1031 } else if (IsAtomTerm(t)) {
1032#ifndef TRIE_COMPACT_PAIRS
1033 if (arity[arity[0]] == -1 && t == TermNil) {
1034 str[str_index - 1] = ']';
1035 arity[0]--;
1036 } else
1037#endif /* TRIE_COMPACT_PAIRS */
1038 str_index += sprintf(&str[str_index], "%s", AtomName(AtomOfTerm(t)));
1039 traverse_update_arity(str, &str_index, arity);
1040 } else if (IsPairTerm(t)) {
1041#ifdef TRIE_COMPACT_PAIRS
1042 if (t == CompactPairEndList)
1043 arity[arity[0]] = -1;
1044 else if (t == CompactPairEndTerm) {
1045 str[str_index - 1] = '|';
1046 arity[arity[0]] = -1;
1047#else
1048 if (arity[arity[0]] == -1) {
1049 str[str_index - 1] = ',';
1050 arity[arity[0]] = -2;
1051#endif /* TRIE_COMPACT_PAIRS */
1052 } else {
1053 str_index += sprintf(&str[str_index], "[");
1054 arity[0]++;
1055 arity[arity[0]] = -2;
1056 }
1057 } else if (IsApplTerm(t)) {
1058 Functor f = (Functor)RepAppl(t);
1059 if (f == FunctorDouble) {
1060 mode = TRAVERSE_MODE_DOUBLE;
1061 } else if (f == FunctorLongInt) {
1062 mode = TRAVERSE_MODE_LONGINT;
1063 } else if (f == FunctorBigInt || f == FunctorString) {
1064 mode = TRAVERSE_MODE_BIGINT_OR_STRING;
1065 } else if (f == FunctorComma) {
1066 if (arity[arity[0]] != -3) {
1067 str_index += sprintf(&str[str_index], "(");
1068 arity[0]++;
1069 }
1070 arity[arity[0]] = -4;
1071 } else {
1072 str_index += sprintf(&str[str_index], "%s(", AtomName(NameOfFunctor(f)));
1073 arity[0]++;
1074 arity[arity[0]] = ArityOfFunctor(f);
1075 }
1076 }
1077
1078 *mode_ptr = mode;
1079 *str_index_ptr = str_index;
1080 return;
1081}
1082
1083static inline void traverse_update_arity(char *str, int *str_index_ptr,
1084 int *arity) {
1085 int str_index = *str_index_ptr;
1086 while (arity[0]) {
1087 if (arity[arity[0]] > 0) {
1088 arity[arity[0]]--;
1089 if (arity[arity[0]] == 0) {
1090 str_index += sprintf(&str[str_index], ")");
1091 arity[0]--;
1092 } else {
1093 str_index += sprintf(&str[str_index], ",");
1094 break;
1095 }
1096 } else {
1097 if (arity[arity[0]] == -4) {
1098 str_index += sprintf(&str[str_index], ",");
1099 arity[arity[0]] = -3;
1100 break;
1101 } else if (arity[arity[0]] == -3) {
1102 str_index += sprintf(&str[str_index], ")");
1103 arity[0]--;
1104 } else if (arity[arity[0]] == -2) {
1105#ifdef TRIE_COMPACT_PAIRS
1106 str_index += sprintf(&str[str_index], ",");
1107#else
1108 str_index += sprintf(&str[str_index], "|");
1109 arity[arity[0]] = -1;
1110#endif /* TRIE_COMPACT_PAIRS */
1111 break;
1112 } else if (arity[arity[0]] == -1) {
1113 str_index += sprintf(&str[str_index], "]");
1114 arity[0]--;
1115 }
1116 }
1117 }
1118 *str_index_ptr = str_index;
1119}
1120
1121/*******************************
1122** Global functions **
1123*******************************/
1124
1125sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) {
1126 CACHE_REGS
1127 CELL *stack_vars;
1128 int i, subs_arity, pred_arity;
1129 tab_ent_ptr tab_ent;
1130 sg_fr_ptr sg_fr;
1131 sg_node_ptr current_sg_node;
1132#ifdef MODE_DIRECTED_TABLING
1133 int *mode_directed, aux_mode_directed[MAX_TABLE_VARS];
1134 int subs_pos = 0;
1135#endif /* MODE_DIRECTED_TABLING */
1136
1137 stack_vars = *Yaddr;
1138 subs_arity = 0;
1139 pred_arity = preg->y_u.Otapl.s;
1140 tab_ent = preg->y_u.Otapl.te;
1141 current_sg_node = get_insert_subgoal_trie(tab_ent PASS_REGS);
1142 LOCK_SUBGOAL_TRIE(tab_ent);
1143
1144#ifdef MODE_DIRECTED_TABLING
1145 mode_directed = TabEnt_mode_directed(tab_ent);
1146 if (mode_directed) {
1147 int old_subs_arity = subs_arity;
1148 for (i = 1; i <= pred_arity; i++) {
1149 int j = MODE_DIRECTED_GET_ARG(mode_directed[i - 1]) + 1;
1150 current_sg_node =
1151 subgoal_search_loop(tab_ent, current_sg_node, Deref(XREGS[j]),
1152 &subs_arity, &stack_vars PASS_REGS);
1153 if (subs_arity != old_subs_arity) {
1154 if (subs_pos &&
1155 MODE_DIRECTED_GET_MODE(aux_mode_directed[subs_pos - 1]) ==
1156 MODE_DIRECTED_GET_MODE(mode_directed[i - 1])) {
1157 /* same mode as before -> use the current entry in the
1158 * aux_mode_directed[] array */
1159 aux_mode_directed[subs_pos - 1] +=
1160 MODE_DIRECTED_SET(subs_arity - old_subs_arity, 0);
1161 } else {
1162 /* new mode -> init a new entry in the aux_mode_directed[] array */
1163 aux_mode_directed[subs_pos] =
1164 MODE_DIRECTED_SET(subs_arity - old_subs_arity,
1165 MODE_DIRECTED_GET_MODE(mode_directed[i - 1]));
1166 subs_pos++;
1167 }
1168 old_subs_arity = subs_arity;
1169 }
1170 }
1171 } else
1172#endif /* MODE_DIRECTED_TABLING */
1173 if (IsMode_GlobalTrie(TabEnt_mode(tab_ent))) {
1174 for (i = 1; i <= pred_arity; i++)
1175 current_sg_node =
1176 subgoal_search_terms_loop(tab_ent, current_sg_node, Deref(XREGS[i]),
1177 &subs_arity, &stack_vars PASS_REGS);
1178 } else {
1179 for (i = 1; i <= pred_arity; i++)
1180 current_sg_node =
1181 subgoal_search_loop(tab_ent, current_sg_node, Deref(XREGS[i]),
1182 &subs_arity, &stack_vars PASS_REGS);
1183 }
1184
1185 STACK_PUSH_UP(subs_arity, stack_vars);
1186 *Yaddr = stack_vars++;
1187 /* reset variables */
1188 while (subs_arity--) {
1189 Term t = STACK_POP_DOWN(stack_vars);
1190 RESET_VARIABLE(t);
1191 }
1192
1193 sg_fr_ptr *sg_fr_end =
1194 get_insert_subgoal_frame_addr(current_sg_node PASS_REGS);
1195#ifndef THREADS
1196 LOCK_SUBGOAL_NODE(current_sg_node);
1197#endif /* !THREADS */
1198 if (*sg_fr_end == NULL) {
1199/* new tabled subgoal */
1200#ifdef MODE_DIRECTED_TABLING
1201 if (subs_pos) {
1202 ALLOC_BLOCK(mode_directed, subs_pos * sizeof(int), int);
1203 memcpy((void *)mode_directed, (void *)aux_mode_directed,
1204 subs_pos * sizeof(int));
1205 } else
1206 mode_directed = NULL;
1207#endif /* MODE_DIRECTED_TABLING */
1208#if !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
1209 new_subgoal_frame(sg_fr, preg, mode_directed);
1210 *sg_fr_end = sg_fr;
1211#ifndef _MSC_VER
1212 __sync_synchronize();
1213#endif
1214 TAG_AS_SUBGOAL_LEAF_NODE(current_sg_node);
1215 UNLOCK_SUBGOAL_NODE(current_sg_node);
1216#else /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
1217 sg_ent_ptr sg_ent =
1218 (sg_ent_ptr)UNTAG_SUBGOAL_NODE(TrNode_sg_ent(current_sg_node));
1219 new_subgoal_frame(sg_fr, sg_ent);
1220#ifdef THREADS_CONSUMER_SHARING
1221 SgFr_state(sg_fr) = ready_external;
1222#else
1223 SgFr_state(sg_fr) = ready;
1224#endif /* THREADS_CONSUMER_SHARING */
1225 if (SgEnt_sg_ent_state(sg_ent) == ready) {
1226 LOCK(SgEnt_lock(sg_ent));
1227 if (SgEnt_sg_ent_state(sg_ent) == ready) {
1228 SgEnt_code(sg_ent) = preg;
1229 SgEnt_init_mode_directed_fields(sg_ent, mode_directed);
1230 SgEnt_sg_ent_state(sg_ent) = evaluating;
1231#ifdef THREADS_CONSUMER_SHARING
1232 SgEnt_gen_worker(sg_ent) = worker_id;
1233 SgFr_state(sg_fr) = ready;
1234#endif /* THREADS_CONSUMER_SHARING */
1235 }
1236 UNLOCK(SgEnt_lock(sg_ent));
1237 }
1238 *sg_fr_end = sg_fr;
1239#endif /* !THREADS_FULL_SHARING && !THREADS_CONSUMER_SHARING */
1240 } else {
1241/* repeated tabled subgoal */
1242#ifndef THREADS
1243 UNLOCK_SUBGOAL_NODE(current_sg_node);
1244#endif /* !THREADS */
1245 sg_fr = (sg_fr_ptr)UNTAG_SUBGOAL_NODE(*sg_fr_end);
1246#ifdef LIMIT_TABLING
1247 if (SgFr_state(sg_fr) <= ready) { /* incomplete or ready */
1248 remove_from_global_sg_fr_list(sg_fr);
1249 }
1250#endif /* LIMIT_TABLING */
1251 }
1252 UNLOCK_SUBGOAL_TRIE(tab_ent);
1253 return sg_fr;
1254}
1255
1256ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
1257#define subs_arity *subs_ptr
1258 CACHE_REGS
1259 CELL *stack_vars;
1260 int i, vars_arity;
1261 ans_node_ptr current_ans_node;
1262
1263 vars_arity = 0;
1264 current_ans_node = SgFr_answer_trie(sg_fr);
1265
1266 if (IsMode_GlobalTrie(TabEnt_mode(SgFr_tab_ent(sg_fr)))) {
1267 for (i = subs_arity; i >= 1; i--) {
1268 TABLING_ERROR_CHECKING(answer_search, IsNonVarTerm(subs_ptr[i]));
1269 current_ans_node = answer_search_terms_loop(
1270 sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS);
1271 }
1272 } else {
1273 for (i = subs_arity; i >= 1; i--) {
1274 TABLING_ERROR_CHECKING(answer_search, IsNonVarTerm(subs_ptr[i]));
1275 current_ans_node = answer_search_loop(
1276 sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS);
1277 }
1278 }
1279
1280 /* reset variables */
1281 stack_vars = (CELL *)TR;
1282 while (vars_arity--) {
1283 Term t = STACK_POP_DOWN(stack_vars);
1284 RESET_VARIABLE(t);
1285 }
1286
1287 return current_ans_node;
1288#undef subs_arity
1289}
1290
1291#ifdef MODE_DIRECTED_TABLING
1292ans_node_ptr mode_directed_answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
1293#define subs_arity *subs_ptr
1294 CACHE_REGS
1295 CELL *stack_vars;
1296 int i, j, vars_arity;
1297 ans_node_ptr current_ans_node, invalid_ans_node;
1298 int *mode_directed;
1299
1300 vars_arity = 0;
1301 current_ans_node = SgFr_answer_trie(sg_fr);
1302 invalid_ans_node = NULL;
1303 mode_directed = SgFr_mode_directed(sg_fr);
1304 j = 0;
1305 i = subs_arity;
1306 while (i) {
1307 int mode = MODE_DIRECTED_GET_MODE(mode_directed[j]);
1308 int n_subs = MODE_DIRECTED_GET_ARG(mode_directed[j]);
1309 do {
1310 TABLING_ERROR_CHECKING(answer_search, IsNonVarTerm(subs_ptr[i]));
1311 if (mode == MODE_DIRECTED_INDEX || mode == MODE_DIRECTED_ALL) {
1312 current_ans_node = answer_search_loop(
1313 sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS);
1314 } else {
1315 LOCK_ANSWER_NODE(current_ans_node);
1316 if (TrNode_child(current_ans_node) == NULL) {
1317#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
1318 struct answer_trie_node
1319 virtual_ans_node; /* necessary because the answer_search_loop()
1320 procedure also locks the parent node */
1321 ans_node_ptr parent_ans_node = current_ans_node;
1322 AnsNode_init_lock_field(&virtual_ans_node);
1323 TrNode_parent(&virtual_ans_node) = NULL;
1324 TrNode_child(&virtual_ans_node) = NULL;
1325 current_ans_node =
1326 answer_search_loop(sg_fr, &virtual_ans_node, Deref(subs_ptr[i]),
1327 &vars_arity PASS_REGS);
1328 TrNode_child(parent_ans_node) = TrNode_child(&virtual_ans_node);
1329 TrNode_parent(TrNode_child(&virtual_ans_node)) = parent_ans_node;
1330#else
1331 current_ans_node =
1332 answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]),
1333 &vars_arity PASS_REGS);
1334#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
1335 } else if (mode == MODE_DIRECTED_MIN || mode == MODE_DIRECTED_MAX) {
1336 ans_node_ptr parent_ans_node = current_ans_node;
1337 invalid_ans_node = TrNode_child(
1338 parent_ans_node); /* by default, assume a better answer */
1339 current_ans_node = answer_search_min_max(
1340 sg_fr, current_ans_node, Deref(subs_ptr[i]), mode PASS_REGS);
1341 if (invalid_ans_node ==
1342 TrNode_child(parent_ans_node)) /* worse or equal answer */
1343 invalid_ans_node = NULL;
1344 } else if (mode == MODE_DIRECTED_SUM) {
1345 invalid_ans_node = TrNode_child(current_ans_node);
1346 current_ans_node = answer_search_sum(sg_fr, current_ans_node,
1347 Deref(subs_ptr[i]) PASS_REGS);
1348 } else if (mode == MODE_DIRECTED_LAST) {
1349#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
1350 struct answer_trie_node
1351 virtual_ans_node; /* necessary because the answer_search_loop()
1352 procedure also locks the parent node */
1353 ans_node_ptr parent_ans_node = current_ans_node;
1354 invalid_ans_node = TrNode_child(parent_ans_node);
1355 AnsNode_init_lock_field(&virtual_ans_node);
1356 TrNode_parent(&virtual_ans_node) = NULL;
1357 TrNode_child(&virtual_ans_node) = NULL;
1358 current_ans_node =
1359 answer_search_loop(sg_fr, &virtual_ans_node, Deref(subs_ptr[i]),
1360 &vars_arity PASS_REGS);
1361 TrNode_child(parent_ans_node) = TrNode_child(&virtual_ans_node);
1362 TrNode_parent(TrNode_child(&virtual_ans_node)) = parent_ans_node;
1363#else
1364 invalid_ans_node = TrNode_child(current_ans_node);
1365 TrNode_child(current_ans_node) = NULL;
1366 current_ans_node =
1367 answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]),
1368 &vars_arity PASS_REGS);
1369#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
1370 } else if (mode == MODE_DIRECTED_FIRST) {
1371 current_ans_node = NULL;
1372 } else
1373 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
1374 "mode_directed_answer_search: unknown mode");
1375 UNLOCK_ANSWER_NODE(current_ans_node);
1376 }
1377 n_subs--;
1378 i--;
1379 } while (n_subs && current_ans_node);
1380 if (current_ans_node == NULL) /* no answer inserted */
1381 break;
1382 j++;
1383 }
1384 if (invalid_ans_node)
1385 invalidate_answer_trie(invalid_ans_node, sg_fr,
1386 TRAVERSE_POSITION_FIRST PASS_REGS);
1387
1388 /* reset variables */
1389 stack_vars = (CELL *)TR;
1390 while (vars_arity--) {
1391 Term t = STACK_POP_DOWN(stack_vars);
1392 RESET_VARIABLE(t);
1393 }
1394
1395 return current_ans_node;
1396#undef subs_arity
1397}
1398#endif /* MODE_DIRECTED_TABLING */
1399
1400void load_answer(ans_node_ptr current_ans_node, CELL *subs_ptr) {
1401 CACHE_REGS
1402#define subs_arity *subs_ptr
1403 CELL *stack_terms;
1404 int i;
1405
1406 TABLING_ERROR_CHECKING(load_answer, H < H_FZ);
1407 if (subs_arity == 0)
1408 return;
1409
1410 stack_terms = load_answer_loop(current_ans_node PASS_REGS);
1411
1412 for (i = subs_arity; i >= 1; i--) {
1413 Term t = STACK_POP_DOWN(stack_terms);
1414 YapBind((CELL *)subs_ptr[i], t);
1415 }
1416 TABLING_ERROR_CHECKING(load_answer, stack_terms != (CELL *)LOCAL_TrailTop);
1417
1418 return;
1419#undef subs_arity
1420}
1421
1422CELL *exec_substitution(gt_node_ptr current_node, CELL *aux_stack) {
1423 CACHE_REGS
1424#define subs_arity *subs_ptr
1425 CELL *stack_terms, *subs_ptr;
1426 Term t;
1427
1428 ++aux_stack; /* skip the heap_arity entry */
1429 stack_terms = exec_substitution_loop(current_node, &aux_stack,
1430 (CELL *)LOCAL_TrailTop PASS_REGS);
1431 *--aux_stack = 0; /* restore the heap_arity entry */
1432
1433 subs_ptr = aux_stack + aux_stack[1] + 2;
1434 t = STACK_POP_DOWN(stack_terms);
1435 YapBind((CELL *)subs_ptr[subs_arity], t);
1436 TABLING_ERROR_CHECKING(exec_substitution,
1437 stack_terms != (CELL *)LOCAL_TrailTop);
1438 *subs_ptr = subs_arity - 1;
1439
1440 return aux_stack;
1441#undef subs_arity
1442}
1443
1444void update_answer_trie(sg_fr_ptr sg_fr) {
1445 ans_node_ptr current_node;
1446
1447 free_answer_hash_chain(SgFr_hash_chain(sg_fr));
1448 SgFr_hash_chain(sg_fr) = NULL;
1449 SgFr_state(sg_fr) +=
1450 2; /* complete --> compiled : complete_in_use --> compiled_in_use */
1451
1452#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
1453 SgFr_sg_ent_state(sg_fr) += 2; /* complete --> compiled */
1454#ifdef THREADS_FULL_SHARING
1455 if (IsMode_Batched(TabEnt_mode(SgFr_tab_ent(sg_fr)))) {
1456 /* cleaning bits used by batched mode and shifting the instruction back to
1457 * the original place */
1458 ans_node_ptr leaf_ans_trie_node = SgFr_first_answer(sg_fr);
1459 while (TrNode_child(leaf_ans_trie_node) != NULL) {
1460 ANSWER_LEAF_NODE_INSTR_ABSOLUTE(leaf_ans_trie_node);
1461 leaf_ans_trie_node = TrNode_child(leaf_ans_trie_node);
1462 }
1463 ANSWER_LEAF_NODE_INSTR_ABSOLUTE(leaf_ans_trie_node);
1464 }
1465#endif /* THREADS_FULL_SHARING */
1466#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
1467 current_node = TrNode_child(SgFr_answer_trie(sg_fr));
1468 if (current_node) {
1469#ifdef YAPOR
1470 TrNode_instr(current_node) -= 1;
1471#ifdef TABLING_INNER_CUTS
1472 update_answer_trie_branch(NULL, current_node);
1473#else
1474 update_answer_trie_branch(current_node);
1475#endif /* TABLING_INNER_CUTS */
1476#else /* TABLING */
1477 update_answer_trie_branch(current_node, TRAVERSE_POSITION_FIRST);
1478#endif /* YAPOR */
1479 }
1480 return;
1481}
1482
1483void free_subgoal_trie(sg_node_ptr current_node, int mode, int position) {
1484 CACHE_REGS
1485
1486 if (IS_SUBGOAL_TRIE_HASH(current_node)) {
1487 sg_node_ptr *bucket, *last_bucket;
1488 sg_hash_ptr hash;
1489 hash = (sg_hash_ptr)current_node;
1490 bucket = Hash_buckets(hash);
1491 last_bucket = bucket + Hash_num_buckets(hash);
1492 do {
1493 if (*bucket) {
1494 sg_node_ptr next_node = *bucket;
1495 do {
1496 current_node = next_node;
1497 next_node = TrNode_next(current_node);
1498 free_subgoal_trie(current_node, mode, TRAVERSE_POSITION_NEXT);
1499 } while (next_node);
1500 }
1501 } while (++bucket != last_bucket);
1502 IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES {
1503 FREE_BUCKETS(Hash_buckets(hash));
1504 FREE_SUBGOAL_TRIE_HASH(hash);
1505 }
1506 return;
1507 }
1508 if (!IS_SUBGOAL_LEAF_NODE(current_node)) {
1509 int child_mode;
1510 if (mode == TRAVERSE_MODE_NORMAL) {
1511 Term t = TrNode_entry(current_node);
1512 if (IsApplTerm(t)) {
1513 Functor f = (Functor)RepAppl(t);
1514 if (f == FunctorDouble)
1515 child_mode = TRAVERSE_MODE_DOUBLE;
1516 else if (f == FunctorLongInt)
1517 child_mode = TRAVERSE_MODE_LONGINT;
1518 else if (f == FunctorBigInt || f == FunctorString)
1519 child_mode = TRAVERSE_MODE_BIGINT_OR_STRING;
1520 else
1521 child_mode = TRAVERSE_MODE_NORMAL;
1522 } else
1523 child_mode = TRAVERSE_MODE_NORMAL;
1524 } else if (mode == TRAVERSE_MODE_LONGINT) {
1525 child_mode = TRAVERSE_MODE_LONGINT_END;
1526 } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) {
1527 Yap_FreeCodeSpace((char *)TrNode_entry(current_node));
1528 child_mode = TRAVERSE_MODE_BIGINT_OR_STRING_END;
1529 } else if (mode == TRAVERSE_MODE_DOUBLE) {
1530#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
1531 child_mode = TRAVERSE_MODE_DOUBLE2;
1532 } else if (mode == TRAVERSE_MODE_DOUBLE2) {
1533#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
1534 child_mode = TRAVERSE_MODE_DOUBLE_END;
1535 } else {
1536 child_mode = TRAVERSE_MODE_NORMAL;
1537 }
1538 free_subgoal_trie(TrNode_child(current_node), child_mode,
1539 TRAVERSE_POSITION_FIRST);
1540 } else {
1541 sg_fr_ptr sg_fr = get_subgoal_frame_for_abolish(current_node PASS_REGS);
1542 if (sg_fr) {
1543 ans_node_ptr ans_node;
1544 free_answer_hash_chain(SgFr_hash_chain(sg_fr));
1545 ans_node = SgFr_answer_trie(sg_fr);
1546 if (TrNode_child(ans_node))
1547 free_answer_trie(TrNode_child(ans_node), TRAVERSE_MODE_NORMAL,
1548 TRAVERSE_POSITION_FIRST);
1549 IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES {
1550 FREE_ANSWER_TRIE_NODE(ans_node);
1551#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
1552#ifdef MODE_DIRECTED_TABLING
1553 if (SgEnt_mode_directed(SgFr_sg_ent(sg_fr)))
1554 FREE_BLOCK(SgEnt_mode_directed(SgFr_sg_ent(sg_fr)));
1555 if (SgFr_invalid_chain(sg_fr)) {
1556 ans_node_ptr current_node, next_node;
1557 /* free invalid answer nodes */
1558 current_node = SgFr_invalid_chain(sg_fr);
1559 SgFr_invalid_chain(sg_fr) = NULL;
1560 while (current_node) {
1561 next_node = TrNode_next(current_node);
1562 FREE_ANSWER_TRIE_NODE(current_node);
1563 current_node = next_node;
1564 }
1565 }
1566#endif /* MODE_DIRECTED_TABLING */
1567 FREE_SUBGOAL_ENTRY(SgFr_sg_ent(sg_fr));
1568#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
1569 }
1570#ifdef LIMIT_TABLING
1571 remove_from_global_sg_fr_list(sg_fr);
1572#endif /* LIMIT_TABLING */
1573#if defined(MODE_DIRECTED_TABLING) && !defined(THREADS_FULL_SHARING) && \
1574 !defined(THREADS_CONSUMER_SHARING)
1575 if (SgFr_mode_directed(sg_fr))
1576 FREE_BLOCK(SgFr_mode_directed(sg_fr));
1577#endif /* MODE_DIRECTED_TABLING && !THREADS_FULL_SHARING && \
1578 !THREADS_CONSUMER_SHARING */
1579 FREE_SUBGOAL_FRAME(sg_fr);
1580 }
1581 }
1582 if (position == TRAVERSE_POSITION_FIRST) {
1583 sg_node_ptr next_node = TrNode_next(current_node);
1584 IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES {
1585 CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(TrNode_entry(current_node), mode);
1586 FREE_SUBGOAL_TRIE_NODE(current_node);
1587 }
1588 while (next_node) {
1589 current_node = next_node;
1590 next_node = TrNode_next(current_node);
1591 free_subgoal_trie(current_node, mode, TRAVERSE_POSITION_NEXT);
1592 }
1593 } else {
1594 IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES {
1595 CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(TrNode_entry(current_node), mode);
1596 FREE_SUBGOAL_TRIE_NODE(current_node);
1597 }
1598 }
1599 return;
1600}
1601
1602void free_answer_trie(ans_node_ptr current_node, int mode, int position) {
1603 CACHE_REGS
1604
1605#ifdef TABLING_INNER_CUTS
1606 if (!IS_ANSWER_LEAF_NODE(current_node) && TrNode_child(current_node)) {
1607#else
1608 if (!IS_ANSWER_LEAF_NODE(current_node)) {
1609#endif /* TABLING_INNER_CUTS */
1610 int child_mode;
1611 if (mode == TRAVERSE_MODE_NORMAL) {
1612 Term t = TrNode_entry(current_node);
1613 if (IsApplTerm(t)) {
1614 Functor f = (Functor)RepAppl(t);
1615 if (f == FunctorDouble)
1616 child_mode = TRAVERSE_MODE_DOUBLE;
1617 else if (f == FunctorLongInt)
1618 child_mode = TRAVERSE_MODE_LONGINT;
1619 else if (f == FunctorBigInt || f == FunctorString)
1620 child_mode = TRAVERSE_MODE_BIGINT_OR_STRING;
1621 else
1622 child_mode = TRAVERSE_MODE_NORMAL;
1623 } else
1624 child_mode = TRAVERSE_MODE_NORMAL;
1625 } else if (mode == TRAVERSE_MODE_LONGINT) {
1626 child_mode = TRAVERSE_MODE_LONGINT_END;
1627 } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) {
1628 Yap_FreeCodeSpace((char *)TrNode_entry(current_node));
1629 child_mode = TRAVERSE_MODE_BIGINT_OR_STRING_END;
1630 } else if (mode == TRAVERSE_MODE_DOUBLE) {
1631#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
1632 child_mode = TRAVERSE_MODE_DOUBLE2;
1633 } else if (mode == TRAVERSE_MODE_DOUBLE2) {
1634#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
1635 child_mode = TRAVERSE_MODE_DOUBLE_END;
1636 } else {
1637 child_mode = TRAVERSE_MODE_NORMAL;
1638 }
1639 free_answer_trie(TrNode_child(current_node), child_mode,
1640 TRAVERSE_POSITION_FIRST);
1641 }
1642 if (position == TRAVERSE_POSITION_FIRST) {
1643 ans_node_ptr next_node = TrNode_next(current_node);
1644 IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES {
1645 CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(TrNode_entry(current_node), mode);
1646 FREE_ANSWER_TRIE_NODE(current_node);
1647 }
1648 while (next_node) {
1649 current_node = next_node;
1650 next_node = TrNode_next(current_node);
1651 free_answer_trie(current_node, mode, TRAVERSE_POSITION_NEXT);
1652 }
1653 } else {
1654 IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES {
1655 CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(TrNode_entry(current_node), mode);
1656 FREE_ANSWER_TRIE_NODE(current_node);
1657 }
1658 }
1659 return;
1660}
1661
1662void free_answer_hash_chain(ans_hash_ptr hash) {
1663#if defined(THREADS_NO_SHARING) || defined(THREADS_SUBGOAL_SHARING)
1664 CACHE_REGS
1665#endif /* THREADS_NO_SHARING || THREADS_SUBGOAL_SHARING */
1666
1667 while (hash) {
1668 ans_node_ptr chain_node, *bucket, *last_bucket;
1669 ans_hash_ptr next_hash;
1670
1671 bucket = Hash_buckets(hash);
1672 last_bucket = bucket + Hash_num_buckets(hash);
1673 while (!*bucket)
1674 bucket++;
1675 chain_node = *bucket;
1676 TrNode_child((ans_node_ptr)UNTAG_ANSWER_NODE(TrNode_parent(chain_node))) =
1677 chain_node;
1678 while (++bucket != last_bucket) {
1679 if (*bucket) {
1680 while (TrNode_next(chain_node))
1681 chain_node = TrNode_next(chain_node);
1682 TrNode_next(chain_node) = *bucket;
1683 chain_node = *bucket;
1684 }
1685 }
1686 next_hash = Hash_next(hash);
1687 FREE_BUCKETS(Hash_buckets(hash));
1688 FREE_ANSWER_TRIE_HASH(hash);
1689 hash = next_hash;
1690 }
1691 return;
1692}
1693
1694/*****************************************************************************************
1695** all threads abolish their local data structures, and the main thread also
1696*abolishes **
1697** all shared data structures, if no other thread is running (GLOBAL_NOfThreads
1698*== 1). **
1699*****************************************************************************************/
1700void abolish_table(tab_ent_ptr tab_ent) {
1701 CACHE_REGS
1702 sg_node_ptr sg_node;
1703
1704#ifdef THREADS
1705 if (GLOBAL_NOfThreads == 1) {
1706 ATTACH_PAGES(_pages_tab_ent);
1707#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
1708 ATTACH_PAGES(_pages_sg_ent);
1709#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
1710 ATTACH_PAGES(_pages_sg_fr);
1711 ATTACH_PAGES(_pages_dep_fr);
1712 ATTACH_PAGES(_pages_sg_node);
1713 ATTACH_PAGES(_pages_sg_hash);
1714 ATTACH_PAGES(_pages_ans_node);
1715 ATTACH_PAGES(_pages_ans_hash);
1716#if defined(THREADS_FULL_SHARING)
1717 ATTACH_PAGES(_pages_ans_ref_node);
1718#endif /* THREADS_FULL_SHARING */
1719 ATTACH_PAGES(_pages_gt_node);
1720 ATTACH_PAGES(_pages_gt_hash);
1721 }
1722#endif /* THREADS */
1723 sg_node = get_subgoal_trie_for_abolish(tab_ent PASS_REGS);
1724 if (sg_node) {
1725 if (TrNode_child(sg_node)) {
1726 if (TabEnt_arity(tab_ent)) {
1727 free_subgoal_trie(TrNode_child(sg_node), TRAVERSE_MODE_NORMAL,
1728 TRAVERSE_POSITION_FIRST);
1729 } else {
1730 sg_fr_ptr sg_fr = get_subgoal_frame_for_abolish(sg_node PASS_REGS);
1731 if (sg_fr) {
1732 IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES {
1733 FREE_ANSWER_TRIE_NODE(SgFr_answer_trie(sg_fr));
1734#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
1735 FREE_SUBGOAL_ENTRY(SgFr_sg_ent(sg_fr));
1736#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
1737 }
1738#ifdef LIMIT_TABLING
1739 remove_from_global_sg_fr_list(sg_fr);
1740#endif /* LIMIT_TABLING */
1741 FREE_SUBGOAL_FRAME(sg_fr);
1742 }
1743 }
1744 IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES
1745 TrNode_child(sg_node) = NULL;
1746 }
1747#ifdef THREADS_NO_SHARING
1748 FREE_SUBGOAL_TRIE_NODE(sg_node);
1749#endif /* THREADS_NO_SHARING */
1750 }
1751 return;
1752}
1753
1754void showTable(tab_ent_ptr tab_ent, int show_mode, FILE *out) {
1755 CACHE_REGS
1756 sg_node_ptr sg_node;
1757
1758 TrStat_out = out;
1759 TrStat_show = show_mode;
1760 TrStat_subgoals = 0;
1761 TrStat_sg_incomplete = 0;
1762 TrStat_sg_nodes = 1;
1763 TrStat_answers = 0;
1764 TrStat_answers_true = 0;
1765 TrStat_answers_no = 0;
1766#ifdef TABLING_INNER_CUTS
1767 TrStat_answers_pruned = 0;
1768#endif /* TABLING_INNER_CUTS */
1769 TrStat_ans_nodes = 0;
1770 TrStat_gt_refs = 0;
1771 if (show_mode == SHOW_MODE_STATISTICS)
1772 fprintf(TrStat_out, "Table statistics for predicate '%s",
1773 AtomName(TabEnt_atom(tab_ent)));
1774 else /* SHOW_MODE_STRUCTURE */
1775 fprintf(TrStat_out, "Table structure for predicate '%s",
1776 AtomName(TabEnt_atom(tab_ent)));
1777#ifdef MODE_DIRECTED_TABLING
1778 if (TabEnt_mode_directed(tab_ent)) {
1779 int i, *mode_directed = TabEnt_mode_directed(tab_ent);
1780 fprintf(TrStat_out, "(");
1781 for (i = 0; i < TabEnt_arity(tab_ent); i++) {
1782 int mode = MODE_DIRECTED_GET_MODE(mode_directed[i]);
1783 if (mode == MODE_DIRECTED_INDEX) {
1784 fprintf(TrStat_out, "index");
1785 } else if (mode == MODE_DIRECTED_MIN) {
1786 fprintf(TrStat_out, "min");
1787 } else if (mode == MODE_DIRECTED_MAX) {
1788 fprintf(TrStat_out, "max");
1789 } else if (mode == MODE_DIRECTED_ALL) {
1790 fprintf(TrStat_out, "all");
1791 } else if (mode == MODE_DIRECTED_SUM) {
1792 fprintf(TrStat_out, "sum");
1793 } else if (mode == MODE_DIRECTED_LAST) {
1794 fprintf(TrStat_out, "last");
1795 } else if (mode == MODE_DIRECTED_FIRST) {
1796 fprintf(TrStat_out, "first");
1797 } else
1798 Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "show_table: unknown mode");
1799 if (i != MODE_DIRECTED_GET_ARG(mode_directed[i]))
1800 fprintf(TrStat_out, "(ARG%d)",
1801 MODE_DIRECTED_GET_ARG(mode_directed[i]) + 1);
1802 if (i + 1 != TabEnt_arity(tab_ent))
1803 fprintf(TrStat_out, ",");
1804 }
1805 fprintf(TrStat_out, ")'\n");
1806 } else
1807#endif /* MODE_DIRECTED_TABLING */
1808 fprintf(TrStat_out, "/%d'\n", TabEnt_arity(tab_ent));
1809 sg_node = get_subgoal_trie(tab_ent);
1810 if (sg_node) {
1811 if (TrNode_child(sg_node)) {
1812 if (TabEnt_arity(tab_ent)) {
1813 char *str = (char *)malloc(sizeof(char) * SHOW_TABLE_STR_ARRAY_SIZE);
1814 int *arity = (int *)malloc(sizeof(int) * SHOW_TABLE_ARITY_ARRAY_SIZE);
1815 arity[0] = 1;
1816 arity[1] = TabEnt_arity(tab_ent);
1817 int str_index =
1818 sprintf(str, " ?- %s(", AtomName(TabEnt_atom(tab_ent)));
1819 traverse_subgoal_trie(TrNode_child(sg_node), str, str_index, arity,
1820 TRAVERSE_MODE_NORMAL,
1821 TRAVERSE_POSITION_FIRST PASS_REGS);
1822 free(str);
1823 free(arity);
1824 } else {
1825 sg_fr_ptr sg_fr = get_subgoal_frame(sg_node);
1826 if (sg_fr) {
1827 TrStat_subgoals++;
1828 SHOW_TABLE_STRUCTURE(" ?- %s.\n", AtomName(TabEnt_atom(tab_ent)));
1829 TrStat_ans_nodes++;
1830 if (SgFr_first_answer(sg_fr) == NULL) {
1831 if (SgFr_state(sg_fr) < complete) {
1832 TrStat_sg_incomplete++;
1833 SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n");
1834 } else {
1835 TrStat_answers_no++;
1836 SHOW_TABLE_STRUCTURE(" NO\n");
1837 }
1838 } else { /* SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr) */
1839 TrStat_answers_true++;
1840 SHOW_TABLE_STRUCTURE(" TRUE\n");
1841 }
1842 }
1843 }
1844 }
1845 }
1846 if (TrStat_subgoals == 0)
1847 SHOW_TABLE_STRUCTURE(" EMPTY\n");
1848 if (show_mode == SHOW_MODE_STATISTICS) {
1849 fprintf(TrStat_out, " Subgoal trie structure\n");
1850 fprintf(TrStat_out, " Subgoals: %ld (%ld incomplete)\n", TrStat_subgoals,
1851 TrStat_sg_incomplete);
1852 fprintf(TrStat_out, " Subgoal trie nodes: %ld\n", TrStat_sg_nodes);
1853 fprintf(TrStat_out, " Answer trie structure(s)\n");
1854#ifdef TABLING_INNER_CUTS
1855 fprintf(TrStat_out, " Answers: %ld (%ld pruned)\n", TrStat_answers,
1856 TrStat_answers_pruned);
1857#else
1858 fprintf(TrStat_out, " Answers: %ld\n", TrStat_answers);
1859#endif /* TABLING_INNER_CUTS */
1860 fprintf(TrStat_out, " Answers 'TRUE': %ld\n", TrStat_answers_true);
1861 fprintf(TrStat_out, " Answers 'NO': %ld\n", TrStat_answers_no);
1862 fprintf(TrStat_out, " Answer trie nodes: %ld\n", TrStat_ans_nodes);
1863 fprintf(TrStat_out, " Global trie references: %ld\n", TrStat_gt_refs);
1864 }
1865 return;
1866}
1867
1868void showGlobalTrie(int show_mode, FILE *out) {
1869 CACHE_REGS
1870
1871 TrStat_out = out;
1872 TrStat_show = show_mode;
1873 TrStat_gt_terms = 0;
1874 TrStat_gt_nodes = 1;
1875 TrStat_gt_refs = 0;
1876 if (show_mode == SHOW_MODE_STATISTICS)
1877 fprintf(TrStat_out, "Global trie statistics\n");
1878 else /* SHOW_MODE_STRUCTURE */
1879 fprintf(TrStat_out, "Global trie structure\n");
1880 if (TrNode_child(GLOBAL_root_gt)) {
1881 char *str = (char *)malloc(sizeof(char) * SHOW_TABLE_STR_ARRAY_SIZE);
1882 int *arity = (int *)malloc(sizeof(int) * SHOW_TABLE_ARITY_ARRAY_SIZE);
1883 arity[0] = 0;
1884 traverse_global_trie(TrNode_child(GLOBAL_root_gt), str, 0, arity,
1885 TRAVERSE_MODE_NORMAL,
1886 TRAVERSE_POSITION_FIRST PASS_REGS);
1887 free(str);
1888 free(arity);
1889 } else
1890 SHOW_TABLE_STRUCTURE(" EMPTY\n");
1891 if (show_mode == SHOW_MODE_STATISTICS) {
1892 fprintf(TrStat_out, " Terms: %ld\n", TrStat_gt_terms);
1893 fprintf(TrStat_out, " Global trie nodes: %ld\n", TrStat_gt_nodes);
1894 fprintf(TrStat_out, " Global trie auto references: %ld\n", TrStat_gt_refs);
1895 }
1896 return;
1897}
1898#endif /* TABLING */
Yap.h
Main definitions.
answer_trie_hash
Definition: tab.structs.h:140
answer_trie_node
Definition: tab.structs.h:70
bucket
Definition: hash.h:40
global_trie_hash
Definition: tab.structs.h:153
global_trie_node
Definition: tab.structs.h:84
subgoal_entry
Definition: tab.structs.h:240
subgoal_frame
Definition: tab.structs.h:296
subgoal_trie_hash
Definition: tab.structs.h:128
subgoal_trie_node
Definition: tab.structs.h:60
table_entry
Definition: tab.structs.h:22
yami
Definition: amidefs.h:264