From 3d8c03f3c9a41f2434fefa049c17a940db30ab41 Mon Sep 17 00:00:00 2001 From: ricroc Date: Sat, 4 Jun 2005 07:28:24 +0000 Subject: [PATCH] long int support for tabling git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1327 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/absmi.c | 7 ++- C/cdmgr.c | 7 ++- C/heapgc.c | 4 ++ C/index.c | 13 ++++- H/YapOpcodes.h | 9 +++- H/rclause.h | 9 +++- OPTYap/tab.tries.c | 105 ++++++++++++++++++++++++++++++++------- OPTYap/tab.tries.insts.i | 40 ++++++++++++--- 8 files changed, 166 insertions(+), 28 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index 32622471b..a6092eec2 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -10,8 +10,11 @@ * * * File: absmi.c * * comments: Portable abstract machine interpreter * -* Last rev: $Date: 2005-06-03 08:26:31 $,$Author: ricroc $ * +* Last rev: $Date: 2005-06-04 07:27:33 $,$Author: ricroc $ * * $Log: not supported by cvs2svn $ +* Revision 1.167 2005/06/03 08:26:31 ricroc +* float support for tabling +* * Revision 1.166 2005/06/01 20:25:22 vsc * == and \= should not need a choice-point in -> * @@ -1427,6 +1430,8 @@ Yap_absmi(int inp) case _trie_trust_struct: case _trie_retry_float: case _trie_trust_float: + case _trie_retry_long: + case _trie_trust_long: low_level_trace(retry_table_consumer, NULL, NULL); break; case _table_retry_me: diff --git a/C/cdmgr.c b/C/cdmgr.c index 12b9c33ea..f9a1428c8 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -11,8 +11,11 @@ * File: cdmgr.c * * comments: Code manager * * * -* Last rev: $Date: 2005-06-03 08:26:32 $,$Author: ricroc $ * +* Last rev: $Date: 2005-06-04 07:27:33 $,$Author: ricroc $ * * $Log: not supported by cvs2svn $ +* Revision 1.161 2005/06/03 08:26:32 ricroc +* float support for tabling +* * Revision 1.160 2005/06/01 14:02:47 vsc * get_rid of try_me?, retry_me? and trust_me? instructions: they are not * significantly used nowadays. @@ -294,6 +297,8 @@ PredForChoicePt(yamop *p_code) { case _trie_trust_struct: case _trie_retry_float: case _trie_trust_float: + case _trie_retry_long: + case _trie_trust_long: return NULL; case _table_completion: case _table_answer_resolution: diff --git a/C/heapgc.c b/C/heapgc.c index 8cffead3b..74c6e652e 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -1888,6 +1888,8 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose) case _trie_trust_struct: case _trie_retry_float: case _trie_trust_float: + case _trie_retry_long: + case _trie_trust_long: { CELL *aux_ptr; int heap_arity; @@ -2628,6 +2630,8 @@ sweep_choicepoints(choiceptr gc_B) case _trie_trust_struct: case _trie_retry_float: case _trie_trust_float: + case _trie_retry_long: + case _trie_trust_long: { CELL *aux_ptr; int heap_arity; diff --git a/C/index.c b/C/index.c index 19a314369..d4bea8cac 100644 --- a/C/index.c +++ b/C/index.c @@ -11,8 +11,11 @@ * File: index.c * * comments: Indexing a Prolog predicate * * * -* Last rev: $Date: 2005-06-03 08:26:32 $,$Author: ricroc $ * +* Last rev: $Date: 2005-06-04 07:27:34 $,$Author: ricroc $ * * $Log: not supported by cvs2svn $ +* Revision 1.136 2005/06/03 08:26:32 ricroc +* float support for tabling +* * Revision 1.135 2005/06/01 20:25:23 vsc * == and \= should not need a choice-point in -> * @@ -795,6 +798,10 @@ has_cut(yamop *pc) case _trie_trust_float: case _trie_try_float: case _trie_retry_float: + case _trie_do_long: + case _trie_trust_long: + case _trie_try_long: + case _trie_retry_long: #endif /* TABLING */ pc = NEXTOP(pc,e); break; @@ -2171,6 +2178,10 @@ add_info(ClauseDef *clause, UInt regno) case _trie_trust_float: case _trie_try_float: case _trie_retry_float: + case _trie_do_long: + case _trie_trust_long: + case _trie_try_long: + case _trie_retry_long: #endif /* TABLING */ clause->Tag = (CELL)NULL; return; diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index 1d1b5d61e..965e9d8b7 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -11,8 +11,11 @@ * File: YapOpcodes.h * * comments: Central Table with all YAP opcodes * * * -* Last rev: $Date: 2005-06-03 08:18:25 $ * +* Last rev: $Date: 2005-06-04 07:26:43 $ * * $Log: not supported by cvs2svn $ +* Revision 1.29 2005/06/03 08:18:25 ricroc +* float support for tabling +* * Revision 1.28 2005/06/01 20:25:23 vsc * == and \= should not need a choice-point in -> * @@ -106,6 +109,10 @@ OPCODE(trie_trust_float ,e), OPCODE(trie_try_float ,e), OPCODE(trie_retry_float ,e), + OPCODE(trie_do_long ,e), + OPCODE(trie_trust_long ,e), + OPCODE(trie_try_long ,e), + OPCODE(trie_retry_long ,e), #endif /* TABLING */ OPCODE(try_me ,ld), OPCODE(retry_me ,ld), diff --git a/H/rclause.h b/H/rclause.h index 7062f920f..3e5e080dd 100644 --- a/H/rclause.h +++ b/H/rclause.h @@ -12,8 +12,11 @@ * File: rclause.h * * comments: walk through a clause * * * -* Last rev: $Date: 2005-06-03 08:18:25 $,$Author: ricroc $ * +* Last rev: $Date: 2005-06-04 07:26:43 $,$Author: ricroc $ * * $Log: not supported by cvs2svn $ +* Revision 1.6 2005/06/03 08:18:25 ricroc +* float support for tabling +* * Revision 1.5 2005/06/01 20:25:23 vsc * == and \= should not need a choice-point in -> * @@ -242,6 +245,10 @@ restore_opcodes(yamop *pc) case _trie_trust_float: case _trie_try_float: case _trie_retry_float: + case _trie_do_long: + case _trie_trust_long: + case _trie_try_long: + case _trie_retry_long: #endif /* TABLING */ #ifdef TABLING_INNER_CUTS case _clause_with_cut: diff --git a/OPTYap/tab.tries.c b/OPTYap/tab.tries.c index 2acd78fa7..dcfae5816 100644 --- a/OPTYap/tab.tries.c +++ b/OPTYap/tab.tries.c @@ -5,7 +5,7 @@ Copyright: R. Rocha and NCC - University of Porto, Portugal File: tab.tries.C - version: $Id: tab.tries.c,v 1.11 2005-06-03 09:02:08 ricroc Exp $ + version: $Id: tab.tries.c,v 1.12 2005-06-04 07:28:23 ricroc Exp $ **********************************************************************/ @@ -29,10 +29,12 @@ ** Defines ** ** ----------------- */ -#define TRAVERSE_NORMAL 0 -#define TRAVERSE_FLOAT_INIT 1 -#define TRAVERSE_FLOAT 2 -#define TRAVERSE_FLOAT_END 3 +#define TRAVERSE_NORMAL 0 +#define TRAVERSE_FLOAT 1 +#define TRAVERSE_FLOAT2 2 +#define TRAVERSE_FLOAT_END 3 +#define TRAVERSE_LONG 4 +#define TRAVERSE_LONG_END 5 @@ -724,6 +726,9 @@ sg_fr_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr) { current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, *(t_dbl + 1)); #endif /* SIZEOF_DOUBLE x SIZEOF_LONG_INT */ current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, *t_dbl); + } else if (f == FunctorLongInt) { + Int li = LongIntOfTerm(t); + current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, li); } else { for (j = ArityOfFunctor(f); j >= 1; j--) { STACK_PUSH_UP(*(RepAppl(t) + j), stack_terms); @@ -820,6 +825,11 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) { #endif /* SIZEOF_DOUBLE x SIZEOF_LONG_INT */ current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, *t_dbl, _trie_retry_nothing); current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_float); + } else if (f == FunctorLongInt) { + Int li = LongIntOfTerm (t); + current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_nothing); + current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, li, _trie_retry_nothing); + current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_long); } else { current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_struct); for (j = ArityOfFunctor(f); j >= 1; j--) { @@ -897,6 +907,12 @@ void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) { ans_node = TrNode_parent(ans_node); t = MkFloatTerm(dbl); STACK_PUSH_UP(t, stack_terms); + } else if (f == FunctorLongInt) { + Int li = TrNode_entry(ans_node); + ans_node = TrNode_parent(ans_node); + ans_node = TrNode_parent(ans_node); + t = MkLongIntTerm(li); + STACK_PUSH_UP(t, stack_terms); } else { int f_arity = ArityOfFunctor(f); t = Yap_MkApplTerm(f, f_arity, stack_terms); @@ -1236,18 +1252,18 @@ int traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *ar /* test the node type */ #if SIZEOF_DOUBLE == 2 * SIZEOF_LONG_INT - if (mode == TRAVERSE_FLOAT_INIT) { + if (mode == TRAVERSE_FLOAT) { arity[0]++; arity[arity[0]] = (int) t; - mode = TRAVERSE_FLOAT; - } else if (mode == TRAVERSE_FLOAT) { + mode = TRAVERSE_FLOAT2; + } else if (mode == TRAVERSE_FLOAT2) { volatile Float dbl; volatile Term *t_dbl = (Term *)((void *) &dbl); *t_dbl = t; *(t_dbl + 1) = (Term) arity[arity[0]]; arity[0]--; #else /* SIZEOF_DOUBLE == SIZEOF_LONG_INT */ - if (mode == TRAVERSE_FLOAT_INIT) { + if (mode == TRAVERSE_FLOAT) { Float dbl = (Float) t; #endif /* SIZEOF_DOUBLE x SIZEOF_LONG_INT */ str_index += sprintf(& str[str_index], "%.15g", dbl); @@ -1273,6 +1289,31 @@ int traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *ar } } mode = TRAVERSE_NORMAL; + } else if (mode == TRAVERSE_LONG) { + Int li = (Int) t; + str_index += sprintf(& str[str_index], "%d", li); + while (arity[0]) { + if (arity[arity[0]] > 0) { + arity[arity[0]]--; + if (arity[arity[0]] == 0) { + str_index += sprintf(& str[str_index], ")"); + arity[0]--; + } else { + str_index += sprintf(& str[str_index], ","); + break; + } + } else { + arity[arity[0]]++; + if (arity[arity[0]] == 0) { + str[str_index] = 0; + SHOW_INFO("%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); + return FALSE; + } + str_index += sprintf(& str[str_index], "|"); + break; + } + } + mode = TRAVERSE_NORMAL; } else if (IsVarTerm(t)) { str_index += sprintf(& str[str_index], "VAR%d", VarIndexOfTableTerm(t)); while (arity[0]) { @@ -1364,7 +1405,9 @@ int traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *ar } else if (IsApplTerm(t)) { Functor f = (Functor) RepAppl(t); if (f == FunctorDouble) { - mode = TRAVERSE_FLOAT_INIT; + mode = TRAVERSE_FLOAT; + } else if (f == FunctorLongInt) { + mode = TRAVERSE_LONG; } else { str_index += sprintf(& str[str_index], "%s(", AtomName(NameOfFunctor(f))); arity[0]++; @@ -1457,21 +1500,18 @@ int traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *a } /* test the node type */ - if (mode == TRAVERSE_FLOAT_END) { - mode = TRAVERSE_NORMAL; + if (mode == TRAVERSE_FLOAT) { #if SIZEOF_DOUBLE == 2 * SIZEOF_LONG_INT - } else if (mode == TRAVERSE_FLOAT_INIT) { arity[0]++; arity[arity[0]] = (int) t; - mode = TRAVERSE_FLOAT; - } else if (mode == TRAVERSE_FLOAT) { + mode = TRAVERSE_FLOAT2; + } else if (mode == TRAVERSE_FLOAT2) { volatile Float dbl; volatile Term *t_dbl = (Term *)((void *) &dbl); *t_dbl = t; *(t_dbl + 1) = (Term) arity[arity[0]]; arity[0]--; #else /* SIZEOF_DOUBLE == SIZEOF_LONG_INT */ - } else if (mode == TRAVERSE_FLOAT_INIT) { Float dbl = (Float) t; #endif /* SIZEOF_DOUBLE x SIZEOF_LONG_INT */ str_index += sprintf(& str[str_index], "%.15g", dbl); @@ -1497,6 +1537,35 @@ int traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *a } } mode = TRAVERSE_FLOAT_END; + } else if (mode == TRAVERSE_FLOAT_END) { + mode = TRAVERSE_NORMAL; + } else if (mode == TRAVERSE_LONG) { + Int li = (Int) t; + str_index += sprintf(& str[str_index], "%d", li); + while (arity[0]) { + if (arity[arity[0]] > 0) { + arity[arity[0]]--; + if (arity[arity[0]] == 0) { + str_index += sprintf(& str[str_index], ")"); + arity[0]--; + } else { + str_index += sprintf(& str[str_index], ","); + break; + } + } else { + arity[arity[0]]++; + if (arity[arity[0]] == 0) { + str[str_index] = 0; + SHOW_INFO("%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); + return FALSE; + } + str_index += sprintf(& str[str_index], "|"); + break; + } + } + mode = TRAVERSE_LONG_END; + } else if (mode == TRAVERSE_LONG_END) { + mode = TRAVERSE_NORMAL; } else if (IsVarTerm(t)) { str_index += sprintf(& str[str_index], "ANSVAR%d", VarIndexOfTableTerm(t)); while (arity[0]) { @@ -1588,7 +1657,9 @@ int traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *a } else if (IsApplTerm(t)) { Functor f = (Functor) RepAppl(t); if (f == FunctorDouble) { - mode = TRAVERSE_FLOAT_INIT; + mode = TRAVERSE_FLOAT; + } else if (f == FunctorLongInt) { + mode = TRAVERSE_LONG; } else { str_index += sprintf(& str[str_index], "%s(", AtomName(NameOfFunctor(f))); arity[0]++; diff --git a/OPTYap/tab.tries.insts.i b/OPTYap/tab.tries.insts.i index 410c5fc31..70227cf2d 100644 --- a/OPTYap/tab.tries.insts.i +++ b/OPTYap/tab.tries.insts.i @@ -5,7 +5,7 @@ Copyright: R. Rocha and NCC - University of Porto, Portugal File: tab.tries.insts.i - version: $Id: tab.tries.insts.i,v 1.8 2005-06-03 18:28:11 ricroc Exp $ + version: $Id: tab.tries.insts.i,v 1.9 2005-06-04 07:28:24 ricroc Exp $ **********************************************************************/ @@ -467,11 +467,11 @@ -/* -------------------- ** -** trie_float ** -** -------------------- */ +/* ---------------------------------------- ** +** trie_extension (float/longint) ** +** ---------------------------------------- */ -#define no_cp_trie_float_instr() \ +#define no_cp_trie_extension_instr() \ if (heap_arity) { \ aux_ptr++; \ YENV = ++aux_ptr; \ @@ -912,7 +912,7 @@ heap_arity -= 2; #endif /* SIZEOF_DOUBLE x SIZEOF_LONG_INT */ t = MkFloatTerm(dbl); - no_cp_trie_float_instr(); + no_cp_trie_extension_instr(); ENDPBOp(); @@ -929,3 +929,31 @@ PBOp(trie_trust_float, e) Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_float)"); ENDPBOp(); + + + PBOp(trie_do_long, e) + 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; + Term t = MkLongIntTerm(*++aux_ptr); + heap_arity -= 2; + no_cp_trie_extension_instr(); + ENDPBOp(); + + + PBOp(trie_try_long, e) + Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_long)"); + ENDPBOp(); + + + PBOp(trie_retry_long, e) + Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_long)"); + ENDPBOp(); + + + PBOp(trie_trust_long, e) + Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_long)"); + ENDPBOp();