diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' of gitosis@yap.dcc.fc.up.pt:yap-6

Browse Source
This commit is contained in:
RIGUZZI FABRIZIO - Dipartimento di Ingegneria 2009-06-27 11:56:10 +02:00
commit d9cdee931c
17 changed files with 1003 additions and 352 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
C/absmi.c
View File

@ -1209,13 +1209,16 @@ Yap_absmi(int inp)
UNLOCK(PREG->u.p.p->StatisticsForPred.lock); UNLOCK(PREG->u.p.p->StatisticsForPred.lock);
RetriesCounter--; RetriesCounter--;
if (RetriesCounter == 0 && RetriesCounterOn) { if (RetriesCounter == 0 && RetriesCounterOn) {
/* act as if we had backtracked */
ENV = B->cp_env;
saveregs(); saveregs();
Yap_Error(RETRY_COUNTER_UNDERFLOW,TermNil,""); Yap_Error(RETRY_COUNTER_UNDERFLOW,TermNil,"");
JMPNext();
setregs(); setregs();
JMPNext();
} }
PredEntriesCounter--; PredEntriesCounter--;
if (PredEntriesCounter == 0 && PredEntriesCounterOn) { if (PredEntriesCounter == 0 && PredEntriesCounterOn) {
ENV = B->cp_env;
saveregs(); saveregs();
Yap_Error(PRED_ENTRY_COUNTER_UNDERFLOW,TermNil,""); Yap_Error(PRED_ENTRY_COUNTER_UNDERFLOW,TermNil,"");
setregs(); setregs();
@ -1228,8 +1231,18 @@ Yap_absmi(int inp)
/* count_retry_me Label,NArgs */ /* count_retry_me Label,NArgs */
Op(count_retry_me, Otapl); Op(count_retry_me, Otapl);
CACHE_Y(B); CACHE_Y(B);
restore_yaam_regs(PREG->u.Otapl.d);
restore_args(PREG->u.Otapl.s);
/* After retry, cut should be pointing at the parent /* After retry, cut should be pointing at the parent
* choicepoint for the current B */ * choicepoint for the current B */
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
#endif /* FROZEN_STACKS */
SET_BB(B_YREG);
ENDCACHE_Y();
LOCK(((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.lock); LOCK(((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.lock);
((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.NOfRetries++; ((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.NOfRetries++;
UNLOCK(((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.lock); UNLOCK(((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.lock);
@ -1247,16 +1260,6 @@ Yap_absmi(int inp)
setregs(); setregs();
JMPNext(); JMPNext();
} }
restore_yaam_regs(PREG->u.Otapl.d);
restore_args(PREG->u.Otapl.s);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
#endif /* FROZEN_STACKS */
SET_BB(B_YREG);
ENDCACHE_Y();
PREG = NEXTOP(PREG, Otapl); PREG = NEXTOP(PREG, Otapl);
GONext(); GONext();
ENDOp(); ENDOp();
@ -7336,7 +7339,7 @@ Yap_absmi(int inp)
\************************************************************************/ \************************************************************************/
BOp(call_cpred, Osbpp); BOp(call_cpred, Osbpp);
check_trail(TR);
if (!(PREG->u.Osbpp.p->PredFlags & (SafePredFlag|HiddenPredFlag))) { if (!(PREG->u.Osbpp.p->PredFlags & (SafePredFlag|HiddenPredFlag))) {
CACHE_Y_AS_ENV(YREG); CACHE_Y_AS_ENV(YREG);
check_stack(NoStackCall, H); check_stack(NoStackCall, H);
@ -7384,6 +7387,7 @@ Yap_absmi(int inp)
/* execute Label */ /* execute Label */
BOp(execute_cpred, pp); BOp(execute_cpred, pp);
check_trail(TR);
{ {
PredEntry *pt0; PredEntry *pt0;
@ -8038,9 +8042,9 @@ Yap_absmi(int inp)
setregs(); setregs();
JMPNext(); JMPNext();
} }
PREG = pe->cs.p_code.TrueCodeOfPred;
if ((pe->PredFlags & (CountPredFlag|ProfiledPredFlag|SpiedPredFlag)) == if ((pe->PredFlags & (CountPredFlag|ProfiledPredFlag|SpiedPredFlag)) ==
CountPredFlag) { CountPredFlag) {
PREG = pe->cs.p_code.TrueCodeOfPred;
JMPNext(); JMPNext();
} }
} }

6
C/cdmgr.c
View File

@ -1006,7 +1006,7 @@ RemoveMainIndex(PredEntry *ap)
} }
if (First != NULL && spied) { if (First != NULL && spied) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred); ap->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->cs.p_code.TrueCodeOfPred = ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
} else if (ap->cs.p_code.NOfClauses > 1 } else if (ap->cs.p_code.NOfClauses > 1
#ifdef TABLING #ifdef TABLING
||ap->PredFlags & TabledPredFlag ||ap->PredFlags & TabledPredFlag
@ -1775,10 +1775,10 @@ asserta_stat_clause(PredEntry *p, yamop *q, int spy_flag)
p->cs.p_code.FirstClause = q; p->cs.p_code.FirstClause = q;
if (p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) { if (p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
p->OpcodeOfPred = Yap_opcode(_spy_pred); p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} else if (!(p->PredFlags & IndexedPredFlag)) { } else if (!(p->PredFlags & IndexedPredFlag)) {
p->OpcodeOfPred = INDEX_OPCODE; p->OpcodeOfPred = INDEX_OPCODE;
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} }
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (p->ModuleOfPred != IDB_MODULE) { if (p->ModuleOfPred != IDB_MODULE) {

4
C/compiler.c
View File

@ -1811,9 +1811,9 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs)
} }
else if (op >= _plus && op <= _functor) { else if (op >= _plus && op <= _functor) {
if (profiling) if (profiling)
Yap_emit(enter_profiling_op, (CELL)RepPredProp(p), Zero, &cglobs->cint); Yap_emit(enter_profiling_op, (CELL)p, Zero, &cglobs->cint);
else if (call_counting) else if (call_counting)
Yap_emit(count_call_op, (CELL)RepPredProp(p), Zero, &cglobs->cint); Yap_emit(count_call_op, (CELL)p, Zero, &cglobs->cint);
if (op == _functor) { if (op == _functor) {
c_functor(Goal, mod, cglobs); c_functor(Goal, mod, cglobs);
} }

11
C/errors.c
View File

@ -518,20 +518,27 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
break; break;
case CALL_COUNTER_UNDERFLOW: case CALL_COUNTER_UNDERFLOW:
/* Do a long jump */ /* Do a long jump */
PredEntriesCounter--; ReductionsCounterOn = FALSE;
PredEntriesCounterOn = FALSE;
RetriesCounterOn = FALSE;
Yap_JumpToEnv(MkAtomTerm(AtomCallCounter)); Yap_JumpToEnv(MkAtomTerm(AtomCallCounter));
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
Yap_PrologMode &= ~InErrorMode; Yap_PrologMode &= ~InErrorMode;
return(P); return(P);
case PRED_ENTRY_COUNTER_UNDERFLOW: case PRED_ENTRY_COUNTER_UNDERFLOW:
/* Do a long jump */ /* Do a long jump */
ReductionsCounterOn = FALSE;
PredEntriesCounterOn = FALSE;
RetriesCounterOn = FALSE;
Yap_JumpToEnv(MkAtomTerm(AtomCallAndRetryCounter)); Yap_JumpToEnv(MkAtomTerm(AtomCallAndRetryCounter));
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
Yap_PrologMode &= ~InErrorMode; Yap_PrologMode &= ~InErrorMode;
return(P); return(P);
case RETRY_COUNTER_UNDERFLOW: case RETRY_COUNTER_UNDERFLOW:
/* Do a long jump */ /* Do a long jump */
PredEntriesCounter--; ReductionsCounterOn = FALSE;
PredEntriesCounterOn = FALSE;
RetriesCounterOn = FALSE;
Yap_JumpToEnv(MkAtomTerm(AtomRetryCounter)); Yap_JumpToEnv(MkAtomTerm(AtomRetryCounter));
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
Yap_PrologMode &= ~InErrorMode; Yap_PrologMode &= ~InErrorMode;

24
H/YapOpcodes.h
View File

@ -345,26 +345,50 @@
OPCODE(trie_trust_null ,e), OPCODE(trie_trust_null ,e),
OPCODE(trie_try_null ,e), OPCODE(trie_try_null ,e),
OPCODE(trie_retry_null ,e), OPCODE(trie_retry_null ,e),
OPCODE(trie_do_null_in_new_list ,e),
OPCODE(trie_trust_null_in_new_list,e),
OPCODE(trie_try_null_in_new_list ,e),
OPCODE(trie_retry_null_in_new_list,e),
OPCODE(trie_do_var ,e), OPCODE(trie_do_var ,e),
OPCODE(trie_trust_var ,e), OPCODE(trie_trust_var ,e),
OPCODE(trie_try_var ,e), OPCODE(trie_try_var ,e),
OPCODE(trie_retry_var ,e), OPCODE(trie_retry_var ,e),
OPCODE(trie_do_var_in_new_list ,e),
OPCODE(trie_trust_var_in_new_list ,e),
OPCODE(trie_try_var_in_new_list ,e),
OPCODE(trie_retry_var_in_new_list ,e),
OPCODE(trie_do_val ,e), OPCODE(trie_do_val ,e),
OPCODE(trie_trust_val ,e), OPCODE(trie_trust_val ,e),
OPCODE(trie_try_val ,e), OPCODE(trie_try_val ,e),
OPCODE(trie_retry_val ,e), OPCODE(trie_retry_val ,e),
OPCODE(trie_do_val_in_new_list ,e),
OPCODE(trie_trust_val_in_new_list ,e),
OPCODE(trie_try_val_in_new_list ,e),
OPCODE(trie_retry_val_in_new_list ,e),
OPCODE(trie_do_atom ,e), OPCODE(trie_do_atom ,e),
OPCODE(trie_trust_atom ,e), OPCODE(trie_trust_atom ,e),
OPCODE(trie_try_atom ,e), OPCODE(trie_try_atom ,e),
OPCODE(trie_retry_atom ,e), OPCODE(trie_retry_atom ,e),
OPCODE(trie_do_atom_in_new_list ,e),
OPCODE(trie_trust_atom_in_new_list,e),
OPCODE(trie_try_atom_in_new_list ,e),
OPCODE(trie_retry_atom_in_new_list,e),
OPCODE(trie_do_list ,e), OPCODE(trie_do_list ,e),
OPCODE(trie_trust_list ,e), OPCODE(trie_trust_list ,e),
OPCODE(trie_try_list ,e), OPCODE(trie_try_list ,e),
OPCODE(trie_retry_list ,e), OPCODE(trie_retry_list ,e),
OPCODE(trie_do_list_in_new_list ,e),
OPCODE(trie_trust_list_in_new_list,e),
OPCODE(trie_try_list_in_new_list ,e),
OPCODE(trie_retry_list_in_new_list,e),
OPCODE(trie_do_struct ,e), OPCODE(trie_do_struct ,e),
OPCODE(trie_trust_struct ,e), OPCODE(trie_trust_struct ,e),
OPCODE(trie_try_struct ,e), OPCODE(trie_try_struct ,e),
OPCODE(trie_retry_struct ,e), OPCODE(trie_retry_struct ,e),
OPCODE(trie_do_struct_in_new_list ,e),
OPCODE(trie_trust_struct_in_new_list,e),
OPCODE(trie_try_struct_in_new_list,e),
OPCODE(trie_retry_struct_in_new_list,e),
OPCODE(trie_do_extension ,e), OPCODE(trie_do_extension ,e),
OPCODE(trie_trust_extension ,e), OPCODE(trie_trust_extension ,e),
OPCODE(trie_try_extension ,e), OPCODE(trie_try_extension ,e),

24
H/rclause.h
View File

@ -793,41 +793,65 @@ restore_opcodes(yamop *pc)
break; break;
/* instructions type e */ /* instructions type e */
case _trie_do_atom: case _trie_do_atom:
case _trie_do_atom_in_new_list:
case _trie_do_extension: case _trie_do_extension:
case _trie_do_float: case _trie_do_float:
case _trie_do_list: case _trie_do_list:
case _trie_do_list_in_new_list:
case _trie_do_long: case _trie_do_long:
case _trie_do_null: case _trie_do_null:
case _trie_do_null_in_new_list:
case _trie_do_struct: case _trie_do_struct:
case _trie_do_struct_in_new_list:
case _trie_do_val: case _trie_do_val:
case _trie_do_val_in_new_list:
case _trie_do_var: case _trie_do_var:
case _trie_do_var_in_new_list:
case _trie_retry_atom: case _trie_retry_atom:
case _trie_retry_atom_in_new_list:
case _trie_retry_extension: case _trie_retry_extension:
case _trie_retry_float: case _trie_retry_float:
case _trie_retry_list: case _trie_retry_list:
case _trie_retry_list_in_new_list:
case _trie_retry_long: case _trie_retry_long:
case _trie_retry_null: case _trie_retry_null:
case _trie_retry_null_in_new_list:
case _trie_retry_struct: case _trie_retry_struct:
case _trie_retry_struct_in_new_list:
case _trie_retry_val: case _trie_retry_val:
case _trie_retry_val_in_new_list:
case _trie_retry_var: case _trie_retry_var:
case _trie_retry_var_in_new_list:
case _trie_trust_atom: case _trie_trust_atom:
case _trie_trust_atom_in_new_list:
case _trie_trust_extension: case _trie_trust_extension:
case _trie_trust_float: case _trie_trust_float:
case _trie_trust_list: case _trie_trust_list:
case _trie_trust_list_in_new_list:
case _trie_trust_long: case _trie_trust_long:
case _trie_trust_null: case _trie_trust_null:
case _trie_trust_null_in_new_list:
case _trie_trust_struct: case _trie_trust_struct:
case _trie_trust_struct_in_new_list:
case _trie_trust_val: case _trie_trust_val:
case _trie_trust_val_in_new_list:
case _trie_trust_var: case _trie_trust_var:
case _trie_trust_var_in_new_list:
case _trie_try_atom: case _trie_try_atom:
case _trie_try_atom_in_new_list:
case _trie_try_extension: case _trie_try_extension:
case _trie_try_float: case _trie_try_float:
case _trie_try_list: case _trie_try_list:
case _trie_try_list_in_new_list:
case _trie_try_long: case _trie_try_long:
case _trie_try_null: case _trie_try_null:
case _trie_try_null_in_new_list:
case _trie_try_struct: case _trie_try_struct:
case _trie_try_struct_in_new_list:
case _trie_try_val: case _trie_try_val:
case _trie_try_val_in_new_list:
case _trie_try_var: case _trie_try_var:
case _trie_try_var_in_new_list:
if (op == _Nstop || op == _copy_idb_term || op == _unify_idb_term) return; if (op == _Nstop || op == _copy_idb_term || op == _unify_idb_term) return;
pc = NEXTOP(pc,e); pc = NEXTOP(pc,e);
break; break;

24
H/walkclause.h
View File

@ -612,41 +612,65 @@
break; break;
/* instructions type e */ /* instructions type e */
case _trie_do_atom: case _trie_do_atom:
case _trie_do_atom_in_new_list:
case _trie_do_extension: case _trie_do_extension:
case _trie_do_float: case _trie_do_float:
case _trie_do_list: case _trie_do_list:
case _trie_do_list_in_new_list:
case _trie_do_long: case _trie_do_long:
case _trie_do_null: case _trie_do_null:
case _trie_do_null_in_new_list:
case _trie_do_struct: case _trie_do_struct:
case _trie_do_struct_in_new_list:
case _trie_do_val: case _trie_do_val:
case _trie_do_val_in_new_list:
case _trie_do_var: case _trie_do_var:
case _trie_do_var_in_new_list:
case _trie_retry_atom: case _trie_retry_atom:
case _trie_retry_atom_in_new_list:
case _trie_retry_extension: case _trie_retry_extension:
case _trie_retry_float: case _trie_retry_float:
case _trie_retry_list: case _trie_retry_list:
case _trie_retry_list_in_new_list:
case _trie_retry_long: case _trie_retry_long:
case _trie_retry_null: case _trie_retry_null:
case _trie_retry_null_in_new_list:
case _trie_retry_struct: case _trie_retry_struct:
case _trie_retry_struct_in_new_list:
case _trie_retry_val: case _trie_retry_val:
case _trie_retry_val_in_new_list:
case _trie_retry_var: case _trie_retry_var:
case _trie_retry_var_in_new_list:
case _trie_trust_atom: case _trie_trust_atom:
case _trie_trust_atom_in_new_list:
case _trie_trust_extension: case _trie_trust_extension:
case _trie_trust_float: case _trie_trust_float:
case _trie_trust_list: case _trie_trust_list:
case _trie_trust_list_in_new_list:
case _trie_trust_long: case _trie_trust_long:
case _trie_trust_null: case _trie_trust_null:
case _trie_trust_null_in_new_list:
case _trie_trust_struct: case _trie_trust_struct:
case _trie_trust_struct_in_new_list:
case _trie_trust_val: case _trie_trust_val:
case _trie_trust_val_in_new_list:
case _trie_trust_var: case _trie_trust_var:
case _trie_trust_var_in_new_list:
case _trie_try_atom: case _trie_try_atom:
case _trie_try_atom_in_new_list:
case _trie_try_extension: case _trie_try_extension:
case _trie_try_float: case _trie_try_float:
case _trie_try_list: case _trie_try_list:
case _trie_try_list_in_new_list:
case _trie_try_long: case _trie_try_long:
case _trie_try_null: case _trie_try_null:
case _trie_try_null_in_new_list:
case _trie_try_struct: case _trie_try_struct:
case _trie_try_struct_in_new_list:
case _trie_try_val: case _trie_try_val:
case _trie_try_val_in_new_list:
case _trie_try_var: case _trie_try_var:
case _trie_try_var_in_new_list:
pc = NEXTOP(pc,e); pc = NEXTOP(pc,e);
break; break;
#endif #endif

8
OPTYap/opt.config.h
View File

@ -17,7 +17,7 @@
** default sizes ** ** default sizes **
** ----------------------- */ ** ----------------------- */
#define MAX_LENGTH_ANSWER 500 #define MAX_LENGTH_ANSWER 500
#define MAX_DEPTH 1000 #define MAX_BRANCH_DEPTH 1000
#define MAX_BEST_TIMES 21 #define MAX_BEST_TIMES 21
#define MAX_TABLE_VARS 100 #define MAX_TABLE_VARS 100
#define TABLE_LOCK_BUCKETS 512 #define TABLE_LOCK_BUCKETS 512
@ -73,6 +73,11 @@
** ----------------------------------------------- */ ** ----------------------------------------------- */
/* #define INCOMPLETE_TABLING 1 */ /* #define INCOMPLETE_TABLING 1 */
/* ----------------------------------------------- **
** support trie compact lists? (optional) **
** ----------------------------------------------- */
/* #define TRIE_COMPACT_LISTS 1 */
/* --------------------------------------- ** /* --------------------------------------- **
** support inner cuts? (optional) ** ** support inner cuts? (optional) **
** --------------------------------------- */ ** --------------------------------------- */
@ -169,6 +174,7 @@
#undef BBREG_TRAIL_SCHEME #undef BBREG_TRAIL_SCHEME
#undef LIMIT_TABLING #undef LIMIT_TABLING
#undef INCOMPLETE_TABLING #undef INCOMPLETE_TABLING
#undef TRIE_COMPACT_LISTS
#undef TABLING_ERRORS #undef TABLING_ERRORS
#endif /* !TABLING */ #endif /* !TABLING */

13
OPTYap/opt.preds.c
View File

@ -684,7 +684,7 @@ Int p_abolish_table(void) {
sg_node = TrNode_child(TabEnt_subgoal_trie(tab_ent)); sg_node = TrNode_child(TabEnt_subgoal_trie(tab_ent));
if (sg_node) { if (sg_node) {
TrNode_child(TabEnt_subgoal_trie(tab_ent)) = NULL; TrNode_child(TabEnt_subgoal_trie(tab_ent)) = NULL;
free_subgoal_trie_branch(sg_node, TabEnt_arity(tab_ent)); free_subgoal_trie_branch(sg_node, TabEnt_arity(tab_ent), 0);
} }
return (TRUE); return (TRUE);
} }
@ -704,7 +704,7 @@ Int p_abolish_all_tables(void) {
sg_node = TrNode_child(TabEnt_subgoal_trie(tab_ent)); sg_node = TrNode_child(TabEnt_subgoal_trie(tab_ent));
if (sg_node) { if (sg_node) {
TrNode_child(TabEnt_subgoal_trie(tab_ent)) = NULL; TrNode_child(TabEnt_subgoal_trie(tab_ent)) = NULL;
free_subgoal_trie_branch(sg_node, TabEnt_arity(tab_ent)); free_subgoal_trie_branch(sg_node, TabEnt_arity(tab_ent), 0);
} }
tab_ent = TabEnt_next(tab_ent); tab_ent = TabEnt_next(tab_ent);
} }
@ -811,8 +811,7 @@ Int p_tabling_statistics(void) {
bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_ans_node) * sizeof(struct answer_trie_node); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_ans_node) * sizeof(struct answer_trie_node);
fprintf(Yap_stdout, " subgoal hashes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_sg_hash)); fprintf(Yap_stdout, " subgoal hashes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_sg_hash));
bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_sg_hash) * sizeof(struct subgoal_hash); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_sg_hash) * sizeof(struct subgoal_hash);
fprintf(Yap_stdout, "%s answer hashes: %10ld structs in use\n", fprintf(Yap_stdout, " answer hashes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_ans_hash));
Pg_str_in_use(GLOBAL_PAGES_ans_hash) == 0 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_ans_hash));
bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_ans_hash) * sizeof(struct answer_hash); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_ans_hash) * sizeof(struct answer_hash);
fprintf(Yap_stdout, "%s dependency frames: %10ld structs in use\n", fprintf(Yap_stdout, "%s dependency frames: %10ld structs in use\n",
Pg_str_in_use(GLOBAL_PAGES_dep_fr) == 1 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_dep_fr)); Pg_str_in_use(GLOBAL_PAGES_dep_fr) == 1 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_dep_fr));
@ -880,8 +879,7 @@ int p_opt_statistics(void) {
bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_ans_node) * sizeof(struct answer_trie_node); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_ans_node) * sizeof(struct answer_trie_node);
fprintf(Yap_stdout, " subgoal hashes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_sg_hash)); fprintf(Yap_stdout, " subgoal hashes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_sg_hash));
bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_sg_hash) * sizeof(struct subgoal_hash); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_sg_hash) * sizeof(struct subgoal_hash);
fprintf(Yap_stdout, "%s answer hashes: %10ld structs in use\n", fprintf(Yap_stdout, " answer hashes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_ans_hash));
Pg_str_in_use(GLOBAL_PAGES_ans_hash) == 0 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_ans_hash));
bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_ans_hash) * sizeof(struct answer_hash); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_ans_hash) * sizeof(struct answer_hash);
fprintf(Yap_stdout, "%s dependency frames: %10ld structs in use\n", fprintf(Yap_stdout, "%s dependency frames: %10ld structs in use\n",
Pg_str_in_use(GLOBAL_PAGES_dep_fr) == 1 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_dep_fr)); Pg_str_in_use(GLOBAL_PAGES_dep_fr) == 1 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_dep_fr));
@ -1225,8 +1223,7 @@ void shm_answer_hashes(long *pages_in_use, long *bytes_in_use) {
pg_hd = PgHd_next(pg_hd); pg_hd = PgHd_next(pg_hd);
} }
fprintf(Yap_stdout, "%s answer hashes: %8ld pages %10ld structs in use\n", fprintf(Yap_stdout, "%s answer hashes: %8ld pages %10ld structs in use\n",
Pg_str_free(GLOBAL_PAGES_ans_hash) == cont && Pg_str_free(GLOBAL_PAGES_ans_hash) == cont ? " ": "*",
Pg_str_in_use(GLOBAL_PAGES_ans_hash) == 0 ? " ": "*",
Pg_pg_alloc(GLOBAL_PAGES_ans_hash), Pg_str_in_use(GLOBAL_PAGES_ans_hash)); Pg_pg_alloc(GLOBAL_PAGES_ans_hash), Pg_str_in_use(GLOBAL_PAGES_ans_hash));
*pages_in_use += Pg_pg_alloc(GLOBAL_PAGES_ans_hash); *pages_in_use += Pg_pg_alloc(GLOBAL_PAGES_ans_hash);
*bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_ans_hash) * sizeof(struct answer_hash); *bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_ans_hash) * sizeof(struct answer_hash);

2
OPTYap/opt.proto.h
View File

@ -67,7 +67,7 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr);
ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr); ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr);
void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr); void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr);
void private_completion(sg_fr_ptr sg_fr); void private_completion(sg_fr_ptr sg_fr);
void free_subgoal_trie_branch(sg_node_ptr node, int missing_nodes); void free_subgoal_trie_branch(sg_node_ptr node, int nodes_left, int nodes_extra);
void free_answer_trie_branch(ans_node_ptr node); void free_answer_trie_branch(ans_node_ptr node);
void update_answer_trie(sg_fr_ptr sg_fr); void update_answer_trie(sg_fr_ptr sg_fr);
void traverse_table(tab_ent_ptr tab_ent, int show_table); void traverse_table(tab_ent_ptr tab_ent, int show_table);

2
OPTYap/opt.structs.h
View File

@ -158,7 +158,7 @@ struct global_data{
volatile bitmap pruning_workers; volatile bitmap pruning_workers;
#endif /* TABLING_INNER_CUTS */ #endif /* TABLING_INNER_CUTS */
struct global_locks locks; struct global_locks locks;
volatile unsigned int branch[MAX_WORKERS][MAX_DEPTH]; volatile unsigned int branch[MAX_WORKERS][MAX_BRANCH_DEPTH];
volatile char parallel_execution_mode; /* TRUE / FALSE */ volatile char parallel_execution_mode; /* TRUE / FALSE */
volatile int answers; volatile int answers;
#endif /* YAPOR */ #endif /* YAPOR */

2
OPTYap/or.cowengine.c
View File

@ -204,7 +204,7 @@ void share_private_nodes(int worker_q) {
OrFr_nearest_livenode(previous_or_frame) = OrFr_next(previous_or_frame) = or_frame; OrFr_nearest_livenode(previous_or_frame) = OrFr_next(previous_or_frame) = or_frame;
} }
/* update depth */ /* update depth */
if (depth >= MAX_DEPTH) if (depth >= MAX_BRANCH_DEPTH)
Yap_Error(INTERNAL_ERROR, TermNil, "maximum depth exceded (share_private_nodes)"); Yap_Error(INTERNAL_ERROR, TermNil, "maximum depth exceded (share_private_nodes)");
or_frame = B->cp_or_fr; or_frame = B->cp_or_fr;
while (or_frame != LOCAL_top_or_fr) { while (or_frame != LOCAL_top_or_fr) {

2
OPTYap/or.engine.c
View File

@ -587,7 +587,7 @@ void share_private_nodes(int worker_q) {
#endif /* TABLING */ #endif /* TABLING */
/* update depth */ /* update depth */
if (depth >= MAX_DEPTH) if (depth >= MAX_BRANCH_DEPTH)
Yap_Error(INTERNAL_ERROR, TermNil, "maximum depth exceded (share_private_nodes)"); Yap_Error(INTERNAL_ERROR, TermNil, "maximum depth exceded (share_private_nodes)");
or_frame = B->cp_or_fr; or_frame = B->cp_or_fr;
#ifdef TABLING #ifdef TABLING

2
OPTYap/or.sbaengine.c
View File

@ -269,7 +269,7 @@ void share_private_nodes(int worker_q) {
OrFr_nearest_livenode(previous_or_frame) = OrFr_next(previous_or_frame) = or_frame; OrFr_nearest_livenode(previous_or_frame) = OrFr_next(previous_or_frame) = or_frame;
} }
/* update depth */ /* update depth */
if (depth >= MAX_DEPTH) if (depth >= MAX_BRANCH_DEPTH)
Yap_Error(INTERNAL_ERROR, TermNil, "maximum depth exceded (share_private_nodes)"); Yap_Error(INTERNAL_ERROR, TermNil, "maximum depth exceded (share_private_nodes)");
or_frame = B->cp_or_fr; or_frame = B->cp_or_fr;

5
OPTYap/tab.macros.h
View File

@ -111,6 +111,11 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p
#define IsTableVarTerm(TERM) \ #define IsTableVarTerm(TERM) \
((CELL) TERM) >= GLOBAL_table_var_enumerator(0) && \ ((CELL) TERM) >= GLOBAL_table_var_enumerator(0) && \
((CELL) TERM) <= GLOBAL_table_var_enumerator(MAX_TABLE_VARS - 1) ((CELL) TERM) <= GLOBAL_table_var_enumerator(MAX_TABLE_VARS - 1)
#ifdef TRIE_COMPACT_LISTS
#define PairTermMark NULL
#define PairTermInit ((Term *) 0)
#define PairTermLast ((Term *) (LowTagBits + 1))
#endif /* TRIE_COMPACT_LISTS */
#define HASH_TABLE_LOCK(NODE) ((((unsigned long int)NODE) >> 5) & (TABLE_LOCK_BUCKETS - 1)) #define HASH_TABLE_LOCK(NODE) ((((unsigned long int)NODE) >> 5) & (TABLE_LOCK_BUCKETS - 1))
#define LOCK_TABLE(NODE) LOCK(GLOBAL_table_lock(HASH_TABLE_LOCK(NODE))) #define LOCK_TABLE(NODE) LOCK(GLOBAL_table_lock(HASH_TABLE_LOCK(NODE)))

345
OPTYap/tab.tries.c
View File

@ -714,10 +714,35 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) {
} else if (IsAtomOrIntTerm(t)) { } else if (IsAtomOrIntTerm(t)) {
current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, t); current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, t);
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
#ifdef TRIE_COMPACT_LISTS
CELL *aux = RepPair(t);
if (aux == PairTermMark) {
t = Deref(STACK_POP_DOWN(stack_terms));
if (IsPairTerm(t)) {
aux = RepPair(t);
/* STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 2, stack_terms_base); */
/* STACK_CHECK_EXPAND is not necessary here because the situation of pushing **
** up 3 terms has already initially checked for the PairTermInit term */
STACK_PUSH_UP(*(aux + 1), stack_terms);
STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms);
STACK_PUSH_UP(*(aux), stack_terms);
} else {
current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, AbsPair(PairTermLast));
STACK_PUSH_UP(t, stack_terms);
}
} else {
current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, AbsPair(PairTermInit));
STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 2, stack_terms_base);
STACK_PUSH_UP(*(aux + 1), stack_terms);
STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms);
STACK_PUSH_UP(*(aux), stack_terms);
}
#else
current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, AbsPair(NULL)); current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, AbsPair(NULL));
STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1, stack_terms_base); STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1, stack_terms_base);
STACK_PUSH_UP(*(RepPair(t) + 1), stack_terms); STACK_PUSH_UP(*(RepPair(t) + 1), stack_terms);
STACK_PUSH_UP(*(RepPair(t)), stack_terms); STACK_PUSH_UP(*(RepPair(t)), stack_terms);
#endif /* TRIE_COMPACT_LISTS */
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, AbsAppl((Term *)f)); current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, AbsAppl((Term *)f));
@ -731,6 +756,10 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) {
} else if (f == FunctorLongInt) { } else if (f == FunctorLongInt) {
Int li = LongIntOfTerm(t); Int li = LongIntOfTerm(t);
current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, li); current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, li);
} else if (f == FunctorDBRef) {
Yap_Error(INTERNAL_ERROR, TermNil, "unsupported type tag (FunctorDBRef in subgoal_search)");
} else if (f == FunctorBigInt) {
Yap_Error(INTERNAL_ERROR, TermNil, "unsupported type tag (FunctorBigInt in subgoal_search)");
} else { } else {
STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + ArityOfFunctor(f) - 1, stack_terms_base); STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + ArityOfFunctor(f) - 1, stack_terms_base);
for (j = ArityOfFunctor(f); j >= 1; j--) for (j = ArityOfFunctor(f); j >= 1; j--)
@ -782,6 +811,11 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
int i, j, count_vars, subs_arity; int i, j, count_vars, subs_arity;
CELL *stack_vars, *stack_terms_base, *stack_terms; CELL *stack_vars, *stack_terms_base, *stack_terms;
ans_node_ptr current_ans_node; ans_node_ptr current_ans_node;
#ifdef TRIE_COMPACT_LISTS
int in_new_list = 0;
#else
#define in_new_list 0
#endif /* TRIE_COMPACT_LISTS */
count_vars = 0; count_vars = 0;
subs_arity = *subs_ptr; subs_arity = *subs_ptr;
@ -801,7 +835,7 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
if (IsTableVarTerm(t)) { if (IsTableVarTerm(t)) {
t = MakeTableVarTerm(VarIndexOfTerm(t)); t = MakeTableVarTerm(VarIndexOfTerm(t));
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, t, _trie_retry_val); current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, t, _trie_retry_val + in_new_list);
} else { } else {
if (count_vars == MAX_TABLE_VARS) if (count_vars == MAX_TABLE_VARS)
Yap_Error(INTERNAL_ERROR, TermNil, "MAX_TABLE_VARS exceeded (answer_search)"); Yap_Error(INTERNAL_ERROR, TermNil, "MAX_TABLE_VARS exceeded (answer_search)");
@ -809,21 +843,54 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
*((CELL *)t) = GLOBAL_table_var_enumerator(count_vars); *((CELL *)t) = GLOBAL_table_var_enumerator(count_vars);
t = MakeTableVarTerm(count_vars); t = MakeTableVarTerm(count_vars);
count_vars++; count_vars++;
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, t, _trie_retry_var); current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, t, _trie_retry_var + in_new_list);
} }
#ifdef TRIE_COMPACT_LISTS
in_new_list = 0;
#endif /* TRIE_COMPACT_LISTS */
} else if (IsAtomOrIntTerm(t)) { } else if (IsAtomOrIntTerm(t)) {
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, t, _trie_retry_atom); current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, t, _trie_retry_atom + in_new_list);
#ifdef TRIE_COMPACT_LISTS
in_new_list = 0;
#endif /* TRIE_COMPACT_LISTS */
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
#ifdef TRIE_COMPACT_LISTS
CELL *aux = RepPair(t);
if (aux == PairTermMark) {
t = Deref(STACK_POP_DOWN(stack_terms));
if (IsPairTerm(t)) {
aux = RepPair(t);
/* STACK_CHECK_EXPAND(stack_terms, stack_vars + 2, stack_terms_base); */
/* STACK_CHECK_EXPAND is not necessary here because the situation of pushing **
** up 3 terms has already initially checked for the PairTermInit term */
STACK_PUSH_UP(*(aux + 1), stack_terms);
STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms);
STACK_PUSH_UP(*(aux), stack_terms);
in_new_list = 4;
} else {
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsPair(PairTermLast), _trie_retry_null);
STACK_PUSH_UP(t, stack_terms);
}
} else {
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsPair(PairTermInit), _trie_retry_list + in_new_list);
STACK_CHECK_EXPAND(stack_terms, stack_vars + 2, stack_terms_base);
STACK_PUSH_UP(*(aux + 1), stack_terms);
STACK_PUSH_UP(AbsPair(PairTermMark), stack_terms);
STACK_PUSH_UP(*(aux), stack_terms);
in_new_list = 0;
}
#else
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsPair(NULL), _trie_retry_list); current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsPair(NULL), _trie_retry_list);
STACK_CHECK_EXPAND(stack_terms, stack_vars + 1, stack_terms_base); STACK_CHECK_EXPAND(stack_terms, stack_vars + 1, stack_terms_base);
STACK_PUSH_UP(*(RepPair(t) + 1), stack_terms); STACK_PUSH_UP(*(RepPair(t) + 1), stack_terms);
STACK_PUSH_UP(*(RepPair(t)), stack_terms); STACK_PUSH_UP(*(RepPair(t)), stack_terms);
#endif /* TRIE_COMPACT_LISTS */
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t); Functor f = FunctorOfTerm(t);
if (f == FunctorDouble) { if (f == FunctorDouble) {
volatile Float dbl = FloatOfTerm(t); volatile Float dbl = FloatOfTerm(t);
volatile Term *t_dbl = (Term *)((void *) &dbl); volatile Term *t_dbl = (Term *)((void *) &dbl);
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_null); current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_null + in_new_list);
#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, *(t_dbl + 1), _trie_retry_extension); current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, *(t_dbl + 1), _trie_retry_extension);
#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
@ -831,15 +898,22 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_float); current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_float);
} else if (f == FunctorLongInt) { } else if (f == FunctorLongInt) {
Int li = LongIntOfTerm (t); Int li = LongIntOfTerm (t);
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_null); current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_null + in_new_list);
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, li, _trie_retry_extension); current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, li, _trie_retry_extension);
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_long); current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_long);
} else if (f == FunctorDBRef) {
Yap_Error(INTERNAL_ERROR, TermNil, "unsupported type tag (FunctorDBRef in answer_search)");
} else if (f == FunctorBigInt) {
Yap_Error(INTERNAL_ERROR, TermNil, "unsupported type tag (FunctorBigInt in answer_search)");
} else { } else {
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_struct); current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_struct + in_new_list);
STACK_CHECK_EXPAND(stack_terms, stack_vars + ArityOfFunctor(f) - 1, stack_terms_base); STACK_CHECK_EXPAND(stack_terms, stack_vars + ArityOfFunctor(f) - 1, stack_terms_base);
for (j = ArityOfFunctor(f); j >= 1; j--) for (j = ArityOfFunctor(f); j >= 1; j--)
STACK_PUSH_UP(*(RepAppl(t) + j), stack_terms); STACK_PUSH_UP(*(RepAppl(t) + j), stack_terms);
} }
#ifdef TRIE_COMPACT_LISTS
in_new_list = 0;
#endif /* TRIE_COMPACT_LISTS */
} else { } else {
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (answer_search)"); Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (answer_search)");
} }
@ -860,6 +934,9 @@ void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) {
CELL *stack_vars_base, *stack_vars, *stack_terms_base, *stack_terms; CELL *stack_vars_base, *stack_vars, *stack_terms_base, *stack_terms;
int subs_arity, i, n_vars = -1; int subs_arity, i, n_vars = -1;
Term t; Term t;
#ifdef TRIE_COMPACT_LISTS
int stack_terms_pair_offset = 0;
#endif /* TRIE_COMPACT_LISTS */
if ((subs_arity = *subs_ptr) == 0) if ((subs_arity = *subs_ptr) == 0)
return; return;
@ -890,10 +967,31 @@ void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) {
STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base);
STACK_PUSH_UP(t, stack_terms); STACK_PUSH_UP(t, stack_terms);
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
#ifdef TRIE_COMPACT_LISTS
if (t == AbsPair(PairTermInit)) {
Term *stack_aux = stack_terms_base - stack_terms_pair_offset;
Term head, tail = STACK_POP_UP(stack_aux);
while (STACK_NOT_EMPTY(stack_aux, stack_terms)) {
head = STACK_POP_UP(stack_aux);
tail = MkPairTerm(head, tail);
}
stack_terms = stack_terms_base - stack_terms_pair_offset;
stack_terms_pair_offset = (int) STACK_POP_DOWN(stack_terms);
STACK_PUSH_UP(tail, stack_terms);
} else { /* AbsPair(PairTermLast)) */
Term last;
STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base);
last = STACK_POP_DOWN(stack_terms);
STACK_PUSH_UP(stack_terms_pair_offset, stack_terms);
stack_terms_pair_offset = (int) (stack_terms_base - stack_terms);
STACK_PUSH_UP(last, stack_terms);
}
#else
Term head = STACK_POP_DOWN(stack_terms); Term head = STACK_POP_DOWN(stack_terms);
Term tail = STACK_POP_DOWN(stack_terms); Term tail = STACK_POP_DOWN(stack_terms);
t = MkPairTerm(head, tail); t = MkPairTerm(head, tail);
STACK_PUSH_UP(t, stack_terms); STACK_PUSH_UP(t, stack_terms);
#endif /* TRIE_COMPACT_LISTS */
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
Functor f = (Functor) RepAppl(t); Functor f = (Functor) RepAppl(t);
if (f == FunctorDouble) { if (f == FunctorDouble) {
@ -925,8 +1023,6 @@ void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) {
STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base);
STACK_PUSH_UP(t, stack_terms); STACK_PUSH_UP(t, stack_terms);
} }
} else {
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (load_answer_trie)");
} }
t = TrNode_entry(ans_node); t = TrNode_entry(ans_node);
ans_node = TrNode_parent(ans_node); ans_node = TrNode_parent(ans_node);
@ -984,25 +1080,52 @@ void private_completion(sg_fr_ptr sg_fr) {
} }
void free_subgoal_trie_branch(sg_node_ptr node, int missing_nodes) { void free_subgoal_trie_branch(sg_node_ptr node, int nodes_left, int nodes_extra) {
Term t;
if (TrNode_next(node)) if (TrNode_next(node))
free_subgoal_trie_branch(TrNode_next(node), missing_nodes); free_subgoal_trie_branch(TrNode_next(node), nodes_left, nodes_extra);
t = TrNode_entry(node); if (nodes_extra) {
if (IsVarTerm(t) || IsAtomOrIntTerm(t)) { #ifdef TRIE_COMPACT_LISTS
missing_nodes -= 1; if (nodes_extra < 0) {
} else if (IsPairTerm(t)) { Term t = TrNode_entry(node);
missing_nodes += 1; if (IsPairTerm(t)) {
} else if (IsApplTerm(t)) { if (t == AbsPair(PairTermInit))
missing_nodes += ArityOfFunctor((Functor)RepAppl(t)) - 1; nodes_extra--;
} else { else /* AbsPair(PairTermLast) */
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (chain_subgoal_frames)"); nodes_extra++;
} }
if (missing_nodes) { } else
free_subgoal_trie_branch(TrNode_child(node), missing_nodes); #endif /* TRIE_COMPACT_LISTS */
if (--nodes_extra == 0)
nodes_left--;
} else { } else {
Term t = TrNode_entry(node);
if (IsVarTerm(t) || IsAtomOrIntTerm(t))
nodes_left--;
else if (IsPairTerm(t))
#ifdef TRIE_COMPACT_LISTS
/* AbsPair(PairTermInit) */
nodes_extra = -1;
#else
nodes_left++;
#endif /* TRIE_COMPACT_LISTS */
else if (IsApplTerm(t)) {
Functor f = (Functor) RepAppl(t);
if (f == FunctorDouble)
#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
nodes_extra = 2;
#else
nodes_extra = 1;
#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
else if (f == FunctorLongInt)
nodes_extra = 1;
else
nodes_left += ArityOfFunctor(f) - 1;
}
}
if (nodes_left)
free_subgoal_trie_branch(TrNode_child(node), nodes_left, nodes_extra);
else {
sg_fr_ptr sg_fr; sg_fr_ptr sg_fr;
ans_node_ptr ans_node; ans_node_ptr ans_node;
sg_fr = (sg_fr_ptr) TrNode_sg_fr(node); sg_fr = (sg_fr_ptr) TrNode_sg_fr(node);
@ -1286,6 +1409,12 @@ void traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *a
sg_node = *bucket; sg_node = *bucket;
traverse_subgoal_trie(sg_node, str, str_index, arity, depth, mode); traverse_subgoal_trie(sg_node, str, str_index, arity, depth, mode);
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#ifdef TRIE_COMPACT_LISTS
else if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
str[str_index - 1] = ',';
#endif /* TRIE_COMPACT_LISTS */
} }
} while (++bucket != last_bucket); } while (++bucket != last_bucket);
free(current_arity); free(current_arity);
@ -1301,6 +1430,10 @@ void traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *a
free(current_arity); free(current_arity);
if (arity[arity[0]] == -1) if (arity[arity[0]] == -1)
str[str_index - 1] = '|'; str[str_index - 1] = '|';
#ifdef TRIE_COMPACT_LISTS
else if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
str[str_index - 1] = ',';
#endif /* TRIE_COMPACT_LISTS */
} }
/* test the node type */ /* test the node type */
@ -1334,13 +1467,17 @@ void traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *a
break; break;
} }
} else { } else {
arity[arity[0]]++; if (arity[arity[0]] == -2) {
if (arity[arity[0]] == 0) { #ifdef TRIE_COMPACT_LISTS
str_index += sprintf(& str[str_index], ",");
#else
str_index += sprintf(& str[str_index], "|");
arity[arity[0]] = -1;
#endif /* TRIE_COMPACT_LISTS */
break;
} else {
str_index += sprintf(& str[str_index], "]"); str_index += sprintf(& str[str_index], "]");
arity[0]--; arity[0]--;
} else {
str_index += sprintf(& str[str_index], "|");
break;
} }
} }
} }
@ -1363,13 +1500,17 @@ void traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *a
break; break;
} }
} else { } else {
arity[arity[0]]++; if (arity[arity[0]] == -2) {
if (arity[arity[0]] == 0) { #ifdef TRIE_COMPACT_LISTS
str_index += sprintf(& str[str_index], ",");
#else
str_index += sprintf(& str[str_index], "|");
arity[arity[0]] = -1;
#endif /* TRIE_COMPACT_LISTS */
break;
} else {
str_index += sprintf(& str[str_index], "]"); str_index += sprintf(& str[str_index], "]");
arity[0]--; arity[0]--;
} else {
str_index += sprintf(& str[str_index], "|");
break;
} }
} }
} }
@ -1391,13 +1532,17 @@ void traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *a
break; break;
} }
} else { } else {
arity[arity[0]]++; if (arity[arity[0]] == -2) {
if (arity[arity[0]] == 0) { #ifdef TRIE_COMPACT_LISTS
str_index += sprintf(& str[str_index], ",");
#else
str_index += sprintf(& str[str_index], "|");
arity[arity[0]] = -1;
#endif /* TRIE_COMPACT_LISTS */
break;
} else {
str_index += sprintf(& str[str_index], "]"); str_index += sprintf(& str[str_index], "]");
arity[0]--; arity[0]--;
} else {
str_index += sprintf(& str[str_index], "|");
break;
} }
} }
} }
@ -1418,13 +1563,17 @@ void traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *a
break; break;
} }
} else { } else {
arity[arity[0]]++; if (arity[arity[0]] == -2) {
if (arity[arity[0]] == 0) { #ifdef TRIE_COMPACT_LISTS
str_index += sprintf(& str[str_index], ",");
#else
str_index += sprintf(& str[str_index], "|");
arity[arity[0]] = -1;
#endif /* TRIE_COMPACT_LISTS */
break;
} else {
str_index += sprintf(& str[str_index], "]"); str_index += sprintf(& str[str_index], "]");
arity[0]--; arity[0]--;
} else {
str_index += sprintf(& str[str_index], "|");
break;
} }
} }
} }
@ -1445,20 +1594,30 @@ void traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *a
break; break;
} }
} else { } else {
arity[arity[0]]++; if (arity[arity[0]] == -2) {
if (arity[arity[0]] == 0) { #ifdef TRIE_COMPACT_LISTS
str_index += sprintf(& str[str_index], ",");
#else
str_index += sprintf(& str[str_index], "|");
arity[arity[0]] = -1;
#endif /* TRIE_COMPACT_LISTS */
break;
} else {
str_index += sprintf(& str[str_index], "]"); str_index += sprintf(& str[str_index], "]");
arity[0]--; arity[0]--;
} else {
str_index += sprintf(& str[str_index], "|");
break;
} }
} }
} }
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
#ifdef TRIE_COMPACT_LISTS
if (t == AbsPair(PairTermLast)) {
str[str_index - 1] = '|';
arity[arity[0]] = -1;
#else
if (arity[arity[0]] == -1) { if (arity[arity[0]] == -1) {
str[str_index - 1] = ','; str[str_index - 1] = ',';
arity[arity[0]] = -2; arity[arity[0]] = -2;
#endif /* TRIE_COMPACT_LISTS */
} else { } else {
str_index += sprintf(& str[str_index], "["); str_index += sprintf(& str[str_index], "[");
arity[0]++; arity[0]++;
@ -1475,8 +1634,6 @@ void traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *a
arity[0]++; arity[0]++;
arity[arity[0]] = ArityOfFunctor(f); arity[arity[0]] = ArityOfFunctor(f);
} }
} else {
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (traverse_subgoal_trie)");
} }
TrStat_sg_nodes++; TrStat_sg_nodes++;
@ -1549,6 +1706,12 @@ void traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *
ans_node = *bucket; ans_node = *bucket;
traverse_answer_trie(ans_node, str, str_index, arity, var_index, depth, mode); traverse_answer_trie(ans_node, str, str_index, arity, var_index, depth, mode);
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#ifdef TRIE_COMPACT_LISTS
else if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
str[str_index - 1] = ',';
#endif /* TRIE_COMPACT_LISTS */
} }
} while (++bucket != last_bucket); } while (++bucket != last_bucket);
free(current_arity); free(current_arity);
@ -1564,6 +1727,10 @@ void traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *
free(current_arity); free(current_arity);
if (arity[arity[0]] == -1) if (arity[arity[0]] == -1)
str[str_index - 1] = '|'; str[str_index - 1] = '|';
#ifdef TRIE_COMPACT_LISTS
else if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
str[str_index - 1] = ',';
#endif /* TRIE_COMPACT_LISTS */
} }
/* print VAR when starting a term */ /* print VAR when starting a term */
@ -1602,13 +1769,17 @@ void traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *
break; break;
} }
} else { } else {
arity[arity[0]]++; if (arity[arity[0]] == -2) {
if (arity[arity[0]] == 0) { #ifdef TRIE_COMPACT_LISTS
str_index += sprintf(& str[str_index], ",");
#else
str_index += sprintf(& str[str_index], "|");
arity[arity[0]] = -1;
#endif /* TRIE_COMPACT_LISTS */
break;
} else {
str_index += sprintf(& str[str_index], "]"); str_index += sprintf(& str[str_index], "]");
arity[0]--; arity[0]--;
} else {
str_index += sprintf(& str[str_index], "|");
break;
} }
} }
} }
@ -1633,13 +1804,17 @@ void traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *
break; break;
} }
} else { } else {
arity[arity[0]]++; if (arity[arity[0]] == -2) {
if (arity[arity[0]] == 0) { #ifdef TRIE_COMPACT_LISTS
str_index += sprintf(& str[str_index], ",");
#else
str_index += sprintf(& str[str_index], "|");
arity[arity[0]] = -1;
#endif /* TRIE_COMPACT_LISTS */
break;
} else {
str_index += sprintf(& str[str_index], "]"); str_index += sprintf(& str[str_index], "]");
arity[0]--; arity[0]--;
} else {
str_index += sprintf(& str[str_index], "|");
break;
} }
} }
} }
@ -1663,13 +1838,17 @@ void traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *
break; break;
} }
} else { } else {
arity[arity[0]]++; if (arity[arity[0]] == -2) {
if (arity[arity[0]] == 0) { #ifdef TRIE_COMPACT_LISTS
str_index += sprintf(& str[str_index], ",");
#else
str_index += sprintf(& str[str_index], "|");
arity[arity[0]] = -1;
#endif /* TRIE_COMPACT_LISTS */
break;
} else {
str_index += sprintf(& str[str_index], "]"); str_index += sprintf(& str[str_index], "]");
arity[0]--; arity[0]--;
} else {
str_index += sprintf(& str[str_index], "|");
break;
} }
} }
} }
@ -1690,13 +1869,17 @@ void traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *
break; break;
} }
} else { } else {
arity[arity[0]]++; if (arity[arity[0]] == -2) {
if (arity[arity[0]] == 0) { #ifdef TRIE_COMPACT_LISTS
str_index += sprintf(& str[str_index], ",");
#else
str_index += sprintf(& str[str_index], "|");
arity[arity[0]] = -1;
#endif /* TRIE_COMPACT_LISTS */
break;
} else {
str_index += sprintf(& str[str_index], "]"); str_index += sprintf(& str[str_index], "]");
arity[0]--; arity[0]--;
} else {
str_index += sprintf(& str[str_index], "|");
break;
} }
} }
} }
@ -1717,20 +1900,30 @@ void traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *
break; break;
} }
} else { } else {
arity[arity[0]]++; if (arity[arity[0]] == -2) {
if (arity[arity[0]] == 0) { #ifdef TRIE_COMPACT_LISTS
str_index += sprintf(& str[str_index], ",");
#else
str_index += sprintf(& str[str_index], "|");
arity[arity[0]] = -1;
#endif /* TRIE_COMPACT_LISTS */
break;
} else {
str_index += sprintf(& str[str_index], "]"); str_index += sprintf(& str[str_index], "]");
arity[0]--; arity[0]--;
} else {
str_index += sprintf(& str[str_index], "|");
break;
} }
} }
} }
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
#ifdef TRIE_COMPACT_LISTS
if (t == AbsPair(PairTermLast)) {
str[str_index - 1] = '|';
arity[arity[0]] = -1;
#else
if (arity[arity[0]] == -1) { if (arity[arity[0]] == -1) {
str[str_index - 1] = ','; str[str_index - 1] = ',';
arity[arity[0]] = -2; arity[arity[0]] = -2;
#endif /* TRIE_COMPACT_LISTS */
} else { } else {
str_index += sprintf(& str[str_index], "["); str_index += sprintf(& str[str_index], "[");
arity[0]++; arity[0]++;
@ -1747,8 +1940,6 @@ void traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *
arity[0]++; arity[0]++;
arity[arity[0]] = ArityOfFunctor(f); arity[arity[0]] = ArityOfFunctor(f);
} }
} else {
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (traverse_answer_trie)");
} }
TrStat_ans_nodes++; TrStat_ans_nodes++;

787
OPTYap/tab.tries.insts.i
View File

@ -105,7 +105,7 @@
SET_BB(NORM_CP(YENV)); \ SET_BB(NORM_CP(YENV)); \
copy_arity_stack() copy_arity_stack()
#define pop_trie_node() \ #define really_pop_trie_node() \
YENV = (CELL *) PROTECT_FROZEN_B((B + 1)); \ YENV = (CELL *) PROTECT_FROZEN_B((B + 1)); \
H = PROTECT_FROZEN_H(B); \ H = PROTECT_FROZEN_H(B); \
pop_yaam_reg_cpdepth(B); \ pop_yaam_reg_cpdepth(B); \
@ -119,6 +119,17 @@
copy_arity_stack(); \ copy_arity_stack(); \
} }
#ifdef YAPOR
#define pop_trie_node() \
if (SCH_top_shared_cp(B)) { \
restore_trie_node(NULL); \
} else { \
really_pop_trie_node(); \
}
#else
#define pop_trie_node() really_pop_trie_node()
#endif /* YAPOR */
/* ------------------- ** /* ------------------- **
@ -126,17 +137,28 @@
** ------------------- */ ** ------------------- */
#define stack_trie_null_instr() \ #define stack_trie_null_instr() \
*aux_ptr = 0; \ next_trie_instruction(node)
*--aux_ptr = heap_arity + 1; \
#define stack_trie_null_in_new_list_instr() \
aux_ptr++; \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
H += 2; \
*aux_ptr-- = (CELL) (H - 1); \
*aux_ptr-- = (CELL) (H - 2); \
*aux_ptr = heap_arity - 1 + 2; \
YENV = aux_ptr; \ YENV = aux_ptr; \
next_trie_instruction(node) next_trie_instruction(node)
/* /*
#define cp_trie_null_instr() \ #define stack_trie_null_in_new_list_instr() \
aux_ptr += heap_arity + subs_arity + vars_arity + 2; \ aux_ptr++; \
for (i = 0; i < heap_arity + subs_arity + vars_arity + 2; i++) \ Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
*--YENV = *aux_ptr--; \ H += 2; \
*--YENV = 0; \ *aux_ptr-- = (CELL) (H - 1); \
*--YENV = heap_arity + 1; \ *aux_ptr-- = (CELL) (H - 2); \
heap_arity = heap_arity - 1 + 2; \
*aux_ptr = heap_arity; \
YENV = aux_ptr; \
\
next_trie_instruction(node) next_trie_instruction(node)
*/ */
@ -168,33 +190,53 @@
*++aux_ptr = subs_arity - 1; \ *++aux_ptr = subs_arity - 1; \
next_instruction(subs_arity - 1, node); \ next_instruction(subs_arity - 1, node); \
} }
#define stack_trie_var_in_new_list_instr() \
RESET_VARIABLE((CELL) H); \
*aux_ptr-- = (CELL) (H + 1); \
*aux_ptr = heap_arity; \
YENV = aux_ptr; \
aux_ptr += 2; \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
for (i = 0; i < heap_arity - 1; i++) { \
*aux_ptr = *(aux_ptr + 1); \
aux_ptr++; \
} \
*aux_ptr++ = vars_arity + 1; \
*aux_ptr++ = subs_arity; \
for (i = 0; i < subs_arity; i++) { \
*aux_ptr = *(aux_ptr + 1); \
aux_ptr++; \
} \
*aux_ptr = (CELL) H; \
H += 2; \
next_trie_instruction(node)
/* /*
#define cp_trie_var_instr() \ #define stack_trie_var_in_new_list_instr() \
if (heap_arity) { \ aux_ptr++; \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
H += 2; \
*aux_ptr-- = (CELL) (H - 1); \
*aux_ptr-- = (CELL) (H - 2); \
heap_arity = heap_arity - 1 + 2; \
*aux_ptr = heap_arity; \
YENV = aux_ptr; \
\
*aux_ptr = heap_arity - 1; \
var_ptr = *++aux_ptr; \ var_ptr = *++aux_ptr; \
RESET_VARIABLE(var_ptr); \ RESET_VARIABLE(var_ptr); \
aux_ptr += heap_arity + subs_arity + vars_arity + 1; \ for (i = 0; i < heap_arity - 1; i++) { \
for (i = 0; i < vars_arity; i++) \ *aux_ptr = *(aux_ptr + 1); \
*--YENV = *aux_ptr--; \ aux_ptr++; \
*--YENV = var_ptr; \ } \
for (i = 0; i < subs_arity; i++) \ *aux_ptr++ = vars_arity + 1; \
*--YENV = *aux_ptr--; \ *aux_ptr++ = subs_arity; \
*--YENV = subs_arity; \ for (i = 0; i < subs_arity; i++) { \
*--YENV = vars_arity + 1; \ *aux_ptr = *(aux_ptr + 1); \
aux_ptr--; \ aux_ptr++; \
for (i = 1; i < heap_arity; i++) \ } \
*--YENV = *--aux_ptr; \ *aux_ptr = var_ptr; \
*--YENV = heap_arity - 1; \ next_instruction(heap_arity - 1 || subs_arity, node)
next_instruction(heap_arity - 1 || subs_arity, node); \
} else { \
aux_ptr += 2 + subs_arity + vars_arity; \
for (i = 0; i < subs_arity + vars_arity; i++) \
*--YENV = *aux_ptr--; \
*--YENV = subs_arity - 1; \
*--YENV = vars_arity + 1; \
*--YENV = 0; \
next_instruction(subs_arity - 1, node); \
}
*/ */
@ -251,10 +293,35 @@
} \ } \
next_instruction(subs_arity - 1, node); \ next_instruction(subs_arity - 1, node); \
} }
/*
#define cp_trie_val_instr() \ #define stack_trie_val_in_new_list_instr() \
if (heap_arity) { \
aux_ptr++; \ aux_ptr++; \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
H += 2; \
*aux_ptr = (CELL) (H - 1); \
aux = (CELL) (H - 2); \
subs_ptr = aux_ptr + heap_arity + 1 + subs_arity + vars_arity - var_index; \
subs = *subs_ptr; \
if (aux > subs) { \
Bind_Global((CELL *) aux, subs); \
} else { \
RESET_VARIABLE(aux); \
Bind_Local((CELL *) subs, aux); \
*subs_ptr = aux; \
} \
next_trie_instruction(node)
/*
#define stack_trie_val_in_new_list_instr() \
aux_ptr++; \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
H += 2; \
*aux_ptr-- = (CELL) (H - 1); \
*aux_ptr-- = (CELL) (H - 2); \
heap_arity = heap_arity - 1 + 2; \
*aux_ptr = heap_arity; \
YENV = aux_ptr; \
\
YENV = ++aux_ptr; \
subs_ptr = aux_ptr + heap_arity + 1 + subs_arity + vars_arity - var_index; \ subs_ptr = aux_ptr + heap_arity + 1 + subs_arity + vars_arity - var_index; \
aux = *aux_ptr; \ aux = *aux_ptr; \
subs = *subs_ptr; \ subs = *subs_ptr; \
@ -265,46 +332,8 @@
Bind_Local((CELL *) subs, aux); \ Bind_Local((CELL *) subs, aux); \
*subs_ptr = aux; \ *subs_ptr = aux; \
} \ } \
aux_ptr += heap_arity + subs_arity + vars_arity + 1; \ *aux_ptr = heap_arity - 1; \
for (i = 0; i < heap_arity + subs_arity + vars_arity + 1; i++) \ next_instruction(heap_arity - 1 || subs_arity, node)
*--YENV = *aux_ptr--; \
*--YENV = heap_arity - 1; \
next_instruction(heap_arity - 1 || subs_arity, node); \
} else { \
aux_ptr += 2 + subs_arity; \
subs_ptr = aux_ptr + vars_arity - var_index; \
aux = *aux_ptr; \
subs = *subs_ptr; \
if (aux > subs) { \
if ((CELL *) aux <= H) { \
Bind_Global((CELL *) aux, subs); \
} else if ((CELL *) subs <= H) { \
Bind_Local((CELL *) aux, subs); \
} else { \
Bind_Local((CELL *) subs, aux); \
*subs_ptr = aux; \
} \
} else { \
if ((CELL *) subs <= H) { \
Bind_Global((CELL *) subs, aux); \
*subs_ptr = aux; \
} else if ((CELL *) aux <= H) { \
Bind_Local((CELL *) subs, aux); \
*subs_ptr = aux; \
} else { \
Bind_Local((CELL *) aux, subs); \
} \
} \
aux_ptr += vars_arity; \
for (i = 0; i < vars_arity; i++) \
*--YENV = *aux_ptr--; \
for (i = 1; i < subs_arity; i++) \
*--YENV = *--aux_ptr; \
*--YENV = subs_arity - 1; \
*--YENV = vars_arity; \
*--YENV = 0; \
next_instruction(subs_arity - 1, node); \
}
*/ */
@ -330,29 +359,29 @@
} \ } \
next_instruction(subs_arity - 1, node); \ next_instruction(subs_arity - 1, node); \
} }
/*
#define cp_trie_atom_instr() \ #define stack_trie_atom_in_new_list_instr() \
if (heap_arity) { \
aux_ptr++; \ aux_ptr++; \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
H += 2; \
*aux_ptr = (CELL) (H - 1); \
Bind_Global((H - 2), TrNode_entry(node)); \
next_trie_instruction(node)
/*
#define stack_trie_atom_in_new_list_instr() \
aux_ptr++; \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
H += 2; \
*aux_ptr-- = (CELL) (H - 1); \
*aux_ptr-- = (CELL) (H - 2); \
heap_arity = heap_arity - 1 + 2; \
*aux_ptr = heap_arity; \
YENV = aux_ptr; \
\
YENV = ++aux_ptr; \
Bind_Global((CELL *) *aux_ptr, TrNode_entry(node)); \ Bind_Global((CELL *) *aux_ptr, TrNode_entry(node)); \
aux_ptr += heap_arity + subs_arity + vars_arity + 1; \ *aux_ptr = heap_arity - 1; \
for (i = 0; i < heap_arity + subs_arity + vars_arity + 1; i++) \ next_instruction(heap_arity - 1 || subs_arity, node)
*--YENV = *aux_ptr--; \
*--YENV = heap_arity - 1; \
next_instruction(heap_arity - 1 || subs_arity, node); \
} else { \
aux_ptr += 2 + subs_arity; \
Bind((CELL *) *aux_ptr, TrNode_entry(node)); \
aux_ptr += vars_arity; \
for (i = 0; i < vars_arity; i++) \
*--YENV = *aux_ptr--; \
for (i = 1; i < subs_arity; i++) \
*--YENV = *--aux_ptr; \
*--YENV = subs_arity - 1; \
*--YENV = vars_arity; \
*--YENV = 0; \
next_instruction(subs_arity - 1, node); \
}
*/ */
@ -386,33 +415,37 @@
} \ } \
} \ } \
next_trie_instruction(node) next_trie_instruction(node)
/*
#define cp_trie_list_instr() \ #define stack_trie_list_in_new_list_instr() \
if (heap_arity) { \
aux_ptr++; \ aux_ptr++; \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \ Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
aux_ptr += heap_arity + subs_arity + vars_arity + 1; \
for (i = 0; i < vars_arity + subs_arity + heap_arity + 1; i++) \
*--YENV = *aux_ptr--; \
H += 2; \ H += 2; \
*--YENV = (CELL) (H - 1); \ *aux_ptr-- = (CELL) (H - 1); \
*--YENV = (CELL) (H - 2); \ Bind_Global((H - 2), AbsPair(H)); \
*--YENV = heap_arity + 1; \
} else { \
aux_ptr += 2 + subs_arity; \
Bind((CELL *) *aux_ptr, AbsPair(H)); \
aux_ptr += vars_arity; \
for (i = 0; i < vars_arity; i++) \
*--YENV = *aux_ptr--; \
for (i = 1; i < subs_arity; i++) \
*--YENV = *--aux_ptr; \
*--YENV = subs_arity - 1; \
*--YENV = vars_arity; \
H += 2; \ H += 2; \
*--YENV = (CELL) (H - 1); \ *aux_ptr-- = (CELL) (H - 1); \
*--YENV = (CELL) (H - 2); \ *aux_ptr-- = (CELL) (H - 2); \
*--YENV = 2; \ *aux_ptr = heap_arity - 1 + 1 + 2; \
} \ YENV = aux_ptr; \
next_trie_instruction(node)
/*
#define stack_trie_list_in_new_list_instr() \
aux_ptr++; \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
H += 2; \
*aux_ptr-- = (CELL) (H - 1); \
*aux_ptr-- = (CELL) (H - 2); \
heap_arity = heap_arity - 1 + 2; \
*aux_ptr = heap_arity; \
YENV = aux_ptr; \
\
aux_ptr++; \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
H += 2; \
*aux_ptr-- = (CELL) (H - 1); \
*aux_ptr-- = (CELL) (H - 2); \
*aux_ptr = heap_arity - 1 + 2; \
YENV = aux_ptr; \
next_trie_instruction(node) next_trie_instruction(node)
*/ */
@ -449,35 +482,39 @@
} \ } \
} \ } \
next_trie_instruction(node) next_trie_instruction(node)
#define stack_trie_struct_in_new_list_instr() \
aux_ptr++; \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
H += 2; \
*aux_ptr-- = (CELL) (H - 1); \
Bind_Global((H - 2), AbsAppl(H)); \
*H++ = (CELL) func; \
H += func_arity; \
for (i = 1; i <= func_arity; i++) \
*aux_ptr-- = (CELL) (H - i); \
*aux_ptr = heap_arity - 1 + 1 + func_arity; \
YENV = aux_ptr; \
next_trie_instruction(node)
/* /*
#define cp_trie_struct_instr() \ #define stack_trie_struct_in_new_list_instr() \
if (heap_arity) { \ aux_ptr++; \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
H += 2; \
*aux_ptr-- = (CELL) (H - 1); \
*aux_ptr-- = (CELL) (H - 2); \
heap_arity = heap_arity - 1 + 2; \
*aux_ptr = heap_arity; \
YENV = aux_ptr; \
\
aux_ptr++; \ aux_ptr++; \
Bind_Global((CELL *) *aux_ptr, AbsAppl(H)); \ Bind_Global((CELL *) *aux_ptr, AbsAppl(H)); \
aux_ptr += heap_arity + subs_arity + vars_arity + 1; \
for (i = 0; i < vars_arity + subs_arity + heap_arity + 1; i++) \
*--YENV = *aux_ptr--; \
*H++ = (CELL) func; \ *H++ = (CELL) func; \
H += func_arity; \ H += func_arity; \
for (i = 1; i <= func_arity; i++) \ for (i = 1; i <= func_arity; i++) \
*--YENV = (CELL) (H - i); \ *aux_ptr-- = (CELL) (H - i); \
*--YENV = heap_arity + func_arity - 1; \ *aux_ptr = heap_arity - 1 + func_arity; \
} else { \ YENV = aux_ptr; \
aux_ptr += 2 + subs_arity; \
Bind((CELL *) *aux_ptr, AbsAppl(H)); \
aux_ptr += vars_arity; \
for (i = 0; i < vars_arity; i++) \
*--YENV = *aux_ptr--; \
for (i = 1; i < subs_arity; i++) \
*--YENV = *--aux_ptr; \
*--YENV = subs_arity - 1; \
*--YENV = vars_arity; \
*H++ = (CELL) func; \
H += func_arity; \
for (i = 1; i <= func_arity; i++) \
*--YENV = (CELL) (H - i); \
*--YENV = func_arity; \
} \
next_trie_instruction(node) next_trie_instruction(node)
*/ */
@ -492,15 +529,6 @@
*--aux_ptr = heap_arity + 1; \ *--aux_ptr = heap_arity + 1; \
YENV = aux_ptr; \ YENV = aux_ptr; \
next_trie_instruction(node) next_trie_instruction(node)
/*
#define cp_trie_extension_instr() \
aux_ptr += heap_arity + subs_arity + vars_arity + 2; \
for (i = 0; i < heap_arity + subs_arity + vars_arity + 2; i++) \
*--YENV = *aux_ptr--; \
*--YENV = TrNode_entry(node); \
*--YENV = heap_arity + 1; \
next_trie_instruction(node)
*/
@ -510,13 +538,12 @@
#define stack_trie_float_longint_instr() \ #define stack_trie_float_longint_instr() \
if (heap_arity) { \ if (heap_arity) { \
aux_ptr++; \
YENV = ++aux_ptr; \ YENV = ++aux_ptr; \
Bind_Global((CELL *) *aux_ptr, t); \ Bind_Global((CELL *) *aux_ptr, t); \
*aux_ptr = heap_arity - 1; \ *aux_ptr = heap_arity - 1; \
next_instruction(heap_arity - 1 || subs_arity, node); \ next_instruction(heap_arity - 1 || subs_arity, node); \
} else { \ } else { \
YENV = ++aux_ptr; \ YENV = aux_ptr; \
*aux_ptr = 0; \ *aux_ptr = 0; \
aux_ptr += 2; \ aux_ptr += 2; \
*aux_ptr = subs_arity - 1; \ *aux_ptr = subs_arity - 1; \
@ -527,7 +554,7 @@
aux_ptr++; \ aux_ptr++; \
} \ } \
next_instruction(subs_arity - 1, node); \ next_instruction(subs_arity - 1, node); \
} \ }
@ -537,8 +564,6 @@
PBOp(trie_do_null, e) PBOp(trie_do_null, e)
register ans_node_ptr node = (ans_node_ptr) PREG; register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
int heap_arity = *aux_ptr;
stack_trie_null_instr(); stack_trie_null_instr();
ENDPBOp(); ENDPBOp();
@ -551,14 +576,7 @@
int vars_arity = *(aux_ptr + heap_arity + 1); int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2); int subs_arity = *(aux_ptr + heap_arity + 2);
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_node(NULL);
} else
#endif /* YAPOR */
{
pop_trie_node(); pop_trie_node();
}
stack_trie_null_instr(); stack_trie_null_instr();
ENDPBOp(); ENDPBOp();
@ -587,6 +605,67 @@
ENDPBOp(); ENDPBOp();
PBOp(trie_do_null_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
int heap_arity = *aux_ptr;
stack_trie_null_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_null_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_trust_null_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
pop_trie_node();
stack_trie_null_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_null_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_try_null_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
store_trie_node(TrNode_next(node));
stack_trie_null_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_null_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_retry_null_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
restore_trie_node(TrNode_next(node));
stack_trie_null_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_null_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_do_var, e) PBOp(trie_do_var, e)
register ans_node_ptr node = (ans_node_ptr) PREG; register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV; register CELL *aux_ptr = YENV;
@ -609,14 +688,7 @@
int subs_arity = *(aux_ptr + heap_arity + 2); int subs_arity = *(aux_ptr + heap_arity + 2);
int i; int i;
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_node(NULL);
} else
#endif /* YAPOR */
{
pop_trie_node(); pop_trie_node();
}
stack_trie_var_instr(); stack_trie_var_instr();
ENDPBOp(); ENDPBOp();
@ -649,6 +721,73 @@
ENDPBOp(); ENDPBOp();
PBOp(trie_do_var_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
stack_trie_var_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_var_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_trust_var_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
pop_trie_node();
stack_trie_var_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_var_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_try_var_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
store_trie_node(TrNode_next(node));
stack_trie_var_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_var_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_retry_var_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
restore_trie_node(TrNode_next(node));
stack_trie_var_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_var_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_do_val, e) PBOp(trie_do_val, e)
register ans_node_ptr node = (ans_node_ptr) PREG; register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV, *subs_ptr; register CELL *aux_ptr = YENV, *subs_ptr;
@ -673,14 +812,7 @@
int var_index = VarIndexOfTableTerm(TrNode_entry(node)); int var_index = VarIndexOfTableTerm(TrNode_entry(node));
int i; int i;
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_node(NULL);
} else
#endif /* YAPOR */
{
pop_trie_node(); pop_trie_node();
}
stack_trie_val_instr(); stack_trie_val_instr();
ENDPBOp(); ENDPBOp();
@ -715,6 +847,77 @@
ENDPBOp(); ENDPBOp();
PBOp(trie_do_val_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV, *subs_ptr;
register CELL aux, subs;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int var_index = VarIndexOfTableTerm(TrNode_entry(node));
stack_trie_val_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_val_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_trust_val_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1), *subs_ptr;
register CELL aux, subs;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int var_index = VarIndexOfTableTerm(TrNode_entry(node));
pop_trie_node();
stack_trie_val_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_val_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_try_val_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV, *subs_ptr;
register CELL aux, subs;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int var_index = VarIndexOfTableTerm(TrNode_entry(node));
store_trie_node(TrNode_next(node));
stack_trie_val_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_val_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_retry_val_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1), *subs_ptr;
register CELL aux, subs;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int var_index = VarIndexOfTableTerm(TrNode_entry(node));
restore_trie_node(TrNode_next(node));
stack_trie_val_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_val_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_do_atom, e) PBOp(trie_do_atom, e)
register ans_node_ptr node = (ans_node_ptr) PREG; register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV; register CELL *aux_ptr = YENV;
@ -735,14 +938,7 @@
int subs_arity = *(aux_ptr + heap_arity + 2); int subs_arity = *(aux_ptr + heap_arity + 2);
int i; int i;
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_node(NULL);
} else
#endif /* YAPOR */
{
pop_trie_node(); pop_trie_node();
}
stack_trie_atom_instr(); stack_trie_atom_instr();
ENDPBOp(); ENDPBOp();
@ -773,6 +969,66 @@
ENDPBOp(); ENDPBOp();
PBOp(trie_do_atom_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
stack_trie_atom_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_atom_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_trust_atom_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
pop_trie_node();
stack_trie_atom_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_atom_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_try_atom_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
store_trie_node(TrNode_next(node));
stack_trie_atom_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_atom_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_retry_atom_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
restore_trie_node(TrNode_next(node));
stack_trie_atom_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_atom_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_do_list, e) PBOp(trie_do_list, e)
register ans_node_ptr node = (ans_node_ptr) PREG; register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV; register CELL *aux_ptr = YENV;
@ -793,14 +1049,7 @@
int subs_arity = *(aux_ptr + heap_arity + 2); int subs_arity = *(aux_ptr + heap_arity + 2);
int i; int i;
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_node(NULL);
} else
#endif /* YAPOR */
{
pop_trie_node(); pop_trie_node();
}
stack_trie_list_instr(); stack_trie_list_instr();
ENDPBOp(); ENDPBOp();
@ -831,6 +1080,67 @@
ENDPBOp(); ENDPBOp();
PBOp(trie_do_list_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
int heap_arity = *aux_ptr;
stack_trie_list_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_list_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_trust_list_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
pop_trie_node();
stack_trie_list_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_list_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_try_list_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
store_trie_node(TrNode_next(node));
stack_trie_list_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_list_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_retry_list_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
restore_trie_node(TrNode_next(node));
stack_trie_list_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_list_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_do_struct, e) PBOp(trie_do_struct, e)
register ans_node_ptr node = (ans_node_ptr) PREG; register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV; register CELL *aux_ptr = YENV;
@ -855,14 +1165,7 @@
int func_arity = ArityOfFunctor(func); int func_arity = ArityOfFunctor(func);
int i; int i;
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_node(NULL);
} else
#endif /* YAPOR */
{
pop_trie_node(); pop_trie_node();
}
stack_trie_struct_instr(); stack_trie_struct_instr();
ENDPBOp(); ENDPBOp();
@ -897,6 +1200,79 @@
ENDPBOp(); ENDPBOp();
PBOp(trie_do_struct_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
int heap_arity = *aux_ptr;
Functor func = (Functor) RepAppl(TrNode_entry(node));
int func_arity = ArityOfFunctor(func);
int i;
stack_trie_struct_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_do_struct_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_trust_struct_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
Functor func = (Functor) RepAppl(TrNode_entry(node));
int func_arity = ArityOfFunctor(func);
int i;
pop_trie_node();
stack_trie_struct_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_struct_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_try_struct_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
Functor func = (Functor) RepAppl(TrNode_entry(node));
int func_arity = ArityOfFunctor(func);
int i;
store_trie_node(TrNode_next(node));
stack_trie_struct_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_struct_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_retry_struct_in_new_list, e)
#ifdef TRIE_COMPACT_LISTS
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
Functor func = (Functor) RepAppl(TrNode_entry(node));
int func_arity = ArityOfFunctor(func);
int i;
restore_trie_node(TrNode_next(node));
stack_trie_struct_in_new_list_instr();
#else
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_struct_in_new_list)");
#endif /* TRIE_COMPACT_LISTS */
ENDPBOp();
PBOp(trie_do_extension, e) PBOp(trie_do_extension, e)
register ans_node_ptr node = (ans_node_ptr) PREG; register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV; register CELL *aux_ptr = YENV;
@ -913,14 +1289,7 @@
int vars_arity = *(aux_ptr + heap_arity + 1); int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2); int subs_arity = *(aux_ptr + heap_arity + 2);
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_node(NULL);
} else
#endif /* YAPOR */
{
pop_trie_node(); pop_trie_node();
}
stack_trie_extension_instr(); stack_trie_extension_instr();
ENDPBOp(); ENDPBOp();
@ -963,10 +1332,10 @@
#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
*t_dbl = *++aux_ptr; *t_dbl = *++aux_ptr;
*(t_dbl + 1) = *++aux_ptr; *(t_dbl + 1) = *++aux_ptr;
heap_arity -= 3; heap_arity -= 2;
#else /* SIZEOF_DOUBLE == SIZEOF_INT_P */ #else /* SIZEOF_DOUBLE == SIZEOF_INT_P */
*t_dbl = *++aux_ptr; *t_dbl = *++aux_ptr;
heap_arity -= 2; heap_arity -= 1;
#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
t = MkFloatTerm(dbl); t = MkFloatTerm(dbl);
stack_trie_float_longint_instr(); stack_trie_float_longint_instr();
@ -997,7 +1366,7 @@
int i; int i;
Term t = MkLongIntTerm(*++aux_ptr); Term t = MkLongIntTerm(*++aux_ptr);
heap_arity -= 2; heap_arity -= 1;
stack_trie_float_longint_instr(); stack_trie_float_longint_instr();
ENDPBOp(); ENDPBOp();