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 <stdio.h>
21 #ifdef HAVE_STRING_H
22 #include <string.h>
23 #endif /* HAVE_STRING_H */
24 #include "Yatom.h"
25 #include "YapHeap.h"
26 #include "yapio.h"
27 #include "tab.macros.h"
28
29 static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr, sg_node_ptr, Term);
30 static inline sg_node_ptr subgoal_trie_check_insert_gt_entry(tab_ent_ptr, sg_node_ptr, Term);
31 static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr, ans_node_ptr, Term, int);
32 static inline ans_node_ptr answer_trie_check_insert_gt_entry(sg_fr_ptr, ans_node_ptr, Term, int);
33 static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr, Term);
34 #ifdef GLOBAL_TRIE_FOR_SUBTERMS
35 static inline gt_node_ptr global_trie_check_insert_gt_entry(gt_node_ptr, Term);
36 #endif /* GLOBAL_TRIE_FOR_SUBTERMS */
37
38 static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr, sg_node_ptr, Term, int *, CELL **);
39 static inline sg_node_ptr subgoal_search_terms_loop(tab_ent_ptr, sg_node_ptr, Term, int *, CELL **);
40 static inline ans_node_ptr answer_search_loop(sg_fr_ptr, ans_node_ptr, Term, int *);
41 static inline ans_node_ptr answer_search_terms_loop(sg_fr_ptr, ans_node_ptr, Term, int *);
42 #ifdef GLOBAL_TRIE_FOR_SUBTERMS
43 static inline gt_node_ptr subgoal_search_global_trie_terms_loop(Term, int *, CELL **, CELL *);
44 static inline gt_node_ptr answer_search_global_trie_terms_loop(Term, int *, CELL *);
45 #else
46 static inline gt_node_ptr subgoal_search_global_trie_loop(Term, int *, CELL **);
47 static inline gt_node_ptr answer_search_global_trie_loop(Term, int *);
48 #endif /* GLOBAL_TRIE_MODE */
49 static inline CELL *load_answer_loop(ans_node_ptr);
50 static inline CELL *load_substitution_loop(gt_node_ptr, int *, CELL *);
51 static inline CELL *exec_substitution_loop(gt_node_ptr, CELL **, CELL *);
52
53 #ifdef YAPOR
54 #ifdef TABLING_INNER_CUTS
55 static int update_answer_trie_branch(ans_node_ptr, ans_node_ptr);
56 #else /* YAPOR && ! TABLING_INNER_CUTS */
57 static int update_answer_trie_branch(ans_node_ptr);
58 #endif
59 #else /* ! YAPOR */
60 static void update_answer_trie_branch(ans_node_ptr, int);
61 #endif
62 #ifdef GLOBAL_TRIE_FOR_SUBTERMS
63 static void free_global_trie_branch(gt_node_ptr, int);
64 #else
65 static void free_global_trie_branch(gt_node_ptr);
66 #endif /* GLOBAL_TRIE_FOR_SUBTERMS */
67
68 static void traverse_subgoal_trie(sg_node_ptr, char *, int, int *, int, int);
69 static void traverse_answer_trie(ans_node_ptr, char *, int, int *, int, int, int);
70 static void traverse_global_trie(gt_node_ptr, char *, int, int *, int, int);
71 static void traverse_global_trie_for_term(gt_node_ptr, char *, int *, int *, int *, int);
72 static inline void traverse_trie_node(Term, char *, int *, int *, int *, int);
73 static inline void traverse_update_arity(char *, int *, int *);
74
75
76 /*******************************
77 ** Structs & Macros **
78 *******************************/
79
80 static struct trie_statistics{
81 int show;
82 long subgoals;
83 long subgoals_incomplete;
84 long subgoal_trie_nodes;
85 long answers;
86 #ifdef TABLING_INNER_CUTS
87 long answers_pruned;
88 #endif /* TABLING_INNER_CUTS */
89 long answers_true;
90 long answers_no;
91 long answer_trie_nodes;
92 long global_trie_terms;
93 long global_trie_nodes;
94 long global_trie_references;
95 } trie_stats;
96
97 #define TrStat_show trie_stats.show
98 #define TrStat_subgoals trie_stats.subgoals
99 #define TrStat_sg_incomplete trie_stats.subgoals_incomplete
100 #define TrStat_sg_nodes trie_stats.subgoal_trie_nodes
101 #define TrStat_answers trie_stats.answers
102 #define TrStat_answers_true trie_stats.answers_true
103 #define TrStat_answers_no trie_stats.answers_no
104 #define TrStat_answers_pruned trie_stats.answers_pruned
105 #define TrStat_ans_nodes trie_stats.answer_trie_nodes
106 #define TrStat_gt_terms trie_stats.global_trie_terms
107 #define TrStat_gt_nodes trie_stats.global_trie_nodes
108 #define TrStat_gt_refs trie_stats.global_trie_references
109 #define SHOW_TABLE_STR_ARRAY_SIZE 100000
110 #define SHOW_TABLE_ARITY_ARRAY_SIZE 10000
111 #define SHOW_TABLE_STRUCTURE(MESG, ARGS...) \
112 if (TrStat_show == SHOW_MODE_STRUCTURE) \
113 fprintf(Yap_stdout, MESG, ##ARGS)
114
115 #define CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF,MODE) \
116 if (MODE == TRAVERSE_MODE_NORMAL && IsVarTerm(REF) && REF > VarIndexOfTableTerm(MAX_TABLE_VARS)) { \
117 register gt_node_ptr gt_node = (gt_node_ptr) (REF); \
118 TrNode_child(gt_node) = (gt_node_ptr) ((unsigned long int) TrNode_child(gt_node) - 1); \
119 if (TrNode_child(gt_node) == 0) \
120 FREE_GLOBAL_TRIE_BRANCH(gt_node,TRAVERSE_MODE_NORMAL); \
121 }
122 #ifdef GLOBAL_TRIE_FOR_SUBTERMS
123 #define CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(REF,MODE) \
124 CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF,MODE)
125 #define FREE_GLOBAL_TRIE_BRANCH(NODE,MODE) \
126 free_global_trie_branch(NODE,MODE)
127 #else
128 #define CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(REF,MODE)
129 #define FREE_GLOBAL_TRIE_BRANCH(NODE,MODE) \
130 free_global_trie_branch(NODE)
131 #endif /* GLOBAL_TRIE_FOR_SUBTERMS */
132
133
134
135 /******************************
136 ** Local functions **
137 ******************************/
138
139 #define INCLUDE_SUBGOAL_TRIE_CHECK_INSERT /* subgoal_trie_check_insert_entry */
140 #define INCLUDE_ANSWER_TRIE_CHECK_INSERT /* answer_trie_check_insert_entry */
141 #define INCLUDE_GLOBAL_TRIE_CHECK_INSERT /* global_trie_check_insert_entry */
142 #include "tab.tries.i"
143 #undef INCLUDE_GLOBAL_TRIE_CHECK_INSERT
144 #undef INCLUDE_ANSWER_TRIE_CHECK_INSERT
145 #undef INCLUDE_SUBGOAL_TRIE_CHECK_INSERT
146
147 #define MODE_GLOBAL_TRIE_ENTRY
148 #define INCLUDE_SUBGOAL_TRIE_CHECK_INSERT /* subgoal_trie_check_insert_gt_entry */
149 #define INCLUDE_ANSWER_TRIE_CHECK_INSERT /* answer_trie_check_insert_gt_entry */
150 #ifdef GLOBAL_TRIE_FOR_SUBTERMS
151 #define INCLUDE_GLOBAL_TRIE_CHECK_INSERT /* global_trie_check_insert_gt_entry */
152 #endif /* GLOBAL_TRIE_FOR_SUBTERMS */
153 #include "tab.tries.i"
154 #undef INCLUDE_GLOBAL_TRIE_CHECK_INSERT
155 #undef INCLUDE_ANSWER_TRIE_CHECK_INSERT
156 #undef INCLUDE_SUBGOAL_TRIE_CHECK_INSERT
157 #undef MODE_GLOBAL_TRIE_ENTRY
158
159 #define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_loop */
160 #define INCLUDE_ANSWER_SEARCH_LOOP /* answer_search_loop */
161 #define INCLUDE_LOAD_ANSWER_LOOP /* load_answer_loop */
162 #include "tab.tries.i"
163 #undef INCLUDE_LOAD_ANSWER_LOOP
164 #undef INCLUDE_ANSWER_SEARCH_LOOP
165 #undef INCLUDE_SUBGOAL_SEARCH_LOOP
166
167 #define MODE_TERMS_LOOP
168 #define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_terms_loop */
169 #define INCLUDE_ANSWER_SEARCH_LOOP /* answer_search_terms_loop */
170 #include "tab.tries.i"
171 #undef INCLUDE_ANSWER_SEARCH_LOOP
172 #undef INCLUDE_SUBGOAL_SEARCH_LOOP
173 #undef MODE_TERMS_LOOP
174
175 #define MODE_GLOBAL_TRIE_LOOP
176 #define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_global_trie_(terms)_loop */
177 #define INCLUDE_ANSWER_SEARCH_LOOP /* answer_search_global_trie_(terms)_loop */
178 #define INCLUDE_LOAD_ANSWER_LOOP /* load_substitution_loop */
179 #include "tab.tries.i"
180 #undef INCLUDE_LOAD_ANSWER_LOOP
181 #undef INCLUDE_ANSWER_SEARCH_LOOP
182 #undef INCLUDE_SUBGOAL_SEARCH_LOOP
183 #undef MODE_GLOBAL_TRIE_LOOP
184
185
exec_substitution_loop(gt_node_ptr current_node,CELL ** stack_vars_ptr,CELL * stack_terms)186 static inline CELL *exec_substitution_loop(gt_node_ptr current_node, CELL **stack_vars_ptr, CELL *stack_terms) {
187 /************************************************************************
188 ===========
189 | |
190 | ... |
191 | |
192 -----------
193 YENV --> | N+1 | <-- stack_vars
194 -----------
195 | VAR_N |
196 -----------
197 | ... |
198 -----------
199 | VAR_0 |
200 -----------
201 | |
202 | ... |
203 | |
204 ===========
205 | |
206 | ... |
207 | |
208 -----------
209 TR --> | | <-- stack_terms_limit
210 -----------
211 | |
212 | ... |
213 | |
214 ----------|
215 | TERM_N | <-- stack_terms
216 ----------| *
217 | ... | /|\
218 ----------| | stack_terms_pair_offset (TRIE_COMPACT_PAIRS)
219 | TERM_1 | \|/
220 =========== *
221 Yap_TrailTop --> | | <-- stack_terms_base (TRIE_COMPACT_PAIRS)
222 -----------
223 ************************************************************************/
224 CELL *stack_vars = *stack_vars_ptr;
225 CELL *stack_terms_limit = (CELL *) TR;
226 #ifdef TRIE_COMPACT_PAIRS
227 #define stack_terms_base ((CELL *) Yap_TrailTop)
228 int stack_terms_pair_offset = 0;
229 #endif /* TRIE_COMPACT_PAIRS */
230 Term t = TrNode_entry(current_node);
231 current_node = TrNode_parent(current_node);
232
233 do {
234 if (IsVarTerm(t)) {
235 #ifdef GLOBAL_TRIE_FOR_SUBTERMS
236 if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) {
237 stack_terms = exec_substitution_loop((gt_node_ptr) t, &stack_vars, stack_terms);
238 } else
239 #endif /* GLOBAL_TRIE_FOR_SUBTERMS */
240 {
241 int var_index = VarIndexOfTableTerm(t);
242 int vars_arity = *stack_vars;
243 t = MkVarTerm();
244 if (var_index >= vars_arity) {
245 while (vars_arity < var_index) {
246 *stack_vars-- = 0;
247 vars_arity++;
248 }
249 *stack_vars-- = t;
250 vars_arity++;
251 *stack_vars = vars_arity;
252 } else {
253 /* do the same as in macro stack_trie_val_instr() */
254 CELL aux_sub, aux_var, *vars_ptr;
255 vars_ptr = stack_vars + vars_arity - var_index;
256 aux_sub = *((CELL *) t);
257 aux_var = *vars_ptr;
258 if (aux_var == 0) {
259 *vars_ptr = t;
260 } else {
261 if (aux_sub > aux_var) {
262 if ((CELL *) aux_sub <= H) {
263 Bind_Global((CELL *) aux_sub, aux_var);
264 } else if ((CELL *) aux_var <= H) {
265 Bind_Local((CELL *) aux_sub, aux_var);
266 } else {
267 Bind_Local((CELL *) aux_var, aux_sub);
268 *vars_ptr = aux_sub;
269 }
270 } else {
271 if ((CELL *) aux_var <= H) {
272 Bind_Global((CELL *) aux_var, aux_sub);
273 *vars_ptr = aux_sub;
274 } else if ((CELL *) aux_sub <= H) {
275 Bind_Local((CELL *) aux_var, aux_sub);
276 *vars_ptr = aux_sub;
277 } else {
278 Bind_Local((CELL *) aux_sub, aux_var);
279 }
280 }
281 }
282 }
283 AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit);
284 STACK_PUSH_UP(t, stack_terms);
285 }
286 } else if (IsAtomOrIntTerm(t)) {
287 AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit);
288 STACK_PUSH_UP(t, stack_terms);
289 } else if (IsPairTerm(t)) {
290 #ifdef TRIE_COMPACT_PAIRS
291 if (t == CompactPairInit) {
292 Term *stack_aux = stack_terms_base - stack_terms_pair_offset;
293 Term head, tail = STACK_POP_UP(stack_aux);
294 while (STACK_NOT_EMPTY(stack_aux, stack_terms)) {
295 head = STACK_POP_UP(stack_aux);
296 tail = MkPairTerm(head, tail);
297 }
298 stack_terms = stack_terms_base - stack_terms_pair_offset;
299 stack_terms_pair_offset = (int) STACK_POP_DOWN(stack_terms);
300 STACK_PUSH_UP(tail, stack_terms);
301 } else { /* CompactPairEndList / CompactPairEndTerm */
302 Term last;
303 AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1);
304 last = STACK_POP_DOWN(stack_terms);
305 STACK_PUSH_UP(stack_terms_pair_offset, stack_terms);
306 stack_terms_pair_offset = (int) (stack_terms_base - stack_terms);
307 if (t == CompactPairEndList)
308 STACK_PUSH_UP(TermNil, stack_terms);
309 STACK_PUSH_UP(last, stack_terms);
310 }
311 #else
312 Term head = STACK_POP_DOWN(stack_terms);
313 Term tail = STACK_POP_DOWN(stack_terms);
314 t = MkPairTerm(head, tail);
315 STACK_PUSH_UP(t, stack_terms);
316 #endif /* TRIE_COMPACT_PAIRS */
317 } else if (IsApplTerm(t)) {
318 Functor f = (Functor) RepAppl(t);
319 if (f == FunctorDouble) {
320 volatile Float dbl;
321 volatile Term *t_dbl = (Term *)((void *) &dbl);
322 t = TrNode_entry(current_node);
323 current_node = TrNode_parent(current_node);
324 t_dbl[0] = t;
325 #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
326 t = TrNode_entry(current_node);
327 current_node = TrNode_parent(current_node);
328 t_dbl[1] = t;
329 #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
330 current_node = TrNode_parent(current_node);
331 t = MkFloatTerm(dbl);
332 } else if (f == FunctorLongInt) {
333 Int li = TrNode_entry(current_node);
334 current_node = TrNode_parent(current_node);
335 current_node = TrNode_parent(current_node);
336 t = MkLongIntTerm(li);
337 } else {
338 int f_arity = ArityOfFunctor(f);
339 t = Yap_MkApplTerm(f, f_arity, stack_terms);
340 stack_terms += f_arity;
341 }
342 AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit);
343 STACK_PUSH_UP(t, stack_terms);
344 }
345 t = TrNode_entry(current_node);
346 current_node = TrNode_parent(current_node);
347 } while (current_node);
348
349 *stack_vars_ptr = stack_vars;
350 return stack_terms;
351
352 #ifdef TRIE_COMPACT_PAIRS
353 #undef stack_terms_base
354 #endif /* TRIE_COMPACT_PAIRS */
355 }
356
357
358 #ifdef YAPOR
359 #ifdef TABLING_INNER_CUTS
update_answer_trie_branch(ans_node_ptr previous_node,ans_node_ptr current_node)360 static int update_answer_trie_branch(ans_node_ptr previous_node, ans_node_ptr current_node) {
361 int ltt;
362 if (! IS_ANSWER_LEAF_NODE(current_node)) {
363 if (TrNode_child(current_node)) {
364 TrNode_instr(TrNode_child(current_node)) -= 1; /* retry --> try */
365 update_answer_trie_branch(NULL, TrNode_child(current_node));
366 if (TrNode_child(current_node))
367 goto update_next_trie_branch;
368 }
369 /* node belonging to a pruned answer */
370 if (previous_node) {
371 TrNode_next(previous_node) = TrNode_next(current_node);
372 FREE_ANSWER_TRIE_NODE(current_node);
373 if (TrNode_next(previous_node)) {
374 return update_answer_trie_branch(previous_node, TrNode_next(previous_node));
375 } else {
376 TrNode_instr(previous_node) -= 2; /* retry --> trust : try --> do */
377 return 0;
378 }
379 } else {
380 TrNode_child(TrNode_parent(current_node)) = TrNode_next(current_node);
381 if (TrNode_next(current_node)) {
382 TrNode_instr(TrNode_next(current_node)) -= 1; /* retry --> try */
383 update_answer_trie_branch(NULL, TrNode_next(current_node));
384 }
385 FREE_ANSWER_TRIE_NODE(current_node);
386 return 0;
387 }
388 }
389 update_next_trie_branch:
390 if (TrNode_next(current_node)) {
391 ltt = 1 + update_answer_trie_branch(current_node, TrNode_next(current_node));
392 } else {
393 TrNode_instr(current_node) -= 2; /* retry --> trust : try --> do */
394 ltt = 1;
395 }
396
397 TrNode_or_arg(current_node) = ltt;
398 TrNode_instr(current_node) = Yap_opcode(TrNode_instr(current_node));
399 return ltt;
400 }
401 #else /* YAPOR && ! TABLING_INNER_CUTS */
update_answer_trie_branch(ans_node_ptr current_node)402 static int update_answer_trie_branch(ans_node_ptr current_node) {
403 int ltt;
404 if (! IS_ANSWER_LEAF_NODE(current_node)) {
405 TrNode_instr(TrNode_child(current_node)) -= 1; /* retry --> try */
406 update_answer_trie_branch(TrNode_child(current_node));
407 }
408 if (TrNode_next(current_node)) {
409 ltt = 1 + update_answer_trie_branch(TrNode_next(current_node));
410 } else {
411 TrNode_instr(current_node) -= 2; /* retry --> trust : try --> do */
412 ltt = 1;
413 }
414 TrNode_or_arg(current_node) = ltt;
415 TrNode_instr(current_node) = Yap_opcode(TrNode_instr(current_node));
416 return ltt;
417 }
418 #endif
419 #else /* ! YAPOR */
update_answer_trie_branch(ans_node_ptr current_node,int position)420 static void update_answer_trie_branch(ans_node_ptr current_node, int position) {
421 if (! IS_ANSWER_LEAF_NODE(current_node))
422 update_answer_trie_branch(TrNode_child(current_node), TRAVERSE_POSITION_FIRST); /* retry --> try */
423 if (position == TRAVERSE_POSITION_FIRST) {
424 ans_node_ptr next = TrNode_next(current_node);
425 if (next) {
426 while (TrNode_next(next)) {
427 update_answer_trie_branch(next, TRAVERSE_POSITION_NEXT); /* retry --> retry */
428 next = TrNode_next(next);
429 }
430 update_answer_trie_branch(next, TRAVERSE_POSITION_LAST); /* retry --> trust */
431 } else
432 position += TRAVERSE_POSITION_LAST; /* try --> do */
433 }
434 TrNode_instr(current_node) = Yap_opcode(TrNode_instr(current_node) - position);
435 return;
436 }
437 #endif /* YAPOR */
438
439
440 #ifdef GLOBAL_TRIE_FOR_SUBTERMS
free_global_trie_branch(gt_node_ptr current_node,int mode)441 static void free_global_trie_branch(gt_node_ptr current_node, int mode) {
442 Term t = TrNode_entry(current_node);
443 #else
444 static void free_global_trie_branch(gt_node_ptr current_node) {
445 #endif /* GLOBAL_TRIE_FOR_SUBTERMS */
446 gt_node_ptr parent_node, child_node;
447
448 parent_node = TrNode_parent(current_node);
449 child_node = TrNode_child(parent_node);
450 if (IS_GLOBAL_TRIE_HASH(child_node)) {
451 gt_hash_ptr hash = (gt_hash_ptr) child_node;
452 gt_node_ptr *bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(current_node), Hash_seed(hash)));
453 int num_nodes = --Hash_num_nodes(hash);
454 child_node = *bucket;
455 if (child_node != current_node) {
456 while (TrNode_next(child_node) != current_node)
457 child_node = TrNode_next(child_node);
458 TrNode_next(child_node) = TrNode_next(current_node);
459 CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode);
460 FREE_GLOBAL_TRIE_NODE(current_node);
461 } else {
462 *bucket = TrNode_next(current_node);
463 CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode);
464 FREE_GLOBAL_TRIE_NODE(current_node);
465 if (num_nodes == 0) {
466 FREE_HASH_BUCKETS(Hash_buckets(hash));
467 FREE_GLOBAL_TRIE_HASH(hash);
468 if (parent_node != GLOBAL_root_gt) {
469 #ifdef GLOBAL_TRIE_FOR_SUBTERMS
470 if (mode == TRAVERSE_MODE_NORMAL) {
471 if (IsApplTerm(t)) {
472 Functor f = (Functor) RepAppl(t);
473 if (f == FunctorDouble)
474 mode = TRAVERSE_MODE_DOUBLE;
475 else if (f == FunctorLongInt)
476 mode = TRAVERSE_MODE_LONGINT;
477 else
478 mode = TRAVERSE_MODE_NORMAL;
479 } else
480 mode = TRAVERSE_MODE_NORMAL;
481 } else if (mode == TRAVERSE_MODE_LONGINT)
482 mode = TRAVERSE_MODE_LONGINT_END;
483 else if (mode == TRAVERSE_MODE_DOUBLE)
484 #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
485 mode = TRAVERSE_MODE_DOUBLE2;
486 else if (mode == TRAVERSE_MODE_DOUBLE2)
487 #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
488 mode = TRAVERSE_MODE_DOUBLE_END;
489 else
490 mode = TRAVERSE_MODE_NORMAL;
491 #endif /* GLOBAL_TRIE_FOR_SUBTERMS */
492 FREE_GLOBAL_TRIE_BRANCH(parent_node, mode);
493 } else
494 TrNode_child(parent_node) = NULL;
495 }
496 }
497 } else if (child_node != current_node) {
498 while (TrNode_next(child_node) != current_node)
499 child_node = TrNode_next(child_node);
500 TrNode_next(child_node) = TrNode_next(current_node);
501 CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode);
502 FREE_GLOBAL_TRIE_NODE(current_node);
503 } else if (TrNode_next(current_node) == NULL) {
504 CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode);
505 FREE_GLOBAL_TRIE_NODE(current_node);
506 if (parent_node != GLOBAL_root_gt) {
507 #ifdef GLOBAL_TRIE_FOR_SUBTERMS
508 if (mode == TRAVERSE_MODE_NORMAL) {
509 if (IsApplTerm(t)) {
510 Functor f = (Functor) RepAppl(t);
511 if (f == FunctorDouble)
512 mode = TRAVERSE_MODE_DOUBLE;
513 else if (f == FunctorLongInt)
514 mode = TRAVERSE_MODE_LONGINT;
515 else
516 mode = TRAVERSE_MODE_NORMAL;
517 } else
518 mode = TRAVERSE_MODE_NORMAL;
519 } else if (mode == TRAVERSE_MODE_LONGINT)
520 mode = TRAVERSE_MODE_LONGINT_END;
521 else if (mode == TRAVERSE_MODE_DOUBLE)
522 #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
523 mode = TRAVERSE_MODE_DOUBLE2;
524 else if (mode == TRAVERSE_MODE_DOUBLE2)
525 #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
526 mode = TRAVERSE_MODE_DOUBLE_END;
527 else
528 mode = TRAVERSE_MODE_NORMAL;
529 #endif /* GLOBAL_TRIE_FOR_SUBTERMS */
530 FREE_GLOBAL_TRIE_BRANCH(parent_node, mode);
531 } else
532 TrNode_child(parent_node) = NULL;
533 } else {
534 TrNode_child(parent_node) = TrNode_next(current_node);
535 CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode);
536 FREE_GLOBAL_TRIE_NODE(current_node);
537 }
538 return;
539 }
540
541
542 static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_index, int *arity, int mode, int position) {
543 int *current_arity = NULL, current_str_index = 0, current_mode = 0;
544
545 /* test if hashing */
546 if (IS_SUBGOAL_TRIE_HASH(current_node)) {
547 sg_node_ptr *bucket, *last_bucket;
548 sg_hash_ptr hash;
549 hash = (sg_hash_ptr) current_node;
550 bucket = Hash_buckets(hash);
551 last_bucket = bucket + Hash_num_buckets(hash);
552 current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
553 memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
554 do {
555 if (*bucket) {
556 traverse_subgoal_trie(*bucket, str, str_index, arity, mode, TRAVERSE_POSITION_FIRST);
557 memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
558 #ifdef TRIE_COMPACT_PAIRS
559 if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
560 str[str_index - 1] = ',';
561 #else
562 if (arity[arity[0]] == -1)
563 str[str_index - 1] = '|';
564 #endif /* TRIE_COMPACT_PAIRS */
565 }
566 } while (++bucket != last_bucket);
567 free(current_arity);
568 return;
569 }
570
571 /* save current state if first sibling node */
572 if (position == TRAVERSE_POSITION_FIRST) {
573 current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
574 memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
575 current_str_index = str_index;
576 current_mode = mode;
577 }
578
579 /* process current trie node */
580 TrStat_sg_nodes++;
581 traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_SUBGOAL);
582
583 /* show answers ... */
584 if (IS_SUBGOAL_LEAF_NODE(current_node)) {
585 sg_fr_ptr sg_fr = UNTAG_SUBGOAL_LEAF_NODE(TrNode_sg_fr(current_node));
586 TrStat_subgoals++;
587 str[str_index] = 0;
588 SHOW_TABLE_STRUCTURE("%s.\n", str);
589 TrStat_ans_nodes++;
590 if (SgFr_first_answer(sg_fr) == NULL) {
591 if (SgFr_state(sg_fr) < complete) {
592 TrStat_sg_incomplete++;
593 SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n");
594 } else {
595 TrStat_answers_no++;
596 SHOW_TABLE_STRUCTURE(" NO\n");
597 }
598 } else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
599 TrStat_answers_true++;
600 SHOW_TABLE_STRUCTURE(" TRUE\n");
601 } else {
602 arity[0] = 0;
603 traverse_answer_trie(TrNode_child(SgFr_answer_trie(sg_fr)), &str[str_index], 0, arity, 0, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST);
604 if (SgFr_state(sg_fr) < complete) {
605 TrStat_sg_incomplete++;
606 SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n");
607 }
608 }
609 }
610 /* ... or continue with child node */
611 else
612 traverse_subgoal_trie(TrNode_child(current_node), str, str_index, arity, mode, TRAVERSE_POSITION_FIRST);
613
614 /* restore the initial state and continue with sibling nodes */
615 if (position == TRAVERSE_POSITION_FIRST) {
616 str_index = current_str_index;
617 mode = current_mode;
618 current_node = TrNode_next(current_node);
619 while (current_node) {
620 memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
621 #ifdef TRIE_COMPACT_PAIRS
622 if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
623 str[str_index - 1] = ',';
624 #else
625 if (arity[arity[0]] == -1)
626 str[str_index - 1] = '|';
627 #endif /* TRIE_COMPACT_PAIRS */
628 traverse_subgoal_trie(current_node, str, str_index, arity, mode, TRAVERSE_POSITION_NEXT);
629 current_node = TrNode_next(current_node);
630 }
631 free(current_arity);
632 }
633
634 return;
635 }
636
637
638 static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_index, int *arity, int var_index, int mode, int position) {
639 int *current_arity = NULL, current_str_index = 0, current_var_index = 0, current_mode = 0;
640
641 /* test if hashing */
642 if (IS_ANSWER_TRIE_HASH(current_node)) {
643 ans_node_ptr *bucket, *last_bucket;
644 ans_hash_ptr hash;
645 hash = (ans_hash_ptr) current_node;
646 bucket = Hash_buckets(hash);
647 last_bucket = bucket + Hash_num_buckets(hash);
648 current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
649 memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
650 do {
651 if (*bucket) {
652 traverse_answer_trie(*bucket, str, str_index, arity, var_index, mode, TRAVERSE_POSITION_FIRST);
653 memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
654 #ifdef TRIE_COMPACT_PAIRS
655 if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
656 str[str_index - 1] = ',';
657 #else
658 if (arity[arity[0]] == -1)
659 str[str_index - 1] = '|';
660 #endif /* TRIE_COMPACT_PAIRS */
661 }
662 } while (++bucket != last_bucket);
663 free(current_arity);
664 return;
665 }
666
667 /* save current state if first sibling node */
668 if (position == TRAVERSE_POSITION_FIRST) {
669 current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
670 memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
671 current_str_index = str_index;
672 current_var_index = var_index;
673 current_mode = mode;
674 }
675
676 /* print VAR if starting a term */
677 if (arity[0] == 0 && mode == TRAVERSE_MODE_NORMAL) {
678 str_index += sprintf(& str[str_index], " VAR%d: ", var_index);
679 var_index++;
680 }
681
682 /* process current trie node */
683 TrStat_ans_nodes++;
684 traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_ANSWER);
685
686 /* show answer .... */
687 if (IS_ANSWER_LEAF_NODE(current_node)) {
688 TrStat_answers++;
689 str[str_index] = 0;
690 SHOW_TABLE_STRUCTURE("%s\n", str);
691 }
692 #ifdef TABLING_INNER_CUTS
693 /* ... or continue with pruned node */
694 else if (TrNode_child(current_node) == NULL) {
695 TrStat_answers++;
696 TrStat_answers_pruned++;
697 }
698 #endif /* TABLING_INNER_CUTS */
699 /* ... or continue with child node */
700 else
701 traverse_answer_trie(TrNode_child(current_node), str, str_index, arity, var_index, mode, TRAVERSE_POSITION_FIRST);
702
703 /* restore the initial state and continue with sibling nodes */
704 if (position == TRAVERSE_POSITION_FIRST) {
705 str_index = current_str_index;
706 var_index = current_var_index;
707 mode = current_mode;
708 current_node = TrNode_next(current_node);
709 while (current_node) {
710 memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
711 #ifdef TRIE_COMPACT_PAIRS
712 if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
713 str[str_index - 1] = ',';
714 #else
715 if (arity[arity[0]] == -1)
716 str[str_index - 1] = '|';
717 #endif /* TRIE_COMPACT_PAIRS */
718 traverse_answer_trie(current_node, str, str_index, arity, var_index, mode, TRAVERSE_POSITION_NEXT);
719 current_node = TrNode_next(current_node);
720 }
721 free(current_arity);
722 }
723
724 return;
725 }
726
727
728 static void traverse_global_trie(gt_node_ptr current_node, char *str, int str_index, int *arity, int mode, int position) {
729 int *current_arity = NULL, current_str_index = 0, current_mode = 0;
730
731 /* test if hashing */
732 if (IS_GLOBAL_TRIE_HASH(current_node)) {
733 gt_node_ptr *bucket, *last_bucket;
734 gt_hash_ptr hash;
735 hash = (gt_hash_ptr) current_node;
736 bucket = Hash_buckets(hash);
737 last_bucket = bucket + Hash_num_buckets(hash);
738 current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
739 memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
740 do {
741 if (*bucket) {
742 traverse_global_trie(*bucket, str, str_index, arity, mode, TRAVERSE_POSITION_FIRST);
743 memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
744 #ifdef TRIE_COMPACT_PAIRS
745 if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
746 str[str_index - 1] = ',';
747 #else
748 if (arity[arity[0]] == -1)
749 str[str_index - 1] = '|';
750 #endif /* TRIE_COMPACT_PAIRS */
751 }
752 } while (++bucket != last_bucket);
753 free(current_arity);
754 return;
755 }
756
757 /* save current state if first sibling node */
758 if (position == TRAVERSE_POSITION_FIRST) {
759 current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1));
760 memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
761 current_str_index = str_index;
762 current_mode = mode;
763 }
764
765 /* process current trie node */
766 TrStat_gt_nodes++;
767 traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_GT_SUBGOAL);
768
769 /* continue with child node ... */
770 if (arity[0] != 0 || mode != TRAVERSE_MODE_NORMAL)
771 traverse_global_trie(TrNode_child(current_node), str, str_index, arity, mode, TRAVERSE_POSITION_FIRST);
772 /* ... or show term */
773 else {
774 TrStat_gt_terms++;
775 str[str_index] = 0;
776 SHOW_TABLE_STRUCTURE(" TERMx%ld: %s\n", (unsigned long int) TrNode_child(current_node), str);
777 }
778
779 /* restore the initial state and continue with sibling nodes */
780 if (position == TRAVERSE_POSITION_FIRST) {
781 str_index = current_str_index;
782 mode = current_mode;
783 current_node = TrNode_next(current_node);
784 while (current_node) {
785 memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
786 #ifdef TRIE_COMPACT_PAIRS
787 if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
788 str[str_index - 1] = ',';
789 #else
790 if (arity[arity[0]] == -1)
791 str[str_index - 1] = '|';
792 #endif /* TRIE_COMPACT_PAIRS */
793 traverse_global_trie(current_node, str, str_index, arity, mode, TRAVERSE_POSITION_NEXT);
794 current_node = TrNode_next(current_node);
795 }
796 free(current_arity);
797 }
798
799 return;
800 }
801
802
803 static void traverse_global_trie_for_term(gt_node_ptr current_node, char *str, int *str_index, int *arity, int *mode, int type) {
804 if (TrNode_parent(current_node) != GLOBAL_root_gt)
805 traverse_global_trie_for_term(TrNode_parent(current_node), str, str_index, arity, mode, type);
806 traverse_trie_node(TrNode_entry(current_node), str, str_index, arity, mode, type);
807 return;
808 }
809
810
811 static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int *arity, int *mode_ptr, int type) {
812 int mode = *mode_ptr;
813 int str_index = *str_index_ptr;
814
815 /* test the node type */
816 if (mode == TRAVERSE_MODE_DOUBLE) {
817 #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
818 arity[0]++;
819 arity[arity[0]] = (int) t;
820 mode = TRAVERSE_MODE_DOUBLE2;
821 } else if (mode == TRAVERSE_MODE_DOUBLE2) {
822 volatile Float dbl = 0;
823 volatile Term *t_dbl = (Term *)((void *) &dbl);
824 t_dbl[0] = t;
825 t_dbl[1] = (Term) arity[arity[0]];
826 arity[0]--;
827 #else /* SIZEOF_DOUBLE == SIZEOF_INT_P */
828 volatile Float dbl;
829 volatile Term *t_dbl = (Term *)((void *) &dbl);
830 t_dbl[0] = t;
831 #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
832 str_index += sprintf(& str[str_index], "%.15g", dbl);
833 traverse_update_arity(str, &str_index, arity);
834 if (type == TRAVERSE_TYPE_SUBGOAL)
835 mode = TRAVERSE_MODE_NORMAL;
836 else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_SUBGOAL || TRAVERSE_TYPE_GT_ANSWER */
837 mode = TRAVERSE_MODE_DOUBLE_END;
838 } else if (mode == TRAVERSE_MODE_DOUBLE_END) {
839 mode = TRAVERSE_MODE_NORMAL;
840 } else if (mode == TRAVERSE_MODE_LONGINT) {
841 Int li = (Int) t;
842 #if SHORT_INTS
843 str_index += sprintf(& str[str_index], "%ld", li);
844 #else
845 str_index += sprintf(& str[str_index], "%d", li);
846 #endif /* SHORT_INTS */
847 traverse_update_arity(str, &str_index, arity);
848 if (type == TRAVERSE_TYPE_SUBGOAL)
849 mode = TRAVERSE_MODE_NORMAL;
850 else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_SUBGOAL || TRAVERSE_TYPE_GT_ANSWER */
851 mode = TRAVERSE_MODE_LONGINT_END;
852 } else if (mode == TRAVERSE_MODE_LONGINT_END) {
853 mode = TRAVERSE_MODE_NORMAL;
854 } else if (IsVarTerm(t)) {
855 if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) {
856 TrStat_gt_refs++;
857 /* (type % 2 + 2): TRAVERSE_TYPE_ANSWER --> TRAVERSE_TYPE_GT_ANSWER */
858 /* (type % 2 + 2): TRAVERSE_TYPE_SUBGOAL --> TRAVERSE_TYPE_GT_SUBGOAL */
859 traverse_global_trie_for_term((gt_node_ptr) t, str, &str_index, arity, &mode, type % 2 + 2);
860 } else {
861 if (type == TRAVERSE_TYPE_SUBGOAL || type == TRAVERSE_TYPE_GT_SUBGOAL)
862 str_index += sprintf(& str[str_index], "VAR%d", VarIndexOfTableTerm(t));
863 else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_ANSWER */
864 str_index += sprintf(& str[str_index], "ANSVAR%d", VarIndexOfTableTerm(t));
865 traverse_update_arity(str, &str_index, arity);
866 }
867 } else if (IsIntTerm(t)) {
868 #if SHORT_INTS
869 str_index += sprintf(& str[str_index], "%ld", IntOfTerm(t));
870 #else
871 str_index += sprintf(& str[str_index], "%d", IntOfTerm(t));
872 #endif /* SHORT_INTS */
873 traverse_update_arity(str, &str_index, arity);
874 } else if (IsAtomTerm(t)) {
875 #ifndef TRIE_COMPACT_PAIRS
876 if (arity[arity[0]] == -1 && t == TermNil) {
877 str[str_index - 1] = ']';
878 arity[0]--;
879 } else
880 #endif /* TRIE_COMPACT_PAIRS */
881 str_index += sprintf(& str[str_index], "%s", AtomName(AtomOfTerm(t)));
882 traverse_update_arity(str, &str_index, arity);
883 } else if (IsPairTerm(t)) {
884 #ifdef TRIE_COMPACT_PAIRS
885 if (t == CompactPairEndList)
886 arity[arity[0]] = -1;
887 else if (t == CompactPairEndTerm) {
888 str[str_index - 1] = '|';
889 arity[arity[0]] = -1;
890 #else
891 if (arity[arity[0]] == -1) {
892 str[str_index - 1] = ',';
893 arity[arity[0]] = -2;
894 #endif /* TRIE_COMPACT_PAIRS */
895 } else {
896 str_index += sprintf(& str[str_index], "[");
897 arity[0]++;
898 arity[arity[0]] = -2;
899 }
900 } else if (IsApplTerm(t)) {
901 Functor f = (Functor) RepAppl(t);
902 if (f == FunctorDouble) {
903 mode = TRAVERSE_MODE_DOUBLE;
904 } else if (f == FunctorLongInt) {
905 mode = TRAVERSE_MODE_LONGINT;
906 } else if (f == FunctorComma) {
907 if (arity[arity[0]] != -3) {
908 str_index += sprintf(& str[str_index], "(");
909 arity[0]++;
910 }
911 arity[arity[0]] = -4;
912 } else {
913 str_index += sprintf(& str[str_index], "%s(", AtomName(NameOfFunctor(f)));
914 arity[0]++;
915 arity[arity[0]] = ArityOfFunctor(f);
916 }
917 }
918
919 *mode_ptr = mode;
920 *str_index_ptr = str_index;
921 return;
922 }
923
924
925 static inline void traverse_update_arity(char *str, int *str_index_ptr, int *arity) {
926 int str_index = *str_index_ptr;
927 while (arity[0]) {
928 if (arity[arity[0]] > 0) {
929 arity[arity[0]]--;
930 if (arity[arity[0]] == 0) {
931 str_index += sprintf(& str[str_index], ")");
932 arity[0]--;
933 } else {
934 str_index += sprintf(& str[str_index], ",");
935 break;
936 }
937 } else {
938 if (arity[arity[0]] == -4) {
939 str_index += sprintf(& str[str_index], ",");
940 arity[arity[0]] = -3;
941 break;
942 } else if (arity[arity[0]] == -3) {
943 str_index += sprintf(& str[str_index], ")");
944 arity[0]--;
945 } else if (arity[arity[0]] == -2) {
946 #ifdef TRIE_COMPACT_PAIRS
947 str_index += sprintf(& str[str_index], ",");
948 #else
949 str_index += sprintf(& str[str_index], "|");
950 arity[arity[0]] = -1;
951 #endif /* TRIE_COMPACT_PAIRS */
952 break;
953 } else if (arity[arity[0]] == -1) {
954 str_index += sprintf(& str[str_index], "]");
955 arity[0]--;
956 }
957 }
958 }
959 *str_index_ptr = str_index;
960 }
961
962
963
964 /*******************************
965 ** Global functions **
966 *******************************/
967
968 sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) {
969 CELL *stack_vars;
970 int i, subs_arity, pred_arity;
971 tab_ent_ptr tab_ent;
972 sg_fr_ptr sg_fr;
973 sg_node_ptr current_sg_node;
974
975 stack_vars = *Yaddr;
976 subs_arity = 0;
977 pred_arity = preg->u.Otapl.s;
978 tab_ent = preg->u.Otapl.te;
979 current_sg_node = TabEnt_subgoal_trie(tab_ent);
980 #ifdef TABLE_LOCK_AT_ENTRY_LEVEL
981 LOCK(TabEnt_lock(tab_ent));
982 #endif /* TABLE_LOCK_LEVEL */
983
984 if (IsMode_GlobalTrie(TabEnt_mode(tab_ent))) {
985 for (i = 1; i <= pred_arity; i++)
986 current_sg_node = subgoal_search_terms_loop(tab_ent, current_sg_node, Deref(XREGS[i]), &subs_arity, &stack_vars);
987 } else {
988 for (i = 1; i <= pred_arity; i++)
989 current_sg_node = subgoal_search_loop(tab_ent, current_sg_node, Deref(XREGS[i]), &subs_arity, &stack_vars);
990 }
991
992 STACK_PUSH_UP(subs_arity, stack_vars);
993 *Yaddr = stack_vars++;
994 /* reset variables */
995 while (subs_arity--) {
996 Term t = STACK_POP_DOWN(stack_vars);
997 RESET_VARIABLE(t);
998 }
999
1000 #if defined(TABLE_LOCK_AT_NODE_LEVEL)
1001 LOCK(TrNode_lock(current_sg_node));
1002 #elif defined(TABLE_LOCK_AT_WRITE_LEVEL)
1003 LOCK_TABLE(current_sg_node);
1004 #endif /* TABLE_LOCK_LEVEL */
1005 if (TrNode_sg_fr(current_sg_node) == NULL) {
1006 /* new tabled subgoal */
1007 new_subgoal_frame(sg_fr, preg);
1008 TrNode_sg_fr(current_sg_node) = (sg_node_ptr) sg_fr;
1009 TAG_AS_SUBGOAL_LEAF_NODE(current_sg_node);
1010 } else {
1011 sg_fr = UNTAG_SUBGOAL_LEAF_NODE(TrNode_sg_fr(current_sg_node));
1012 #ifdef LIMIT_TABLING
1013 if (SgFr_state(sg_fr) <= ready) { /* incomplete or ready */
1014 remove_from_global_sg_fr_list(sg_fr);
1015 }
1016 #endif /* LIMIT_TABLING */
1017 }
1018 #if defined(TABLE_LOCK_AT_ENTRY_LEVEL)
1019 UNLOCK(TabEnt_lock(tab_ent));
1020 #elif defined(TABLE_LOCK_AT_NODE_LEVEL)
1021 UNLOCK(TrNode_lock(current_sg_node));
1022 #elif defined(TABLE_LOCK_AT_WRITE_LEVEL)
1023 UNLOCK_TABLE(current_sg_node);
1024 #endif /* TABLE_LOCK_LEVEL */
1025 return sg_fr;
1026 }
1027
1028
1029 ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
1030 #define subs_arity *subs_ptr
1031 CELL *stack_vars;
1032 int i, vars_arity;
1033 ans_node_ptr current_ans_node;
1034
1035 vars_arity = 0;
1036 current_ans_node = SgFr_answer_trie(sg_fr);
1037
1038 if (IsMode_GlobalTrie(TabEnt_mode(SgFr_tab_ent(sg_fr)))) {
1039 for (i = subs_arity; i >= 1; i--) {
1040 TABLING_ERROR_CHECKING(answer search, IsNonVarTerm(subs_ptr[i]));
1041 current_ans_node = answer_search_terms_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity);
1042 }
1043 } else {
1044 for (i = subs_arity; i >= 1; i--) {
1045 TABLING_ERROR_CHECKING(answer search, IsNonVarTerm(subs_ptr[i]));
1046 current_ans_node = answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity);
1047 }
1048 }
1049
1050 /* reset variables */
1051 stack_vars = (CELL *) TR;
1052 while (vars_arity--) {
1053 Term t = STACK_POP_DOWN(stack_vars);
1054 RESET_VARIABLE(t);
1055 }
1056
1057 return current_ans_node;
1058 #undef subs_arity
1059 }
1060
1061
1062 void load_answer(ans_node_ptr current_ans_node, CELL *subs_ptr) {
1063 #define subs_arity *subs_ptr
1064 CELL *stack_terms;
1065 int i;
1066
1067 TABLING_ERROR_CHECKING(load_answer, H < H_FZ);
1068 if (subs_arity == 0)
1069 return;
1070
1071 stack_terms = load_answer_loop(current_ans_node);
1072
1073 for (i = subs_arity; i >= 1; i--) {
1074 Term t = STACK_POP_DOWN(stack_terms);
1075 Bind((CELL *) subs_ptr[i], t);
1076 }
1077 TABLING_ERROR_CHECKING(load_answer, stack_terms != (CELL *)Yap_TrailTop);
1078
1079 return;
1080 #undef subs_arity
1081 }
1082
1083
1084 CELL *exec_substitution(gt_node_ptr current_node, CELL *aux_stack) {
1085 #define subs_arity *subs_ptr
1086 CELL *stack_terms, *subs_ptr;
1087 Term t;
1088
1089 ++aux_stack; /* skip the heap_arity entry */
1090 stack_terms = exec_substitution_loop(current_node, &aux_stack, (CELL *) Yap_TrailTop);
1091 *--aux_stack = 0; /* restore the heap_arity entry */
1092
1093 subs_ptr = aux_stack + aux_stack[1] + 2;
1094 t = STACK_POP_DOWN(stack_terms);
1095 Bind((CELL *) subs_ptr[subs_arity], t);
1096 TABLING_ERROR_CHECKING(exec_substitution, stack_terms != (CELL *)Yap_TrailTop);
1097 *subs_ptr = subs_arity - 1;
1098
1099 return aux_stack;
1100 #undef subs_arity
1101 }
1102
1103
1104 void update_answer_trie(sg_fr_ptr sg_fr) {
1105 ans_node_ptr current_node;
1106
1107 free_answer_hash_chain(SgFr_hash_chain(sg_fr));
1108 SgFr_hash_chain(sg_fr) = NULL;
1109 SgFr_state(sg_fr) += 2; /* complete --> compiled : complete_in_use --> compiled_in_use */
1110 current_node = TrNode_child(SgFr_answer_trie(sg_fr));
1111 if (current_node) {
1112 #ifdef YAPOR
1113 TrNode_instr(current_node) -= 1;
1114 #ifdef TABLING_INNER_CUTS
1115 update_answer_trie_branch(NULL, current_node);
1116 #else
1117 update_answer_trie_branch(current_node);
1118 #endif /* TABLING_INNER_CUTS */
1119 #else /* TABLING */
1120 update_answer_trie_branch(current_node, TRAVERSE_POSITION_FIRST);
1121 #endif /* YAPOR */
1122 }
1123 return;
1124 }
1125
1126
1127 void free_subgoal_trie(sg_node_ptr current_node, int mode, int position) {
1128 if (! IS_SUBGOAL_LEAF_NODE(current_node)) {
1129 int child_mode;
1130 if (mode == TRAVERSE_MODE_NORMAL) {
1131 Term t = TrNode_entry(current_node);
1132 if (IsApplTerm(t)) {
1133 Functor f = (Functor) RepAppl(t);
1134 if (f == FunctorDouble)
1135 child_mode = TRAVERSE_MODE_DOUBLE;
1136 else if (f == FunctorLongInt)
1137 child_mode = TRAVERSE_MODE_LONGINT;
1138 else
1139 child_mode = TRAVERSE_MODE_NORMAL;
1140 } else
1141 child_mode = TRAVERSE_MODE_NORMAL;
1142 } else if (mode == TRAVERSE_MODE_LONGINT)
1143 child_mode = TRAVERSE_MODE_LONGINT_END;
1144 else if (mode == TRAVERSE_MODE_DOUBLE)
1145 #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
1146 child_mode = TRAVERSE_MODE_DOUBLE2;
1147 else if (mode == TRAVERSE_MODE_DOUBLE2)
1148 #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
1149 child_mode = TRAVERSE_MODE_DOUBLE_END;
1150 else
1151 child_mode = TRAVERSE_MODE_NORMAL;
1152 free_subgoal_trie(TrNode_child(current_node), child_mode, TRAVERSE_POSITION_FIRST);
1153 } else {
1154 sg_fr_ptr sg_fr;
1155 ans_node_ptr ans_node;
1156 sg_fr = UNTAG_SUBGOAL_LEAF_NODE(TrNode_sg_fr(current_node));
1157 free_answer_hash_chain(SgFr_hash_chain(sg_fr));
1158 ans_node = SgFr_answer_trie(sg_fr);
1159 if (TrNode_child(ans_node))
1160 free_answer_trie(TrNode_child(ans_node), TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST);
1161 FREE_ANSWER_TRIE_NODE(ans_node);
1162 #ifdef LIMIT_TABLING
1163 remove_from_global_sg_fr_list(sg_fr);
1164 #endif /* LIMIT_TABLING */
1165 FREE_SUBGOAL_FRAME(sg_fr);
1166 }
1167 if (position == TRAVERSE_POSITION_FIRST) {
1168 sg_node_ptr next_node = TrNode_next(current_node);
1169 CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(TrNode_entry(current_node), mode);
1170 FREE_SUBGOAL_TRIE_NODE(current_node);
1171 while (next_node) {
1172 current_node = next_node;
1173 next_node = TrNode_next(current_node);
1174 free_subgoal_trie(current_node, mode, TRAVERSE_POSITION_NEXT);
1175 }
1176 } else {
1177 CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(TrNode_entry(current_node), mode);
1178 FREE_SUBGOAL_TRIE_NODE(current_node);
1179 }
1180 return;
1181 }
1182
1183
1184 void free_answer_trie(ans_node_ptr current_node, int mode, int position) {
1185 #ifdef TABLING_INNER_CUTS
1186 if (! IS_ANSWER_LEAF_NODE(current_node) && TrNode_child(current_node)) {
1187 #else
1188 if (! IS_ANSWER_LEAF_NODE(current_node)) {
1189 #endif /* TABLING_INNER_CUTS */
1190 int child_mode;
1191 if (mode == TRAVERSE_MODE_NORMAL) {
1192 Term t = TrNode_entry(current_node);
1193 if (IsApplTerm(t)) {
1194 Functor f = (Functor) RepAppl(t);
1195 if (f == FunctorDouble)
1196 child_mode = TRAVERSE_MODE_DOUBLE;
1197 else if (f == FunctorLongInt)
1198 child_mode = TRAVERSE_MODE_LONGINT;
1199 else
1200 child_mode = TRAVERSE_MODE_NORMAL;
1201 } else
1202 child_mode = TRAVERSE_MODE_NORMAL;
1203 } else if (mode == TRAVERSE_MODE_LONGINT)
1204 child_mode = TRAVERSE_MODE_LONGINT_END;
1205 else if (mode == TRAVERSE_MODE_DOUBLE)
1206 #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
1207 child_mode = TRAVERSE_MODE_DOUBLE2;
1208 else if (mode == TRAVERSE_MODE_DOUBLE2)
1209 #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
1210 child_mode = TRAVERSE_MODE_DOUBLE_END;
1211 else
1212 child_mode = TRAVERSE_MODE_NORMAL;
1213 free_answer_trie(TrNode_child(current_node), child_mode, TRAVERSE_POSITION_FIRST);
1214 }
1215 if (position == TRAVERSE_POSITION_FIRST) {
1216 ans_node_ptr next_node = TrNode_next(current_node);
1217 CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(TrNode_entry(current_node), mode);
1218 FREE_ANSWER_TRIE_NODE(current_node);
1219 while (next_node) {
1220 current_node = next_node;
1221 next_node = TrNode_next(current_node);
1222 free_answer_trie(current_node, mode, TRAVERSE_POSITION_NEXT);
1223 }
1224 } else {
1225 CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(TrNode_entry(current_node), mode);
1226 FREE_ANSWER_TRIE_NODE(current_node);
1227 }
1228 return;
1229 }
1230
1231
1232 void free_subgoal_hash_chain(sg_hash_ptr hash) {
1233 while (hash) {
1234 sg_node_ptr chain_node, *bucket, *last_bucket;
1235 sg_hash_ptr next_hash;
1236
1237 bucket = Hash_buckets(hash);
1238 last_bucket = bucket + Hash_num_buckets(hash);
1239 while (! *bucket)
1240 bucket++;
1241 chain_node = *bucket;
1242 TrNode_child(TrNode_parent(chain_node)) = chain_node;
1243 while (++bucket != last_bucket) {
1244 if (*bucket) {
1245 while (TrNode_next(chain_node))
1246 chain_node = TrNode_next(chain_node);
1247 TrNode_next(chain_node) = *bucket;
1248 chain_node = *bucket;
1249 }
1250 }
1251 next_hash = Hash_next(hash);
1252 FREE_HASH_BUCKETS(Hash_buckets(hash));
1253 FREE_SUBGOAL_TRIE_HASH(hash);
1254 hash = next_hash;
1255 }
1256 return;
1257 }
1258
1259
1260 void free_answer_hash_chain(ans_hash_ptr hash) {
1261 while (hash) {
1262 ans_node_ptr chain_node, *bucket, *last_bucket;
1263 ans_hash_ptr next_hash;
1264
1265 bucket = Hash_buckets(hash);
1266 last_bucket = bucket + Hash_num_buckets(hash);
1267 while (! *bucket)
1268 bucket++;
1269 chain_node = *bucket;
1270 TrNode_child(UNTAG_ANSWER_LEAF_NODE(TrNode_parent(chain_node))) = chain_node;
1271 while (++bucket != last_bucket) {
1272 if (*bucket) {
1273 while (TrNode_next(chain_node))
1274 chain_node = TrNode_next(chain_node);
1275 TrNode_next(chain_node) = *bucket;
1276 chain_node = *bucket;
1277 }
1278 }
1279 next_hash = Hash_next(hash);
1280 FREE_HASH_BUCKETS(Hash_buckets(hash));
1281 FREE_ANSWER_TRIE_HASH(hash);
1282 hash = next_hash;
1283 }
1284 return;
1285 }
1286
1287
1288 void show_table(tab_ent_ptr tab_ent, int show_mode) {
1289 sg_node_ptr sg_node;
1290
1291 TrStat_show = show_mode;
1292 if (show_mode == SHOW_MODE_STATISTICS) {
1293 TrStat_subgoals = 0;
1294 TrStat_sg_incomplete = 0;
1295 TrStat_sg_nodes = 1;
1296 TrStat_answers = 0;
1297 TrStat_answers_true = 0;
1298 TrStat_answers_no = 0;
1299 #ifdef TABLING_INNER_CUTS
1300 TrStat_answers_pruned = 0;
1301 #endif /* TABLING_INNER_CUTS */
1302 TrStat_ans_nodes = 0;
1303 TrStat_gt_refs = 0;
1304 fprintf(Yap_stdout, "Table statistics for predicate '%s/%d'\n", AtomName(TabEnt_atom(tab_ent)), TabEnt_arity(tab_ent));
1305 } else { /* SHOW_MODE_STRUCTURE */
1306 fprintf(Yap_stdout, "Table structure for predicate '%s/%d'\n", AtomName(TabEnt_atom(tab_ent)), TabEnt_arity(tab_ent));
1307 }
1308 sg_node = TrNode_child(TabEnt_subgoal_trie(tab_ent));
1309 if (sg_node) {
1310 if (TabEnt_arity(tab_ent)) {
1311 char *str = (char *) malloc(sizeof(char) * SHOW_TABLE_STR_ARRAY_SIZE);
1312 int str_index = sprintf(str, " ?- %s(", AtomName(TabEnt_atom(tab_ent)));
1313 int *arity = (int *) malloc(sizeof(int) * SHOW_TABLE_ARITY_ARRAY_SIZE);
1314 arity[0] = 1;
1315 arity[1] = TabEnt_arity(tab_ent);
1316 traverse_subgoal_trie(sg_node, str, str_index, arity, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST);
1317 free(str);
1318 free(arity);
1319 } else {
1320 sg_fr_ptr sg_fr = UNTAG_SUBGOAL_LEAF_NODE(sg_node);
1321 TrStat_subgoals++;
1322 SHOW_TABLE_STRUCTURE(" ?- %s.\n", AtomName(TabEnt_atom(tab_ent)));
1323 TrStat_ans_nodes++;
1324 if (SgFr_first_answer(sg_fr) == NULL) {
1325 if (SgFr_state(sg_fr) < complete) {
1326 TrStat_sg_incomplete++;
1327 SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n");
1328 } else {
1329 TrStat_answers_no++;
1330 SHOW_TABLE_STRUCTURE(" NO\n");
1331 }
1332 } else { /* SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr) */
1333 TrStat_answers_true++;
1334 SHOW_TABLE_STRUCTURE(" TRUE\n");
1335 }
1336 }
1337 } else
1338 SHOW_TABLE_STRUCTURE(" EMPTY\n");
1339 if (show_mode == SHOW_MODE_STATISTICS) {
1340 fprintf(Yap_stdout, " Subgoal trie structure\n");
1341 fprintf(Yap_stdout, " Subgoals: %ld (%ld incomplete)\n", TrStat_subgoals, TrStat_sg_incomplete);
1342 fprintf(Yap_stdout, " Subgoal trie nodes: %ld\n", TrStat_sg_nodes);
1343 fprintf(Yap_stdout, " Answer trie structure(s)\n");
1344 #ifdef TABLING_INNER_CUTS
1345 fprintf(Yap_stdout, " Answers: %ld (%ld pruned)\n", TrStat_answers, TrStat_answers_pruned);
1346 #else
1347 fprintf(Yap_stdout, " Answers: %ld\n", TrStat_answers);
1348 #endif /* TABLING_INNER_CUTS */
1349 fprintf(Yap_stdout, " Answers 'TRUE': %ld\n", TrStat_answers_true);
1350 fprintf(Yap_stdout, " Answers 'NO': %ld\n", TrStat_answers_no);
1351 fprintf(Yap_stdout, " Answer trie nodes: %ld\n", TrStat_ans_nodes);
1352 fprintf(Yap_stdout, " Global trie references: %ld\n", TrStat_gt_refs);
1353 }
1354 return;
1355 }
1356
1357
1358 void show_global_trie(int show_mode) {
1359 TrStat_show = show_mode;
1360 if (show_mode == SHOW_MODE_STATISTICS) {
1361 TrStat_gt_terms = 0;
1362 TrStat_gt_nodes = 1;
1363 TrStat_gt_refs = 0;
1364 fprintf(Yap_stdout, "Global trie statistics\n");
1365 } else { /* SHOW_MODE_STRUCTURE */
1366 fprintf(Yap_stdout, "Global trie structure\n");
1367 }
1368 if (TrNode_child(GLOBAL_root_gt)) {
1369 char *str = (char *) malloc(sizeof(char) * SHOW_TABLE_STR_ARRAY_SIZE);
1370 int *arity = (int *) malloc(sizeof(int) * SHOW_TABLE_ARITY_ARRAY_SIZE);
1371 arity[0] = 0;
1372 traverse_global_trie(TrNode_child(GLOBAL_root_gt), str, 0, arity, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST);
1373 free(str);
1374 free(arity);
1375 } else
1376 SHOW_TABLE_STRUCTURE(" EMPTY\n");
1377 if (show_mode == SHOW_MODE_STATISTICS) {
1378 fprintf(Yap_stdout, " Terms: %ld\n", TrStat_gt_terms);
1379 fprintf(Yap_stdout, " Global trie nodes: %ld\n", TrStat_gt_nodes);
1380 fprintf(Yap_stdout, " Global trie auto references: %ld\n", TrStat_gt_refs);
1381 }
1382 return;
1383 }
1384 #endif /* TABLING */
1385