From: Terrance S. <ts...@us...> - 2006-05-22 20:47:55
|
Update of /cvsroot/xsb/XSB/emu In directory sc8-pr-cvs10.sourceforge.net:/tmp/cvs-serv9123 Modified Files: builtin.c builtin.h schedrev_xsb_i.h std_pred_xsb_i.h Log Message: Prolog code for unify_with_occur_check In addition, fixed bug in batched evaluation that I believe is of long standing. In the batched fixed point, a subgoal S may be checked for fixed point even if it has been completed and its answer return lists have been reclaimed. This doesn't usually happen but can if S is the leader of the ASCC. In such a case, the fixed point check traverses each consumer choice point for S and determines whether all answers have been returned to the choice point. However, if the answer return list for S has been reclaimed and its space reused, the fixpoint check may mistakenly think that an answer has not been returned to the choice point -- a dangerous situation. The fix is simple -- a check for reclamation of the subgoal. The check will also be made for local evaluation, even though it won't be needed there. Index: builtin.c =================================================================== RCS file: /cvsroot/xsb/XSB/emu/builtin.c,v retrieving revision 1.262 retrieving revision 1.263 diff -u -r1.262 -r1.263 --- builtin.c 27 Apr 2006 21:08:47 -0000 1.262 +++ builtin.c 22 May 2006 20:47:45 -0000 1.263 @@ -864,8 +864,9 @@ set_builtin_table(RECLAIM_UNINTERNED_NR, "reclaim_uninterned_nr"); set_builtin_table(GLOBALVAR, "globalvar"); - set_builtin_table(SET_TABLED_EVAL, "set_tabled_eval_method"); + set_builtin_table(UNIFY_WITH_OCCURS_CHECK, "unify_with_occurs_check"); + set_builtin_table(PUT_ATTRIBUTES, "put_attributes"); set_builtin_table(GET_ATTRIBUTES, "get_attributes"); set_builtin_table(DELETE_ATTRIBUTES, "delete_attributes"); @@ -2355,6 +2356,9 @@ return TRUE; } + case UNIFY_WITH_OCCURS_CHECK: + return unify_with_occurs_check(CTXTc cell(reg+1),cell(reg+2)); + case XSB_PROFILE: { if (xsb_profiling_enabled) { Index: builtin.h =================================================================== RCS file: /cvsroot/xsb/XSB/emu/builtin.h,v retrieving revision 1.72 retrieving revision 1.73 diff -u -r1.72 -r1.73 --- builtin.h 27 Apr 2006 01:05:26 -0000 1.72 +++ builtin.h 22 May 2006 20:47:45 -0000 1.73 @@ -188,6 +188,7 @@ #define SET_TABLED_EVAL 170 +#define UNIFY_WITH_OCCURS_CHECK 171 #define PUT_ATTRIBUTES 172 #define GET_ATTRIBUTES 173 #define DELETE_ATTRIBUTES 174 Index: schedrev_xsb_i.h =================================================================== RCS file: /cvsroot/xsb/XSB/emu/schedrev_xsb_i.h,v retrieving revision 1.17 retrieving revision 1.18 diff -u -r1.17 -r1.18 --- schedrev_xsb_i.h 10 Nov 2005 23:05:55 -0000 1.17 +++ schedrev_xsb_i.h 22 May 2006 20:47:45 -0000 1.18 @@ -60,7 +60,8 @@ consumer_cpf = subg_asf_list_ptr(producer_sf); /**** The producer has answers and consuming calls ****/ - if ( has_answers(producer_sf) && IsNonNULL(consumer_cpf) ) { + if ( has_answers(producer_sf) && IsNonNULL(consumer_cpf) + && !subg_is_reclaimed(producer_sf)) { /**** Check each consumer for unresolved answers ****/ if ( IsSubsumptiveProducer(producer_sf) ) while ( IsNonNULL(consumer_cpf) ) { Index: std_pred_xsb_i.h =================================================================== RCS file: /cvsroot/xsb/XSB/emu/std_pred_xsb_i.h,v retrieving revision 1.30 retrieving revision 1.31 diff -u -r1.30 -r1.31 --- std_pred_xsb_i.h 16 Nov 2005 17:32:05 -0000 1.30 +++ std_pred_xsb_i.h 22 May 2006 20:47:45 -0000 1.31 @@ -879,3 +879,91 @@ return unify(CTXTc list, term); } +/* Assumes that first arg is a derefed var */ +static inline xsbBool not_occurs_in(Cell Var, Cell Term) { + XSB_Deref(Term); + + switch (cell_tag(Term)) { + case XSB_ATTV: + case XSB_REF: + case XSB_REF1: { + if (Var == Term) return FALSE; else return TRUE; + } + case XSB_INT: + case XSB_STRING: + case XSB_FLOAT: { + return TRUE; + } + case XSB_LIST: { + return (not_occurs_in(Var,Term +1) + & not_occurs_in(Var, Term + 2)); + } + case XSB_STRUCT: { + xsbBool Res = TRUE; + int i; + CPtr arg; + + for (i = 1; i <= get_arity(get_str_psc(Term)); i++) { + arg = clref_val(Term) + i; + // printf("Ref before %d\n",Res); + Res = Res & not_occurs_in(Var,(Cell) (clref_val(Term) +i)); + // printf("Ref after %d\n",Res); + } + return Res; + } + } + return TRUE; /* hush, little compiler */ +} + +xsbBool unify_with_occurs_check(CTXTdeclc Cell Term1, Cell Term2) { + // printf(" Term2 %x, cs_val %x\n",Term2,cs_val(Term2)); + xsbBool Res = TRUE; + + XSB_Deref(Term1); + switch (cell_tag(Term1)) { + case XSB_ATTV: + case XSB_REF: + case XSB_REF1: + if (not_occurs_in(Term1,Term2)) + return unify(CTXTc Term1,Term2); + else return FALSE; + case XSB_INT: + case XSB_STRING: + case XSB_FLOAT: + return unify(CTXTc Term1,Term2); + case XSB_LIST: + case XSB_STRUCT: { + +/**********/ + XSB_Deref(Term2); + switch (cell_tag(Term2)) { + case XSB_ATTV: + case XSB_REF: + case XSB_REF1: + if (not_occurs_in(Term2,Term1)) + return unify(CTXTc Term1,Term2); + else return FALSE; + case XSB_LIST: + case XSB_STRUCT: { + int i; + int arity = get_arity(get_str_psc(Term1)); + if (arity == get_arity(get_str_psc(Term2))) { + for (i = 1; i <= arity; i++) { + // printf(" struct Res before %d\n",Res); + Res = Res & unify_with_occurs_check(CTXTc (Cell) (clref_val(Term1) + i), + (Cell) (clref_val(Term2) + i)); + // printf(" struct Res after %d\n",Res); + } + return Res; + } + else return FALSE; + } + } + +/**********/ + + } + } + return TRUE; /* hush, little compiler */ +} + |