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

long int support for tabling

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1327 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
ricroc 2005-06-04 07:28:24 +00:00
parent c665fa8c11
commit 3d8c03f3c9
8 changed files with 166 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
C/absmi.c
View File

@ -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:

7
C/cdmgr.c
View File

@ -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:

4
C/heapgc.c
View File

@ -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;

13
C/index.c
View File

@ -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;

9
H/YapOpcodes.h
View File

@ -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),

9
H/rclause.h
View File

@ -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:

101
OPTYap/tab.tries.c
View File

@ -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 $
**********************************************************************/
@ -30,9 +30,11 @@
** ----------------- */
#define TRAVERSE_NORMAL 0
#define TRAVERSE_FLOAT_INIT 1
#define TRAVERSE_FLOAT 2
#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]++;

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

@ -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();