From 9083dc56338297069c3cd24622693ee03cc05e1c Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sat, 6 Mar 2010 22:34:49 +0000 Subject: [PATCH 01/37] new functor for attributed variables. --- H/TermExt.h | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/H/TermExt.h b/H/TermExt.h index 0891088f9..184843b00 100644 --- a/H/TermExt.h +++ b/H/TermExt.h @@ -44,13 +44,15 @@ typedef enum { db_ref_e = sizeof (Functor *), - long_int_e = 2 * sizeof (Functor *), - big_int_e = 3 * sizeof (Functor *), - double_e = 4 * sizeof (Functor *) + attvar_e = 2*sizeof (Functor *), + long_int_e = 3 * sizeof (Functor *), + big_int_e = 4 * sizeof (Functor *), + double_e = 5 * sizeof (Functor *) } blob_type; #define FunctorDBRef ((Functor)(db_ref_e)) +#define FunctorAttVar ((Functor)(attvar_e)) #define FunctorLongInt ((Functor)(long_int_e)) #define FunctorBigInt ((Functor)(big_int_e)) #define FunctorDouble ((Functor)(double_e)) From ba091eb2f9e4dc059ac58911137941d537ab6dec Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sat, 6 Mar 2010 22:43:21 +0000 Subject: [PATCH 02/37] support db_ref_e: --- C/arith1.c | 30 +++++++++++----------- C/arith2.c | 72 ++++++++++++++++++++++++++--------------------------- H/TermExt.h | 2 ++ H/arith2.h | 54 ++++++++++++++++++++-------------------- 4 files changed, 80 insertions(+), 78 deletions(-) diff --git a/C/arith1.c b/C/arith1.c index f495bb632..683f6b620 100644 --- a/C/arith1.c +++ b/C/arith1.c @@ -240,7 +240,7 @@ eval1(Int fi, Term t) { RBIG(&new); } #endif - case db_ref_e: + default: RERROR(); } case op_unot: @@ -259,7 +259,7 @@ eval1(Int fi, Term t) { RBIG(&new); } #endif - case db_ref_e: + default: RERROR(); } case op_exp: @@ -480,7 +480,7 @@ eval1(Int fi, Term t) { } break; #endif - case db_ref_e: + default: RERROR(); } #if HAVE_ISNAN @@ -518,7 +518,7 @@ eval1(Int fi, Term t) { } break; #endif - case db_ref_e: + default: RERROR(); } #if HAVE_ISNAN @@ -555,7 +555,7 @@ eval1(Int fi, Term t) { } return t; break; - case db_ref_e: + default: #endif RERROR(); } @@ -591,7 +591,7 @@ eval1(Int fi, Term t) { return Yap_ArithError(TYPE_ERROR_FLOAT, t, "X is round(BIGNUM)"); } return t; - case db_ref_e: + default: #endif RERROR(); } @@ -629,7 +629,7 @@ eval1(Int fi, Term t) { #ifdef USE_GMP RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t))); #endif - case db_ref_e: + default: RERROR(); } case op_abs: @@ -648,7 +648,7 @@ eval1(Int fi, Term t) { RBIG(&new); } #endif - case db_ref_e: + default: RERROR(); } case op_msb: @@ -667,7 +667,7 @@ eval1(Int fi, Term t) { RINT(mpz_sizeinbase(big,2)); } #endif - case db_ref_e: + default: RERROR(); } case op_lsb: @@ -686,7 +686,7 @@ eval1(Int fi, Term t) { RINT(mpz_scan1(big,0)); } #endif - case db_ref_e: + default: RERROR(); } case op_popcount: @@ -705,7 +705,7 @@ eval1(Int fi, Term t) { RINT(mpz_popcount(big)); } #endif - case db_ref_e: + default: RERROR(); } case op_ffracp: @@ -731,7 +731,7 @@ eval1(Int fi, Term t) { RFLOAT(0.0); } #endif - case db_ref_e: + default: RERROR(); } case op_fintp: @@ -753,7 +753,7 @@ eval1(Int fi, Term t) { RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t))); } #endif - case db_ref_e: + default: RERROR(); } case op_sign: @@ -775,7 +775,7 @@ eval1(Int fi, Term t) { #ifdef USE_GMP RINT(mpz_sgn(Yap_BigIntOfTerm(t))); #endif - case db_ref_e: + default: RERROR(); } case op_random1: @@ -788,7 +788,7 @@ eval1(Int fi, Term t) { #ifdef USE_GMP return Yap_ArithError(TYPE_ERROR_INTEGER, t, "random(%f)", FloatOfTerm(t)); #endif - case db_ref_e: + default: RERROR(); } } diff --git a/C/arith2.c b/C/arith2.c index 250cb5ed6..c3bb0f80c 100644 --- a/C/arith2.c +++ b/C/arith2.c @@ -93,7 +93,7 @@ p_mod(Term t1, Term t2) { #ifdef USE_GMP return Yap_gmp_mod_int_big(IntegerOfTerm(t1), Yap_BigIntOfTerm(t2)); #endif - case db_ref_e: + default: RERROR(); break; } @@ -115,11 +115,11 @@ p_mod(Term t1, Term t2) { return Yap_gmp_mod_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2)); case double_e: return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } zero_divisor: @@ -157,7 +157,7 @@ p_rem(Term t1, Term t2) { /* I know the term is much larger, so: */ RINT(IntegerOfTerm(t1)); #endif - case db_ref_e: + default: RERROR(); } break; @@ -191,11 +191,11 @@ p_rem(Term t1, Term t2) { } case double_e: return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "mod/2"); - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } zero_divisor: @@ -234,7 +234,7 @@ p_fdiv(Term t1, Term t2) RFLOAT(((Float)i1/f2)); } #endif - case db_ref_e: + default: RERROR(); } break; @@ -257,7 +257,7 @@ p_fdiv(Term t1, Term t2) RFLOAT(FloatOfTerm(t1)/mpz_get_d(Yap_BigIntOfTerm(t2))); } #endif - case db_ref_e: + default: RERROR(); } break; @@ -278,11 +278,11 @@ p_fdiv(Term t1, Term t2) Float dbl = FloatOfTerm(t2); RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t1))/dbl); } - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } RERROR(); @@ -334,7 +334,7 @@ p_xor(Term t1, Term t2) RBIG(&new); } #endif - case db_ref_e: + default: RERROR(); } break; @@ -362,11 +362,11 @@ p_xor(Term t1, Term t2) } case double_e: return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "#/2"); - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } RERROR(); @@ -394,7 +394,7 @@ p_atan2(Term t1, Term t2) RFLOAT(atan2(i1,f2)); } #endif - case db_ref_e: + default: RERROR(); break; } @@ -417,7 +417,7 @@ p_atan2(Term t1, Term t2) RFLOAT(atan2(FloatOfTerm(t1),mpz_get_d(Yap_BigIntOfTerm(t2)))); } #endif - case db_ref_e: + default: RERROR(); } break; @@ -437,11 +437,11 @@ p_atan2(Term t1, Term t2) Float dbl = FloatOfTerm(t2); RFLOAT(atan2(mpz_get_d(Yap_BigIntOfTerm(t1)),dbl)); } - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } RERROR(); @@ -479,7 +479,7 @@ p_power(Term t1, Term t2) RFLOAT(pow(i1,f2)); } #endif - case db_ref_e: + default: RERROR(); } break; @@ -502,7 +502,7 @@ p_power(Term t1, Term t2) RFLOAT(pow(FloatOfTerm(t1),mpz_get_d(Yap_BigIntOfTerm(t2)))); } #endif - case db_ref_e: + default: RERROR(); } break; @@ -522,11 +522,11 @@ p_power(Term t1, Term t2) Float dbl = FloatOfTerm(t2); RFLOAT(pow(mpz_get_d(Yap_BigIntOfTerm(t1)),dbl)); } - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } RERROR(); @@ -605,7 +605,7 @@ p_exp(Term t1, Term t2) return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "^/2"); } #endif - case db_ref_e: + default: RERROR(); } break; @@ -628,7 +628,7 @@ p_exp(Term t1, Term t2) return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "^/2"); } #endif - case db_ref_e: + default: RERROR(); } break; @@ -649,11 +649,11 @@ p_exp(Term t1, Term t2) Float dbl = FloatOfTerm(t2); RFLOAT(pow(mpz_get_d(Yap_BigIntOfTerm(t1)),dbl)); } - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } RERROR(); @@ -741,7 +741,7 @@ p_gcd(Term t1, Term t2) } } #endif - case db_ref_e: + default: RERROR(); } break; @@ -774,11 +774,11 @@ p_gcd(Term t1, Term t2) } case double_e: return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "gcd/2"); - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } RERROR(); @@ -821,7 +821,7 @@ p_min(Term t1, Term t2) return t1; } #endif - case db_ref_e: + default: RERROR(); } break; @@ -858,7 +858,7 @@ p_min(Term t1, Term t2) } } #endif - case db_ref_e: + default: RERROR(); } break; @@ -897,11 +897,11 @@ p_min(Term t1, Term t2) return t1; } } - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } RERROR(); @@ -944,7 +944,7 @@ p_max(Term t1, Term t2) return t1; } #endif - case db_ref_e: + default: RERROR(); } break; @@ -981,7 +981,7 @@ p_max(Term t1, Term t2) } } #endif - case db_ref_e: + default: RERROR(); } break; @@ -1020,11 +1020,11 @@ p_max(Term t1, Term t2) return t1; } } - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } RERROR(); diff --git a/H/TermExt.h b/H/TermExt.h index 184843b00..b893ac534 100644 --- a/H/TermExt.h +++ b/H/TermExt.h @@ -518,6 +518,8 @@ unify_extension (Functor f, CELL d0, CELL * pt0, CELL d1) { case db_ref_e: return (d0 == d1); + case attvar_e: + return (d0 == d1); case long_int_e: return (pt0[1] == RepAppl (d1)[1]); case big_int_e: diff --git a/H/arith2.h b/H/arith2.h index f4988dc03..bfc6cac22 100644 --- a/H/arith2.h +++ b/H/arith2.h @@ -158,7 +158,7 @@ p_plus(Term t1, Term t2) { #ifdef USE_GMP return(Yap_gmp_add_int_big(IntegerOfTerm(t1), Yap_BigIntOfTerm(t2))); #endif - case db_ref_e: + default: RERROR(); } case double_e: @@ -172,7 +172,7 @@ p_plus(Term t1, Term t2) { #ifdef USE_GMP return(Yap_gmp_add_float_big(FloatOfTerm(t1),Yap_BigIntOfTerm(t2))); #endif - case db_ref_e: + default: RERROR(); } case big_int_e: @@ -185,11 +185,11 @@ p_plus(Term t1, Term t2) { return(Yap_gmp_add_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2))); case double_e: return(Yap_gmp_add_float_big(FloatOfTerm(t2),Yap_BigIntOfTerm(t1))); - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } RERROR(); @@ -214,7 +214,7 @@ p_minus(Term t1, Term t2) { #ifdef USE_GMP return(Yap_gmp_sub_int_big(IntegerOfTerm(t1), Yap_BigIntOfTerm(t2))); #endif - case db_ref_e: + default: RERROR(); } break; @@ -231,7 +231,7 @@ p_minus(Term t1, Term t2) { #ifdef USE_GMP return(Yap_gmp_sub_float_big(FloatOfTerm(t1),Yap_BigIntOfTerm(t2))); #endif - case db_ref_e: + default: RERROR(); } break; @@ -244,11 +244,11 @@ p_minus(Term t1, Term t2) { return(Yap_gmp_sub_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2))); case double_e: return(Yap_gmp_sub_big_float(Yap_BigIntOfTerm(t1),FloatOfTerm(t2))); - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } RERROR(); @@ -274,7 +274,7 @@ p_times(Term t1, Term t2) { #ifdef USE_GMP return(Yap_gmp_mul_int_big(IntegerOfTerm(t1), Yap_BigIntOfTerm(t2))); #endif - case db_ref_e: + default: RERROR(); } break; @@ -289,7 +289,7 @@ p_times(Term t1, Term t2) { #ifdef USE_GMP return(Yap_gmp_mul_float_big(FloatOfTerm(t1),Yap_BigIntOfTerm(t2))); #endif - case db_ref_e: + default: RERROR(); } break; @@ -303,11 +303,11 @@ p_times(Term t1, Term t2) { return(Yap_gmp_mul_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2))); case double_e: return(Yap_gmp_mul_float_big(FloatOfTerm(t2),Yap_BigIntOfTerm(t1))); - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } RERROR(); @@ -343,7 +343,7 @@ p_div(Term t1, Term t2) { /* Cool */ RINT(0); #endif - case db_ref_e: + default: RERROR(); } break; @@ -360,11 +360,11 @@ p_div(Term t1, Term t2) { return Yap_gmp_div_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2)); case double_e: return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "// /2"); - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } RERROR(); @@ -384,7 +384,7 @@ p_and(Term t1, Term t2) { #ifdef USE_GMP return(Yap_gmp_and_int_big(IntegerOfTerm(t1),Yap_BigIntOfTerm(t2))); #endif - case db_ref_e: + default: RERROR(); } break; @@ -401,11 +401,11 @@ p_and(Term t1, Term t2) { return(Yap_gmp_and_big_big(Yap_BigIntOfTerm(t2), Yap_BigIntOfTerm(t1))); case double_e: return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "/\\ /2"); - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } RERROR(); @@ -425,7 +425,7 @@ p_or(Term t1, Term t2) { #ifdef USE_GMP return(Yap_gmp_ior_int_big(IntegerOfTerm(t1),Yap_BigIntOfTerm(t2))); #endif - case db_ref_e: + default: RERROR(); } break; @@ -442,11 +442,11 @@ p_or(Term t1, Term t2) { return Yap_gmp_ior_big_big(Yap_BigIntOfTerm(t2), Yap_BigIntOfTerm(t1)); case double_e: return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "\\/ /2"); - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } RERROR(); @@ -473,7 +473,7 @@ p_sll(Term t1, Term t2) { #ifdef USE_GMP return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "<>/2"); case double_e: return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "<>/2"); #endif - case db_ref_e: + default: RERROR(); } break; @@ -534,11 +534,11 @@ p_slr(Term t1, Term t2) { return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2"); case double_e: return Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2"); - case db_ref_e: + default: RERROR(); } #endif - case db_ref_e: + default: RERROR(); } RERROR(); From 81635b48fb8ad4ca9a8192438e7ef31eee9811b8 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 8 Mar 2010 09:17:40 +0000 Subject: [PATCH 03/37] use isattvar --- C/absmi.c | 216 +++++++++++++++++++++++++++--------------------------- 1 file changed, 108 insertions(+), 108 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index d7e738b9d..7a64650d6 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -2039,7 +2039,7 @@ Yap_absmi(int inp) goto failloop; } else #endif /* FROZEN_STACKS */ - if (IN_BETWEEN(Yap_GlobalBase, pt1, H0)) + if (IsAttVar(pt1)) goto failloop; flags = *pt1; #if defined(YAPOR) || defined(THREADS) @@ -3278,7 +3278,7 @@ Yap_absmi(int inp) BIND_AND_JUMP(pt0, d0); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); #endif GONext(); @@ -3299,7 +3299,7 @@ Yap_absmi(int inp) BIND(pt0, d1, bind_gvalx_var_nonvar); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_gvalx_var_nonvar: #endif GONext(); @@ -3311,14 +3311,14 @@ Yap_absmi(int inp) UnifyCells(pt0, pt1, uc1, uc2); #ifdef COROUTINING DO_TRAIL(pt0, (CELL)pt1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); uc1: #endif GONext(); #ifdef COROUTINING uc2: DO_TRAIL(pt1, (CELL)pt0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); GONext(); #endif ENDP(pt1); @@ -3360,7 +3360,7 @@ Yap_absmi(int inp) BIND(pt1, d0, bind_gvaly_nonvar_var); #ifdef COROUTINING DO_TRAIL(pt1, d0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); bind_gvaly_nonvar_var: #endif GONext(); @@ -3379,7 +3379,7 @@ Yap_absmi(int inp) BIND(pt0, d1, bind_gvaly_var_nonvar); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_gvaly_var_nonvar: #endif GONext(); @@ -3391,14 +3391,14 @@ Yap_absmi(int inp) UnifyCells(pt0, pt1, uc3, uc4); #ifdef COROUTINING DO_TRAIL(pt0, (CELL)pt1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); uc3: #endif GONext(); #ifdef COROUTINING uc4: DO_TRAIL(pt1, (CELL)pt0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); GONext(); #endif ENDP(pt1); @@ -3432,7 +3432,7 @@ Yap_absmi(int inp) BIND(pt0, d1, bind_gatom); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_gatom: #endif GONext(); @@ -3463,7 +3463,7 @@ Yap_absmi(int inp) BIND(pt0, PREG->u.cc.c1, gatom_2b); #ifdef COROUTINING DO_TRAIL(pt0, PREG->u.cc.c1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); #endif ENDP(pt0); gatom_2b: @@ -3489,7 +3489,7 @@ Yap_absmi(int inp) BIND(pt0, d1, gatom_2c); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); gatom_2c: #endif GONext(); @@ -3520,7 +3520,7 @@ Yap_absmi(int inp) BIND(pt0, PREG->u.ccc.c1, gatom_3b); #ifdef COROUTINING DO_TRAIL(pt0, PREG->u.ccc.c1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); #endif ENDP(pt0); gatom_3b: @@ -3543,7 +3543,7 @@ Yap_absmi(int inp) BIND(pt0, PREG->u.ccc.c2, gatom_3c); #ifdef COROUTINING DO_TRAIL(pt0, PREG->u.ccc.c2); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); #endif ENDP(pt0); gatom_3c: @@ -3569,7 +3569,7 @@ Yap_absmi(int inp) BIND(pt0, d1, gatom_3d); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); gatom_3d: #endif GONext(); @@ -3600,7 +3600,7 @@ Yap_absmi(int inp) BIND(pt0, PREG->u.cccc.c1, gatom_4b); #ifdef COROUTINING DO_TRAIL(pt0, PREG->u.cccc.c1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); #endif ENDP(pt0); gatom_4b: @@ -3623,7 +3623,7 @@ Yap_absmi(int inp) BIND(pt0, PREG->u.cccc.c2, gatom_4c); #ifdef COROUTINING DO_TRAIL(pt0, PREG->u.cccc.c2); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); #endif ENDP(pt0); gatom_4c: @@ -3646,7 +3646,7 @@ Yap_absmi(int inp) BIND(pt0, PREG->u.cccc.c3, gatom_4d); #ifdef COROUTINING DO_TRAIL(pt0, PREG->u.cccc.c3); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); #endif ENDP(pt0); gatom_4d: @@ -3672,7 +3672,7 @@ Yap_absmi(int inp) BIND(pt0, d1, gatom_4e); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); gatom_4e: #endif GONext(); @@ -3703,7 +3703,7 @@ Yap_absmi(int inp) BIND(pt0, PREG->u.ccccc.c1, gatom_5b); #ifdef COROUTINING DO_TRAIL(pt0, PREG->u.ccccc.c1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); #endif ENDP(pt0); gatom_5b: @@ -3726,7 +3726,7 @@ Yap_absmi(int inp) BIND(pt0, PREG->u.ccccc.c2, gatom_5c); #ifdef COROUTINING DO_TRAIL(pt0, PREG->u.ccccc.c2); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); #endif ENDP(pt0); gatom_5c: @@ -3749,7 +3749,7 @@ Yap_absmi(int inp) BIND(pt0, PREG->u.ccccc.c3, gatom_5d); #ifdef COROUTINING DO_TRAIL(pt0, PREG->u.ccccc.c3); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); #endif ENDP(pt0); gatom_5d: @@ -3772,7 +3772,7 @@ Yap_absmi(int inp) BIND(pt0, PREG->u.ccccc.c4, gatom_5e); #ifdef COROUTINING DO_TRAIL(pt0, PREG->u.ccccc.c4); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); #endif ENDP(pt0); gatom_5e: @@ -3798,7 +3798,7 @@ Yap_absmi(int inp) BIND(pt0, d1, gatom_5f); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); gatom_5f: #endif GONext(); @@ -3829,7 +3829,7 @@ Yap_absmi(int inp) BIND(pt0, PREG->u.cccccc.c1, gatom_6b); #ifdef COROUTINING DO_TRAIL(pt0, PREG->u.cccccc.c1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); #endif ENDP(pt0); gatom_6b: @@ -3852,7 +3852,7 @@ Yap_absmi(int inp) BIND(pt0, PREG->u.cccccc.c2, gatom_6c); #ifdef COROUTINING DO_TRAIL(pt0, PREG->u.cccccc.c2); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); #endif ENDP(pt0); gatom_6c: @@ -3875,7 +3875,7 @@ Yap_absmi(int inp) BIND(pt0, PREG->u.cccccc.c3, gatom_6d); #ifdef COROUTINING DO_TRAIL(pt0, PREG->u.cccccc.c3); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); #endif ENDP(pt0); gatom_6d: @@ -3898,7 +3898,7 @@ Yap_absmi(int inp) BIND(pt0, PREG->u.cccccc.c4, gatom_6e); #ifdef COROUTINING DO_TRAIL(pt0, PREG->u.cccccc.c4); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); #endif ENDP(pt0); gatom_6e: @@ -3921,7 +3921,7 @@ Yap_absmi(int inp) BIND(pt0, PREG->u.cccccc.c5, gatom_6f); #ifdef COROUTINING DO_TRAIL(pt0, PREG->u.cccccc.c5); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); #endif ENDP(pt0); gatom_6f: @@ -3947,7 +3947,7 @@ Yap_absmi(int inp) BIND(pt0, d1, gatom_6g); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); gatom_6g: #endif GONext(); @@ -3989,7 +3989,7 @@ Yap_absmi(int inp) BIND(pt0, d0, bind_glist); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) { + if (IsAttVar(pt0)) { Yap_WakeUp(pt0); S_SREG = H; } @@ -4043,7 +4043,7 @@ Yap_absmi(int inp) BIND(pt0, d1, bind_gstruct); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) { + if (IsAttVar(pt0)) { Yap_WakeUp(pt0); } bind_gstruct: @@ -4109,7 +4109,7 @@ Yap_absmi(int inp) BIND(pt0, d1, bind_gfloat); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_gfloat: #endif GONext(); @@ -4154,7 +4154,7 @@ Yap_absmi(int inp) BIND(pt0, d1, bind_glongint); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_glongint: #endif GONext(); @@ -4202,7 +4202,7 @@ Yap_absmi(int inp) BIND(pt0, d1, bind_gbigint); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_gbigint: #endif GONext(); @@ -4241,7 +4241,7 @@ Yap_absmi(int inp) BIND(pt0, d1, bind_gdbterm); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_gdbterm: #endif GONext(); @@ -4293,7 +4293,7 @@ Yap_absmi(int inp) BIND(pt1, d0, bind_glist_valx_nonvar_var); #ifdef COROUTINING DO_TRAIL(pt1, d0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); bind_glist_valx_nonvar_var: #endif GONext(); @@ -4314,7 +4314,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d0, bind_glist_valx_var_nonvar); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_glist_valx_var_nonvar: #endif GONext(); @@ -4326,14 +4326,14 @@ Yap_absmi(int inp) UnifyGlobalRegCells(pt0, pt1, uc5, uc6); #ifdef COROUTINING DO_TRAIL(pt0, (CELL)pt1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); uc5: #endif GONext(); #ifdef COROUTINING uc6: DO_TRAIL(pt1, (CELL)pt0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); GONext(); #endif ENDP(pt1); @@ -4366,7 +4366,7 @@ Yap_absmi(int inp) #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); dbind: #endif ALWAYS_GONextW(); @@ -4415,7 +4415,7 @@ Yap_absmi(int inp) BIND(pt1, d0, bind_glist_valy_nonvar_var); #ifdef COROUTINING DO_TRAIL(pt1, d0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); bind_glist_valy_nonvar_var: #endif GONext(); @@ -4436,7 +4436,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_glist_valy_var_nonvar); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_glist_valy_var_nonvar: #endif GONext(); @@ -4447,14 +4447,14 @@ Yap_absmi(int inp) UnifyGlobalRegCells(pt0, pt1, uc7, uc8); #ifdef COROUTINING DO_TRAIL(pt0, (CELL)pt1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); uc7: #endif GONext(); #ifdef COROUTINING uc8: DO_TRAIL(pt1, (CELL)pt0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); GONext(); #endif ENDP(pt1); @@ -4473,7 +4473,7 @@ Yap_absmi(int inp) BIND(pt0, d0, bind_glist_valy_write); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) { + if (IsAttVar(pt0)) { Yap_WakeUp(pt0); pt1 = H; } @@ -4530,7 +4530,7 @@ Yap_absmi(int inp) BIND(pt0, d0, bind_glist_varx_write); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_glist_varx_write: #endif PREG = NEXTOP(PREG, xx); @@ -4581,7 +4581,7 @@ Yap_absmi(int inp) BIND(pt0, d0, bind_glist_void_vary_write); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_glist_void_vary_write: #endif GONext(); @@ -4626,7 +4626,7 @@ Yap_absmi(int inp) BIND(pt1, d0, bind_glist_void_valx_nonvar_var); #ifdef COROUTINING DO_TRAIL(pt1, d0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); bind_glist_void_valx_nonvar_var: #endif GONext(); @@ -4646,7 +4646,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_glist_void_valx_var_nonvar); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_glist_void_valx_var_nonvar: #endif GONext(); @@ -4658,14 +4658,14 @@ Yap_absmi(int inp) UnifyGlobalRegCells(pt0, pt1, uc9, uc10); #ifdef COROUTINING DO_TRAIL(pt0, (CELL)pt1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); uc9: #endif GONext(); #ifdef COROUTINING uc10: DO_TRAIL(pt1, (CELL)pt0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); GONext(); #endif ENDP(pt1); @@ -4681,7 +4681,7 @@ Yap_absmi(int inp) BIND(pt0, d0, bind_glist_void_valx_write); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) { + if (IsAttVar(pt0)) { Yap_WakeUp(pt0); pt1 = H; } @@ -4738,7 +4738,7 @@ Yap_absmi(int inp) BIND(pt1, d0, bind_glist_void_valy_nonvar_var); #ifdef COROUTINING DO_TRAIL(pt1, d0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); bind_glist_void_valy_nonvar_var: #endif GONext(); @@ -4759,7 +4759,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_glist_void_valy_var_nonvar); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_glist_void_valy_var_nonvar: #endif GONext(); @@ -4770,14 +4770,14 @@ Yap_absmi(int inp) UnifyGlobalRegCells(pt0, pt1, uc11, uc12); #ifdef COROUTINING DO_TRAIL(pt0, (CELL)pt1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); uc11: #endif GONext(); #ifdef COROUTINING uc12: DO_TRAIL(pt1, (CELL)pt0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); GONext(); #endif ENDP(pt1); @@ -4793,7 +4793,7 @@ Yap_absmi(int inp) BIND(pt0, d0, bind_glist_void_valy_write); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) { + if (IsAttVar(pt0)) { Yap_WakeUp(pt0); S_SREG = H; } @@ -5087,7 +5087,7 @@ Yap_absmi(int inp) BIND(pt1, d0, bind_uvalx_nonvar_var); #ifdef COROUTINING DO_TRAIL(pt1, d0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); bind_uvalx_nonvar_var: #endif GONext(); @@ -5106,7 +5106,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_uvalx_var_nonvar); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_uvalx_var_nonvar: #endif GONext(); @@ -5119,14 +5119,14 @@ Yap_absmi(int inp) UnifyGlobalRegCells(pt0, pt1, uc13, uc14); #ifdef COROUTINING DO_TRAIL(pt0, (CELL)pt1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); uc13: #endif GONext(); #ifdef COROUTINING uc14: DO_TRAIL(pt1, (CELL)pt0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); GONext(); #endif ENDP(pt1); @@ -5171,7 +5171,7 @@ Yap_absmi(int inp) BIND(pt1, d0, bind_ulvalx_nonvar_var); #ifdef COROUTINING DO_TRAIL(pt1, d0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); bind_ulvalx_nonvar_var: #endif GONext(); @@ -5189,7 +5189,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_ulvalx_var_nonvar); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_ulvalx_var_nonvar: #endif GONext(); @@ -5201,14 +5201,14 @@ Yap_absmi(int inp) UnifyGlobalRegCells(pt0, pt1, uc15, uc16); #ifdef COROUTINING DO_TRAIL(pt0, (CELL)pt1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); uc15: #endif GONext(); #ifdef COROUTINING uc16: DO_TRAIL(pt1, (CELL)pt0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); GONext(); #endif ENDP(pt1); @@ -5256,7 +5256,7 @@ Yap_absmi(int inp) BIND(pt1, d0, bind_uvaly_nonvar_var); #ifdef COROUTINING DO_TRAIL(pt1, d0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); bind_uvaly_nonvar_var: #endif GONext(); @@ -5277,7 +5277,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_uvaly_var_nonvar); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_uvaly_var_nonvar: #endif GONext(); @@ -5289,14 +5289,14 @@ Yap_absmi(int inp) UnifyGlobalRegCells(pt0, pt1, uc17, uc18); #ifdef COROUTINING DO_TRAIL(pt0, (CELL)pt1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); uc17: #endif GONext(); #ifdef COROUTINING uc18: DO_TRAIL(pt1, (CELL)pt1); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); GONext(); #endif ENDP(pt1); @@ -5350,7 +5350,7 @@ Yap_absmi(int inp) BIND(pt1, d0, bind_ulvaly_nonvar_var); #ifdef COROUTINING DO_TRAIL(pt1, d0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); bind_ulvaly_nonvar_var: #endif GONext(); @@ -5370,7 +5370,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_ulvaly_var_nonvar); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_ulvaly_var_nonvar: #endif GONext(); @@ -5383,14 +5383,14 @@ Yap_absmi(int inp) UnifyGlobalRegCells(pt0, pt1, uc19, uc20); #ifdef COROUTINING DO_TRAIL(pt0, (CELL)pt1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); uc19: #endif GONext(); #ifdef COROUTINING uc20: DO_TRAIL(pt1, (CELL)pt0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); GONext(); #endif ENDP(pt1); @@ -5445,7 +5445,7 @@ Yap_absmi(int inp) BIND(pt1, d0, bind_uvalx_loc_nonvar_var); #ifdef COROUTINING DO_TRAIL(pt1, d0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); bind_uvalx_loc_nonvar_var: #endif GONext(); @@ -5465,7 +5465,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_uvalx_loc_var_nonvar); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_uvalx_loc_var_nonvar: #endif GONext(); @@ -5480,14 +5480,14 @@ Yap_absmi(int inp) UnifyGlobalRegCells(pt0, pt1, uc21, uc22); #ifdef COROUTINING DO_TRAIL(pt0, (CELL)pt1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); uc21: #endif GONext(); #ifdef COROUTINING uc22: DO_TRAIL(pt1, (CELL)pt0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); GONext(); #endif ENDP(pt1); @@ -5558,7 +5558,7 @@ Yap_absmi(int inp) BIND(pt0, d0, bind_ulvalx_loc_nonvar_var); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_ulvalx_loc_nonvar_var: #endif GONext(); @@ -5575,7 +5575,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_ulvalx_loc_var_nonvar); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_ulvalx_loc_var_nonvar: #endif GONext(); @@ -5587,14 +5587,14 @@ Yap_absmi(int inp) UnifyGlobalRegCells(pt0, pt1, uc23, uc24); #ifdef COROUTINING DO_TRAIL(pt0, (CELL)pt1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); uc23: #endif GONext(); #ifdef COROUTINING uc24: DO_TRAIL(pt1, (CELL)pt0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); GONext(); #endif ENDP(pt1); @@ -5663,7 +5663,7 @@ Yap_absmi(int inp) BIND(pt1, d0, bind_uvaly_loc_nonvar_var); #ifdef COROUTINING DO_TRAIL(pt1, d0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); bind_uvaly_loc_nonvar_var: #endif GONext(); @@ -5684,7 +5684,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_uvaly_loc_var_nonvar); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_uvaly_loc_var_nonvar: #endif GONext(); @@ -5698,14 +5698,14 @@ Yap_absmi(int inp) UnifyGlobalRegCells(pt0, pt1, uc25, uc26); #ifdef COROUTINING DO_TRAIL(pt0, (CELL)pt1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); uc25: #endif GONext(); #ifdef COROUTINING uc26: DO_TRAIL(pt1, (CELL)pt0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); GONext(); #endif ENDP(pt1); @@ -5777,7 +5777,7 @@ Yap_absmi(int inp) BIND(pt1, d0, bind_ulvaly_loc_nonvar_var); #ifdef COROUTINING DO_TRAIL(pt1, d0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); bind_ulvaly_loc_nonvar_var: #endif GONext(); @@ -5797,7 +5797,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_ulvaly_loc_var_nonvar); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_ulvaly_loc_var_nonvar: #endif GONext(); @@ -5810,14 +5810,14 @@ Yap_absmi(int inp) UnifyGlobalRegCells(pt0, pt1, uc27, uc28); #ifdef COROUTINING DO_TRAIL(pt0, (CELL)pt1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); uc27: #endif GONext(); #ifdef COROUTINING uc28: DO_TRAIL(pt1, (CELL)pt0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); GONext(); #endif ENDP(pt1); @@ -5947,7 +5947,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d0, bind_uatom); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_uatom: #endif GONext(); @@ -5980,7 +5980,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d0, bind_ulatom); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_ulatom: #endif GONext(); @@ -6016,7 +6016,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_unlatom); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_unlatom: continue; #endif @@ -6086,7 +6086,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_ufloat); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_ufloat: #endif GONext(); @@ -6139,7 +6139,7 @@ Yap_absmi(int inp) BIND_GLOBAL(S_SREG, d1, bind_ulfloat); #ifdef COROUTINING DO_TRAIL(S_SREG, d1); - if (S_SREG < H0) Yap_WakeUp(S_SREG); + if (IsAttVar(S_SREG)) Yap_WakeUp(S_SREG); bind_ulfloat: #endif GONext(); @@ -6188,7 +6188,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_ulongint); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_ulongint: #endif GONext(); @@ -6236,7 +6236,7 @@ Yap_absmi(int inp) BIND_GLOBAL(S_SREG, d1, bind_ullongint); #ifdef COROUTINING DO_TRAIL(S_SREG, d1); - if (S_SREG < H0) Yap_WakeUp(S_SREG); + if (IsAttVar(S_SREG)) Yap_WakeUp(S_SREG); bind_ullongint: #endif GONext(); @@ -6285,7 +6285,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_ubigint); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_ubigint: #endif GONext(); @@ -6330,7 +6330,7 @@ Yap_absmi(int inp) BIND_GLOBAL(S_SREG, d1, bind_ulbigint); #ifdef COROUTINING DO_TRAIL(S_SREG, d1); - if (S_SREG < H0) Yap_WakeUp(S_SREG); + if (IsAttVar(S_SREG)) Yap_WakeUp(S_SREG); bind_ulbigint: #endif GONext(); @@ -6363,7 +6363,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_udbterm); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_udbterm: #endif GONext(); @@ -6393,7 +6393,7 @@ Yap_absmi(int inp) BIND_GLOBAL(S_SREG, d1, bind_uldbterm); #ifdef COROUTINING DO_TRAIL(S_SREG, d1); - if (S_SREG < H0) Yap_WakeUp(S_SREG); + if (IsAttVar(S_SREG)) Yap_WakeUp(S_SREG); bind_uldbterm: #endif GONext(); @@ -6435,7 +6435,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d0, bind_ulist_var); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_ulist_var: #endif GONextW(); @@ -6495,7 +6495,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d0, bind_ullist_var); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_ullist_var: #endif GONextW(); @@ -6560,7 +6560,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_ustruct); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_ustruct: #endif /* now, set pt0 to point to the heap where we are going to @@ -6636,7 +6636,7 @@ Yap_absmi(int inp) BIND_GLOBAL(pt0, d1, bind_ulstruct); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_ulstruct: #endif /* now, set pt0 to point to the heap where we are going to @@ -13455,7 +13455,7 @@ Yap_absmi(int inp) BIND(pt0, d0, bind_func_nvar_var); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_func_nvar_var: #endif /* I have to this here so that I don't have a jump to a closing bracket */ @@ -13482,7 +13482,7 @@ Yap_absmi(int inp) /* Done */ #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_func_nvar3_var: #endif GONext(); @@ -13575,7 +13575,7 @@ Yap_absmi(int inp) BIND(pt0, d0, bind_func_var_3nvar); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_func_var_3nvar: #endif GONext(); From 02fb454f3ff5c9e1e95d75748f0e52239943533f Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 8 Mar 2010 09:18:08 +0000 Subject: [PATCH 04/37] DelayTop goes away --- C/agc.c | 4 ---- 1 file changed, 4 deletions(-) diff --git a/C/agc.c b/C/agc.c index fe53c4342..26603d0b4 100755 --- a/C/agc.c +++ b/C/agc.c @@ -322,11 +322,7 @@ mark_global(void) * to clean the global now that functors are just variables pointing to * the code */ -#if COROUTINING - pt = (CELL *)DelayTop(); -#else pt = H0; -#endif while (pt < H) { pt = mark_global_cell(pt); } From 76c6e06b45017c0ca8e7d874bbbc20ef0372a0a4 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 8 Mar 2010 09:18:30 +0000 Subject: [PATCH 05/37] patch label for gc --- C/amasm.c | 1 + 1 file changed, 1 insertion(+) diff --git a/C/amasm.c b/C/amasm.c index 1bedb0653..0ed3f350a 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -3510,6 +3510,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp if (!ystop_found && cip->cpc->nextInst != NULL && (cip->cpc->nextInst->op == mark_initialised_pvars_op || + cip->cpc->nextInst->op == mark_live_regs_op || cip->cpc->nextInst->op == blob_op)) { ystop_found = TRUE; code_p = a_il((CELL)*entry_codep, _Ystop, code_p, pass_no, cip); From e992b0dcf0571caa1b668833cae3906584b53971 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 8 Mar 2010 09:18:52 +0000 Subject: [PATCH 06/37] new version of attributed variable code, using arena to store variables and removing variable chain. --- C/attvar.c | 185 +++++++++++++++++++---------------------------------- 1 file changed, 66 insertions(+), 119 deletions(-) diff --git a/C/attvar.c b/C/attvar.c index cd789b82b..7c48d50f9 100644 --- a/C/attvar.c +++ b/C/attvar.c @@ -67,21 +67,32 @@ AddFailToQueue(void) } } +static attvar_record * +BuildNewAttVar(void) +{ + attvar_record *newv; + + /* add a new attributed variable */ + if (!(newv = (attvar_record *)Yap_GetFromArena(&GlobalArena, sizeof(attvar_record)/sizeof(CELL),2))) + return NULL; + newv->AttFunc = FunctorAttVar; + RESET_VARIABLE(&(newv->Value)); + RESET_VARIABLE(&(newv->Done)); + RESET_VARIABLE(&(newv->Atts)); + HB = PROTECT_FROZEN_H(B); + return newv; +} + static int CopyAttVar(CELL *orig, struct cp_frame **to_visit_ptr, CELL *res) { - register attvar_record *attv = (attvar_record *)orig; + register attvar_record *attv = RepAttVar(orig); register attvar_record *newv; struct cp_frame *to_visit = *to_visit_ptr; CELL *vt; - /* add a new attributed variable */ - newv = DelayTop(); - if ((ADDR)newv - Yap_GlobalBase < 1024*sizeof(CELL)) + if (!(newv = BuildNewAttVar())) return FALSE; - newv--; - RESET_VARIABLE(&(newv->Value)); - RESET_VARIABLE(&(newv->Done)); vt = &(attv->Atts); to_visit->start_cp = vt-1; to_visit->end_cp = vt; @@ -97,32 +108,17 @@ CopyAttVar(CELL *orig, struct cp_frame **to_visit_ptr, CELL *res) to_visit->ground = FALSE; *to_visit_ptr = to_visit+1; *res = (CELL)&(newv->Done); - SetDelayTop(newv); return TRUE; } static Term AttVarToTerm(CELL *orig) { - attvar_record *attv = (attvar_record *)orig; + attvar_record *attv = RepAttVar(orig); return attv->Atts; } -static attvar_record * -BuildNewAttVar(void) -{ - attvar_record *attv = DelayTop(); - if ((ADDR)attv - Yap_GlobalBase < 1024*sizeof(CELL)) - return FALSE; - attv--; - RESET_VARIABLE(&(attv->Done)); - RESET_VARIABLE(&(attv->Value)); - RESET_VARIABLE(&(attv->Atts)); - SetDelayTop(attv); - return attv; -} - static int TermToAttVar(Term attvar, Term to) { @@ -130,7 +126,7 @@ TermToAttVar(Term attvar, Term to) if (!attv) return FALSE; attv->Atts = attvar; - *VarOfTerm(to) = (CELL)attv; + *VarOfTerm(to) = AbsAttVar(attv); return TRUE; } @@ -139,7 +135,7 @@ WakeAttVar(CELL* pt1, CELL reg2) { /* if bound to someone else, follow until we find the last one */ - attvar_record *attv = (attvar_record *)pt1; + attvar_record *attv = RepAttVar(pt1); CELL *myH = H; CELL *bind_ptr; @@ -147,7 +143,7 @@ WakeAttVar(CELL* pt1, CELL reg2) if (pt1 == VarOfTerm(reg2)) return; if (IsAttachedTerm(reg2)) { - attvar_record *susp2 = (attvar_record *)VarOfTerm(reg2); + attvar_record *susp2 = RepAttVar(VarOfTerm(reg2)); /* binding two suspended variables, be careful */ if (susp2 >= attv) { @@ -196,11 +192,7 @@ Yap_WakeUp(CELL *pt0) { static void mark_attvar(CELL *orig) { - register attvar_record *attv = (attvar_record *)orig; - - Yap_mark_external_reference(&(attv->Value)); - Yap_mark_external_reference(&(attv->Done)); - Yap_mark_external_reference(&(attv->Atts)); + return; } static Term @@ -388,11 +380,11 @@ BindAttVar(attvar_record *attv) { Term t = Deref(attv->Value); if (IsVarTerm(t)) { if (IsAttachedTerm(t)) { - attvar_record *attv2 = (attvar_record *)VarOfTerm(t); + attvar_record *attv2 = RepAttVar(VarOfTerm(t)); if (attv2 < attv) { Bind_Global(&(attv->Done), t); } else { - Bind_Global(&(attv2->Done), (CELL)attv); + Bind_Global(&(attv2->Done), AbsAttVar(attv)); } } else { Yap_Error(SYSTEM_ERROR,(CELL)&(attv->Done),"attvar was bound when unset"); @@ -421,43 +413,6 @@ GetAllAtts(attvar_record *attv) { return attv->Atts; } -static Term -AllAttVars(attvar_record *attv) { - CELL *h0 = H; - attvar_record *max = DelayTop(); - - while (--attv >= max) { - if (ASP - H < 1024) { - H = h0; - Yap_Error_Size = (ASP-H)*sizeof(CELL); - return 0L; - } - if (IsVarTerm(attv->Done) && IsUnboundVar(&attv->Done)) { - if (IsVarTerm(attv->Atts)) { - if (VarOfTerm(attv->Atts) < (CELL *)attv) { - /* skip call residue(s) */ - attv = (attvar_record *)(attv->Atts); - continue; - } else if (IsUnboundVar(&attv->Atts)) { - /* ignore arena */ - continue; - } - } - if (H != h0) { - H[-1] = AbsPair(H); - } - H[0] = (CELL)attv; - H += 2; - } - } - if (H != h0) { - H[-1] = TermNil; - return AbsPair(h0); - } else { - return TermNil; - } -} - static Int p_put_att(void) { /* receive a variable in ARG1 */ @@ -472,13 +427,14 @@ p_put_att(void) { int new = FALSE; if (IsAttachedTerm(inp)) { - attv = (attvar_record *)VarOfTerm(inp); + attv = RepAttVar(VarOfTerm(inp)); } else { while (!(attv = BuildNewAttVar())) { - if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, ARG1, Yap_ErrorMessage); + Yap_Error_Size = sizeof(attvar_record); + if (!Yap_gcl(Yap_Error_Size, 5, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); return FALSE; - } + } inp = Deref(ARG1); } new = TRUE; @@ -491,7 +447,7 @@ p_put_att(void) { return FALSE; } } - Yap_unify(ARG1, (Term)attv); + Yap_unify(ARG1, AbsAttVar(attv)); AddNewModule(attv,tatts,new,TRUE); } PutAtt(IntegerOfTerm(Deref(ARG4)), tatts, Deref(ARG5)); @@ -512,19 +468,20 @@ p_put_att_term(void) { int new = FALSE; if (IsAttachedTerm(inp)) { - attv = (attvar_record *)VarOfTerm(inp); + attv = RepAttVar(VarOfTerm(inp)); } else { while (!(attv = BuildNewAttVar())) { - if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, ARG1, Yap_ErrorMessage); + Yap_Error_Size = sizeof(attvar_record); + if (!Yap_gcl(Yap_Error_Size, 5, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); return FALSE; - } + } inp = Deref(ARG1); } new = TRUE; } if (new) { - Bind(VarOfTerm(inp), (CELL)attv); + Bind(VarOfTerm(inp), AbsAttVar(attv)); attv->Atts = Deref(ARG2); } else { MaBind(&(attv->Atts), Deref(ARG2)); @@ -550,17 +507,18 @@ p_rm_att(void) { int new = FALSE; if (IsAttachedTerm(inp)) { - attv = (attvar_record *)VarOfTerm(inp); + attv = RepAttVar(VarOfTerm(inp)); } else { while (!(attv = BuildNewAttVar())) { - if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, ARG1, Yap_ErrorMessage); + Yap_Error_Size = sizeof(attvar_record); + if (!Yap_gcl(Yap_Error_Size, 5, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); return FALSE; - } + } inp = Deref(ARG1); } new = TRUE; - Yap_unify(ARG1, (Term)attv); + Yap_unify(ARG1, AbsAttVar(attv)); } mfun= Yap_MkFunctor(modname,ar); if (IsVarTerm(tatts = SearchAttsForModule(attv->Atts,mfun))) { @@ -595,17 +553,18 @@ p_put_atts(void) { int new = FALSE; if (IsAttachedTerm(inp)) { - attv = (attvar_record *)VarOfTerm(inp); + attv = RepAttVar(VarOfTerm(inp)); } else { while (!(attv = BuildNewAttVar())) { - if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, ARG1, Yap_ErrorMessage); + Yap_Error_Size = sizeof(attvar_record); + if (!Yap_gcl(Yap_Error_Size, 5, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); return FALSE; - } + } tatts = Deref(ARG2); } new = TRUE; - Yap_unify(ARG1, (Term)attv); + Yap_unify(ARG1, AbsAttVar(attv)); } if (IsVarTerm(otatts = SearchAttsForModule(attv->Atts,mfun))) { AddNewModule(attv,tatts,new,FALSE); @@ -632,7 +591,7 @@ p_del_atts(void) { Functor mfun = FunctorOfTerm(tatts); if (IsAttachedTerm(inp)) { - attv = (attvar_record *)VarOfTerm(inp); + attv = RepAttVar(VarOfTerm(inp)); } else { return TRUE; } @@ -656,7 +615,7 @@ p_del_all_atts(void) { if (IsVarTerm(inp) && IsAttachedTerm(inp)) { attvar_record *attv; - attv = (attvar_record *)VarOfTerm(inp); + attv = RepAttVar(VarOfTerm(inp)); DelAllAtts(attv); } return TRUE; @@ -674,7 +633,7 @@ p_get_att(void) { attvar_record *attv; Term tout, tatts; - attv = (attvar_record *)VarOfTerm(inp); + attv = RepAttVar(VarOfTerm(inp)); if (IsVarTerm(tatts = SearchAttsForModuleName(attv->Atts,modname))) return FALSE; tout = ArgOfTerm(IntegerOfTerm(Deref(ARG3)),tatts); @@ -702,7 +661,7 @@ p_free_att(void) { attvar_record *attv; Term tout, tatts; - attv = (attvar_record *)VarOfTerm(inp); + attv = RepAttVar(VarOfTerm(inp)); if (IsVarTerm(tatts = SearchAttsForModuleName(attv->Atts,modname))) return TRUE; tout = ArgOfTerm(IntegerOfTerm(Deref(ARG3)),tatts); @@ -731,7 +690,7 @@ p_get_atts(void) { UInt ar, i; CELL *old, *new; - attv = (attvar_record *)VarOfTerm(inp); + attv = RepAttVar(VarOfTerm(inp)); if (IsVarTerm(tatts = SearchAttsForModule(attv->Atts,mfun))) return FALSE; @@ -769,7 +728,7 @@ p_has_atts(void) { Term access = Deref(ARG2); Functor mfun = FunctorOfTerm(access); - attv = (attvar_record *)VarOfTerm(inp); + attv = RepAttVar(VarOfTerm(inp)); return !IsVarTerm(tatts = SearchAttsForModule(attv->Atts,mfun)); } else { /* Yap_Error(INSTANTIATION_ERROR,inp,"get_att/2"); */ @@ -788,7 +747,7 @@ p_bind_attvar(void) { /* if this is unbound, ok */ if (IsVarTerm(inp)) { if (IsAttachedTerm(inp)) { - attvar_record *attv = (attvar_record *)VarOfTerm(inp); + attvar_record *attv = RepAttVar(VarOfTerm(inp)); return(BindAttVar(attv)); } return(TRUE); @@ -805,7 +764,7 @@ p_unbind_attvar(void) { /* if this is unbound, ok */ if (IsVarTerm(inp)) { if (IsAttachedTerm(inp)) { - attvar_record *attv = (attvar_record *)VarOfTerm(inp); + attvar_record *attv = RepAttVar(VarOfTerm(inp)); return(UnBindAttVar(attv)); } return(TRUE); @@ -822,7 +781,7 @@ p_get_all_atts(void) { /* if this is unbound, ok */ if (IsVarTerm(inp)) { if (IsAttachedTerm(inp)) { - attvar_record *attv = (attvar_record *)VarOfTerm(inp); + attvar_record *attv = RepAttVar(VarOfTerm(inp)); return Yap_unify(ARG2,GetAllAtts(attv)); } return TRUE; @@ -852,7 +811,7 @@ p_modules_with_atts(void) { /* if this is unbound, ok */ if (IsVarTerm(inp)) { if (IsAttachedTerm(inp)) { - attvar_record *attv = (attvar_record *)VarOfTerm(inp); + attvar_record *attv = RepAttVar(VarOfTerm(inp)); CELL *h0 = H; Term tatt; @@ -889,7 +848,7 @@ p_swi_all_atts(void) { /* if this is unbound, ok */ if (IsVarTerm(inp)) { if (IsAttachedTerm(inp)) { - attvar_record *attv = (attvar_record *)VarOfTerm(inp); + attvar_record *attv = RepAttVar(VarOfTerm(inp)); CELL *h0 = H; Term tatt; @@ -923,20 +882,7 @@ p_swi_all_atts(void) { static Int p_all_attvars(void) { - do { - Term out; - attvar_record *base; - - base = (attvar_record *)Yap_ReadTimedVar(AttsMutableList); - if (!(out = AllAttVars(base))) { - if (!Yap_gcl(Yap_Error_Size, 1, ENV, gc_P(P,CP))) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); - return FALSE; - } - } else { - return Yap_unify(ARG1,out); - } - } while (TRUE); + return Yap_unify(ARG1,TermNil); } static Int @@ -944,7 +890,7 @@ p_is_attvar(void) { Term t = Deref(ARG1); return(IsVarTerm(t) && - IsAttachedTerm(t)); + IsAttVar(VarOfTerm(t))); } /* check if we are not redoing effort */ @@ -952,9 +898,10 @@ static Int p_attvar_bound(void) { Term t = Deref(ARG1); - return(IsVarTerm(t) && - IsAttachedTerm(t) && - !IsUnboundVar(&((attvar_record *)VarOfTerm(t))->Done)); + return + IsVarTerm(t) && + IsAttachedTerm(t) && + !IsUnboundVar(&(RepAttVar(VarOfTerm(t))->Done)); } static Int From 99460df1951caa47a5f267ccbba04b10679239b1 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 8 Mar 2010 09:19:35 +0000 Subject: [PATCH 07/37] use IsAttVar --- C/c_interface.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/C/c_interface.c b/C/c_interface.c index 2a462f378..4508f673e 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -2940,7 +2940,7 @@ YAP_IsAttVar(Term t) t = Deref(t); if (!IsVarTerm(t)) return FALSE; - return (VarOfTerm(t) < H0); + return IsAttVar(VarOfTerm(t)); } X_API Term @@ -2951,7 +2951,7 @@ YAP_AttsOfVar(Term t) t = Deref(t); if (!IsVarTerm(t)) return TermNil; - if (VarOfTerm(t) >= H0) + if (IsAttVar(VarOfTerm(t))) return TermNil; attv = (attvar_record *)VarOfTerm(t); return attv->Atts; @@ -2965,7 +2965,7 @@ YAP_TermHash(Term t) t = Deref(t); if (!IsVarTerm(t)) return TermNil; - if (VarOfTerm(t) >= H0) + if (IsAttVar(VarOfTerm(t))) return TermNil; attv = (attvar_record *)VarOfTerm(t); return attv->Atts; From e4409532564483d20b9a0778d61e62f43b88f758 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 8 Mar 2010 09:19:57 +0000 Subject: [PATCH 08/37] use IsAttVar --- C/cdmgr.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/C/cdmgr.c b/C/cdmgr.c index 23d186429..c38bd5409 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -4024,8 +4024,8 @@ p_is_profiled(void) else ta = MkAtomTerm(AtomOff); BIND((CELL *)t,ta,bind_is_profiled); #ifdef COROUTINING - DO_TRAIL(CellPtr(t), ta); - if (CellPtr(t) < H0) Yap_WakeUp((CELL *)t); + DO_TRAIL(VarOfTerm(t), ta); + if (IsAttVar(VarOfTerm(t))) Yap_WakeUp((CELL *)t); bind_is_profiled: #endif return(TRUE); @@ -4127,8 +4127,8 @@ p_is_call_counted(void) else ta = MkAtomTerm(AtomOff); BIND((CELL *)t,ta,bind_is_call_counted); #ifdef COROUTINING - DO_TRAIL(CellPtr(t), ta); - if (CellPtr(t) < H0) Yap_WakeUp((CELL *)t); + DO_TRAIL(VarOfTerm(t), ta); + if (IsAttVar(VarOfTerm(t))) Yap_WakeUp((CELL *)t); bind_is_call_counted: #endif return(TRUE); From 0dc4369b200d85162201f9328003eaafc2f45ebe Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 8 Mar 2010 09:20:06 +0000 Subject: [PATCH 09/37] no more need to support call_residue. --- C/corout.c | 50 -------------------------------------------------- 1 file changed, 50 deletions(-) diff --git a/C/corout.c b/C/corout.c index 177e7be79..bb7d1c0ea 100644 --- a/C/corout.c +++ b/C/corout.c @@ -27,54 +27,6 @@ static char SccsId[]="%W% %G%"; #define NULL (void *)0 #endif -static Int -p_read_svar_list(void) -{ -#ifdef COROUTINING -#ifdef MULTI_ASSIGNMENT_VARIABLES - return Yap_unify(ARG1,Yap_ReadTimedVar(AttsMutableList)); -#else - return(TRUE); -#endif -#else - return(TRUE); -#endif -} - -static Int -p_set_svar_list(void) -{ -#ifdef COROUTINING -#ifdef MULTI_ASSIGNMENT_VARIABLES - Term newl = Deref(ARG1); - attvar_record *max = DelayTop(); - - if (IsVarTerm(newl) && VarOfTerm(newl) > H0) { - /* set to current top */ - max--; - RESET_VARIABLE(&max->Done); - RESET_VARIABLE(&max->Value); - RESET_VARIABLE(&(max->Atts)); - SetDelayTop(max); - - Yap_UpdateTimedVar(AttsMutableList,(CELL)max); - return Yap_unify(ARG1,(CELL)max); - } else { - attvar_record *aold = (attvar_record *)Yap_UpdateTimedVar(AttsMutableList,newl); - - if (max < aold) { - /* we are moving forward */ - /* these items are protected by call-residue, should not - be visible to AllAtts - */ - MaBind(&(aold->Atts),(CELL)max); - } - } -#endif -#endif - return TRUE; -} - #ifdef COROUTINING /* check if variable was there */ @@ -612,8 +564,6 @@ Yap_InitCoroutPreds(void) Yap_InitAttVarPreds(); Yap_InitCPred("$yap_has_rational_trees", 0, p_yap_has_rational_trees, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$yap_has_coroutining", 0, p_yap_has_coroutining, SafePredFlag|HiddenPredFlag); - Yap_InitCPred("$read_svar_list", 1, p_read_svar_list, SafePredFlag|HiddenPredFlag); - Yap_InitCPred("$set_svar_list", 1, p_set_svar_list, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$can_unify", 3, p_can_unify, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$non_ground", 2, p_non_ground, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$coroutining", 0, p_coroutining, SafePredFlag|HiddenPredFlag); From 16ea59e106e7d8c2307163f20e82948c1a2a86ab Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 8 Mar 2010 09:20:30 +0000 Subject: [PATCH 10/37] no more list of variables. --- C/dbase.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/C/dbase.c b/C/dbase.c index 65b1e0d1b..fa88b7fc7 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -2347,7 +2347,6 @@ static int copy_attachments(CELL *ts) { /* we will change delayed vars, and that also means the trail */ - Term orig = Yap_ReadTimedVar(DelayedVars); tr_fr_ptr tr0 = TR; while (TRUE) { @@ -2356,7 +2355,6 @@ copy_attachments(CELL *ts) if (attas[IntegerOfTerm(ts[2])].term_to_op(ts[1], ts[0]) == FALSE) { /* oops, we did not have enough space to copy the elements */ /* reset queue of woken up goals */ - Yap_UpdateTimedVar(DelayedVars, orig); TR = tr0; return FALSE; } From 43a822b41f42c5aa764e9c4ecd83be793dfbb1cb Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 8 Mar 2010 09:21:16 +0000 Subject: [PATCH 11/37] IsAttVar --- C/exec.c | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/C/exec.c b/C/exec.c index 91da5760c..fa5d0fe34 100644 --- a/C/exec.c +++ b/C/exec.c @@ -126,8 +126,8 @@ p_save_cp(void) td = cp_as_integer(B); BIND((CELL *)t,td,bind_save_cp); #ifdef COROUTINING - DO_TRAIL(CellPtr(t), td); - if (CellPtr(t) < H0) Yap_WakeUp((CELL *)t); + DO_TRAIL(VarOfTerm(t), td); + if (IsAttVar(VarOfTerm(t))) Yap_WakeUp((CELL *)t); bind_save_cp: #endif return(TRUE); @@ -145,8 +145,8 @@ p_save_env_b(void) td = cp_as_integer((choiceptr)YENV[E_CB]); BIND((CELL *)t,td,bind_save_cp); #ifdef COROUTINING - DO_TRAIL(CellPtr(t), td); - if (CellPtr(t) < H0) Yap_WakeUp((CELL *)t); + DO_TRAIL(VarOfTerm(t), td); + if (IsAttVar(VarOfTerm(t))) Yap_WakeUp((CELL *)t); bind_save_cp: #endif return(TRUE); @@ -1629,10 +1629,8 @@ Yap_InitYaamRegs(void) GlobalArena = TermNil; h0var = MkVarTerm(); #if COROUTINING - DelayedVars = Yap_NewTimedVar(h0var); WokenGoals = Yap_NewTimedVar(TermNil); AttsMutableList = Yap_NewTimedVar(h0var); - GlobalDelayArena = TermNil; #endif GcGeneration = Yap_NewTimedVar(h0var); GcCurrentPhase = 0L; From d48be6406b260bee0552a2cfb49cb4f86706d7fe Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 8 Mar 2010 09:21:48 +0000 Subject: [PATCH 12/37] no more need to support AttVars --- C/globals.c | 427 +++++++++++----------------------------------------- 1 file changed, 84 insertions(+), 343 deletions(-) diff --git a/C/globals.c b/C/globals.c index 8412e98b6..3ca7dded3 100644 --- a/C/globals.c +++ b/C/globals.c @@ -33,16 +33,14 @@ static char SccsId[] = "%W% %G%"; */ #define QUEUE_ARENA 0 -#define QUEUE_DELAY_ARENA 1 -#define QUEUE_HEAD 2 -#define QUEUE_TAIL 3 -#define QUEUE_SIZE 4 +#define QUEUE_HEAD 1 +#define QUEUE_TAIL 2 +#define QUEUE_SIZE 3 #define HEAP_SIZE 0 #define HEAP_MAX 1 #define HEAP_ARENA 2 -#define HEAP_DELAY_ARENA 3 -#define HEAP_START 4 +#define HEAP_START 3 #define MIN_ARENA_SIZE 1048 #define MAX_ARENA_SIZE (2048*16) @@ -99,102 +97,6 @@ CreateNewArena(CELL *ptr, UInt size) return t; } -#if COROUTINING - -/* pointer to top of an arena */ -static inline attvar_record * -DelayArenaPt(Term arena) -{ - return (attvar_record *)arena; -} - -static inline UInt -DelayArenaSz(Term arena) -{ - attvar_record *ptr = (attvar_record *)arena-1; - return 1+(ptr-(attvar_record *)ptr->Done); -} - -static void -ResetDelayArena(Term old_delay_arena, Term *new_arenap) -{ - attvar_record *min = (attvar_record *)*new_arenap; - Term base = min[-1].Done; - while (min < (attvar_record *)old_delay_arena) { - min->Value = (Term)(min-1); - min->Done = base; - RESET_VARIABLE(&min->Atts); - min++; - } - *new_arenap = old_delay_arena; -} - - -static Term -CreateDelayArena(attvar_record *max, attvar_record *min) -{ - attvar_record *ptr = max; - while (ptr > min) { - --ptr; - ptr->Done = (CELL)min; - ptr->Value = (CELL)(ptr-1); - RESET_VARIABLE(&ptr->Atts); - } - RESET_VARIABLE(&(ptr->Value)); - return (CELL)max; -} - -static Term -NewDelayArena(UInt size) -{ - attvar_record *max = DelayTop(), *min = max-size; - Term out; - UInt howmuch; - - while ((ADDR)min < Yap_GlobalBase+1024) { - UInt bsize = size*sizeof(attvar_record); - if ((howmuch = Yap_InsertInGlobal((CELL *)max, bsize))==0) { - Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms"); - return TermNil; - } - max = DelayTop(), min = max-size; - } - out = CreateDelayArena(max, min); - SetDelayTop(min); - return out; -} - -static Term -GrowDelayArena(Term *arenap, UInt old_size, UInt size, UInt arity) -{ - Term arena = *arenap; - UInt howmuch; - - DelayArenaOverflows++; - if (size == 0) { - if (old_size < 1024) { - size = old_size*2; - } else { - size = old_size+1024; - } - } - if (size < 64) { - size = 64; - } - /* just make sure we are shifted up when we expand stacks */ - XREGS[arity+1] = arena; - if ((howmuch = Yap_InsertInGlobal((CELL *)arena, (size-old_size)*sizeof(attvar_record)))==0) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); - return TermNil; - } - size = howmuch/sizeof(attvar_record)+old_size; - arena = XREGS[arity+1]; - CreateDelayArena(DelayArenaPt(arena), DelayArenaPt(arena)-size); - return arena; -} - -#endif - static Term NewArena(UInt size, UInt arity, CELL *where) { @@ -247,9 +149,6 @@ void Yap_AllocateDefaultArena(Int gsize, Int attsize) { GlobalArena = NewArena(gsize, 2, NULL); -#if COROUTINING - GlobalDelayArena = NewDelayArena(attsize); -#endif } static void @@ -314,6 +213,30 @@ GrowArena(Term arena, CELL *pt, UInt old_size, UInt size, UInt arity) return TRUE; } +CELL * +Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) +{ + restart: + { + Term arena = *arenap; + CELL *max = ArenaLimit(arena); + CELL *base = ArenaPt(arena); + CELL *newH; + UInt old_sz = ArenaSz(arena), new_size; + + if (base+cells > ASP-1024) { + if (!GrowArena(arena, max, old_sz, old_sz+sizeof(CELL)*1024, arity)) + return NULL; + goto restart; + } + + newH = base+cells; + new_size = old_sz - cells; + *arenap = CreateNewArena(newH, new_size); + return base; + } +} + static void CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP, UInt old_size) { @@ -349,53 +272,13 @@ clean_dirty_tr(tr_fr_ptr TR0) { } } -#if COROUTINING - static int -CopyAttVar(CELL *orig, struct cp_frame **to_visit_ptr, CELL *res, Term *att_arenap) -{ - register attvar_record *attv = (attvar_record *)orig; - register attvar_record *newv; - struct cp_frame *to_visit = *to_visit_ptr; - CELL *vt; - - /* add a new attributed variable */ - if (DelayArenaSz(*att_arenap) < 8) - return FALSE; - newv = DelayArenaPt(*att_arenap); - newv--; - RESET_VARIABLE(&(newv->Value)); - RESET_VARIABLE(&(newv->Done)); - vt = &(attv->Atts); - to_visit->start_cp = vt-1; - to_visit->end_cp = vt; - if (IsVarTerm(attv->Atts)) { - newv->Atts = (CELL)H; - to_visit->to = H; - H++; - } else { - to_visit->to = &(newv->Atts); - } - to_visit->oldv = vt[-1]; - /* you're coming from a variable */ - to_visit->ground = FALSE; - *to_visit_ptr = to_visit+1; - *res = (CELL)&(newv->Done); - *att_arenap = (CELL)(newv); - return TRUE; -} -#endif - -static int -copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int copy_att_vars, CELL *ptf, CELL *HLow, Term *att_arenap) +copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int copy_att_vars, CELL *ptf, CELL *HLow) { struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace(); CELL *HB0 = HB; tr_fr_ptr TR0 = TR; -#ifdef COROUTINING - CELL *dvars = NULL; -#endif int ground = TRUE; HB = HLow; @@ -468,6 +351,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop if (IsExtensionFunctor(f)) { switch((CELL)f) { case (CELL)FunctorDBRef: + case (CELL)FunctorAttVar: *ptf++ = d0; break; case (CELL)FunctorLongInt: @@ -571,45 +455,49 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop *ptf++ = (CELL) ptd0; } else { #if COROUTINING - if (IsAttachedTerm((CELL)ptd0) && copy_att_vars) { - /* if unbound, call the standard copy term routine */ - struct cp_frame *bp[1]; - - if (dvars == NULL) { - dvars = (CELL *)DelayArenaPt(*att_arenap); - } - if (ptd0 < dvars && - ptd0 >= (CELL *)DelayArenaPt(*att_arenap)) { - *ptf++ = (CELL) ptd0; - } else { - tr_fr_ptr CurTR; - - CurTR = TR; - bp[0] = to_visit; - HB = HB0; - if (!CopyAttVar(ptd0, bp, ptf, att_arenap)) { - goto delay_overflow; + if (IsAttVar(ptd0) && copy_att_vars) { + attvar_record *newv = (attvar_record *)H; + newv->AttFunc = FunctorAttVar; + RESET_VARIABLE(&newv->Done); + *ptf = AbsAttVar(newv); + ptf++; + /* store the terms to visit */ +#ifdef RATIONAL_TREES + if (to_visit+1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldv = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + *pt0 = AbsAppl(H); + to_visit ++; +#else + if (pt0 < pt0_end) { + if (to_visit ++ >= (CELL **)AuxSp) { + goto heap_overflow; } - if (H > ASP - MIN_ARENA_SIZE) { - goto overflow; - } - to_visit = bp[0]; - HB = HLow; - ptf++; - if ((ADDR)TR > Yap_TrailTop-MIN_ARENA_SIZE) - goto trail_overflow; - Bind_and_Trail(ptd0, ptf[-1]); + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + to_visit ++; + } +#endif + pt0 = ptd0+(1-1); + pt0_end = ptd0 + (ATT_RECORD_ARITY-1); + /* store the functor for the new term */ + ptf = H+2; + H = CellPtr(newv+1); + if (H > ASP - MIN_ARENA_SIZE) { + goto overflow; } } else { -#endif - /* first time we met this term */ - RESET_VARIABLE(ptf); - if ((ADDR)TR > Yap_TrailTop-MIN_ARENA_SIZE) - goto trail_overflow; - Bind_and_Trail(ptd0, (CELL)ptf); - ptf++; -#ifdef COROUTINING + *ptf++ = d0; } + continue; #endif } } @@ -666,64 +554,19 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop #endif reset_trail(TR0); return -2; - - -#if COROUTINING - delay_overflow: - /* oops, we're in trouble */ - H = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - *pt0 = to_visit->oldv; - } -#endif - reset_trail(TR0); - return -3; -#endif - - trail_overflow: - /* oops, we're in trouble */ - H = HLow; - /* we've done it */ - /* restore our nice, friendly, term to its original state */ - HB = HB0; -#ifdef RATIONAL_TREES - while (to_visit > to_visit0) { - to_visit--; - pt0 = to_visit->start_cp; - pt0_end = to_visit->end_cp; - ptf = to_visit->to; - *pt0 = to_visit->oldv; - } -#endif - reset_trail(TR0); - return -4; } static Term -CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Term *newarena, Term *att_arenap, UInt min_grow) +CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Term *newarena, UInt min_grow) { UInt old_size = ArenaSz(arena); CELL *oldH = H; CELL *oldHB = HB; CELL *oldASP = ASP; int res = 0; -#if COROUTINING - Term old_delay_arena; -#endif Term tn; restart: -#if COROUTINING - old_delay_arena = *att_arenap; -#endif t = Deref(t); if (IsVarTerm(t)) { ASP = ArenaLimit(arena); @@ -735,7 +578,7 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te *H = t; Hi = H+1; H += 2; - if ((res = copy_complex_term(Hi-2, Hi-1, share, copy_att_vars, Hi, Hi, att_arenap)) < 0) + if ((res = copy_complex_term(Hi-2, Hi-1, share, copy_att_vars, Hi, Hi)) < 0) goto error_handler; CloseArena(oldH, oldHB, oldASP, newarena, old_size); return Hi[0]; @@ -768,7 +611,7 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te Hi = H; tf = AbsPair(H); H += 2; - if ((res = copy_complex_term(ap-1, ap+1, share, copy_att_vars, Hi, Hi, att_arenap)) < 0) { + if ((res = copy_complex_term(ap-1, ap+1, share, copy_att_vars, Hi, Hi)) < 0) { goto error_handler; } CloseArena(oldH, oldHB, oldASP, newarena, old_size); @@ -838,7 +681,7 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te res = -1; goto error_handler; } - if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, copy_att_vars, HB0+1, HB0, att_arenap)) < 0) { + if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, copy_att_vars, HB0+1, HB0)) < 0) { goto error_handler; } } @@ -848,14 +691,9 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te error_handler: H = HB; CloseArena(oldH, oldHB, oldASP, newarena, old_size); -#if COROUTINING - if (old_delay_arena != MkIntTerm(0)) - ResetDelayArena(old_delay_arena, att_arenap); -#endif XREGS[arity+1] = t; XREGS[arity+2] = arena; XREGS[arity+3] = (CELL)newarena; - XREGS[arity+4] = (CELL)att_arenap; { CELL *old_top = ArenaLimit(*newarena); ASP = oldASP; @@ -865,29 +703,11 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te case -1: if (arena == GlobalArena) GlobalArenaOverflows++; - if (!GrowArena(arena, old_top, old_size, min_grow, arity+4)) { + if (!GrowArena(arena, old_top, old_size, min_grow, arity+3)) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); return 0L; } break; -#if COROUTINING - case -3: - /* handle delay arena overflow */ - old_size = DelayArenaSz(*att_arenap); - - if (!GrowDelayArena(att_arenap, old_size, 0L, arity+4)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); - return 0L; - } - break; -#endif - case -4: - /* handle trail overflow */ - if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L, FALSE)) { - Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, Yap_ErrorMessage); - return 0L; - } - break; default: /* temporary space overflow */ if (!Yap_ExpandPreAllocCodeSpace(0,NULL,TRUE)) { Yap_Error(OUT_OF_AUXSPACE_ERROR, TermNil, Yap_ErrorMessage); @@ -898,7 +718,6 @@ CopyTermToArena(Term t, Term arena, int share, int copy_att_vars, UInt arity, Te oldH = H; oldHB = HB; oldASP = ASP; - att_arenap = (Term *)XREGS[arity+4]; newarena = (CELL *)XREGS[arity+3]; arena = Deref(XREGS[arity+2]); t = XREGS[arity+1]; @@ -1071,7 +890,7 @@ p_nb_setarg(void) } if (pos < 1 || pos > arity) return FALSE; - to = CopyTermToArena(ARG3, GlobalArena, FALSE, TRUE, 2, &GlobalArena, &GlobalDelayArena, garena_overflow_size(ArenaPt(GlobalArena))); + to = CopyTermToArena(ARG3, GlobalArena, FALSE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena))); if (to == 0L) return FALSE; destp[pos] = to; @@ -1111,7 +930,7 @@ p_nb_set_shared_arg(void) } if (pos < 1 || pos > arity) return FALSE; - to = CopyTermToArena(ARG3, GlobalArena, TRUE, TRUE, 2, &GlobalArena, &GlobalDelayArena, garena_overflow_size(ArenaPt(GlobalArena))); + to = CopyTermToArena(ARG3, GlobalArena, TRUE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena))); if (to == 0L) return FALSE; destp[pos] = to; @@ -1180,7 +999,7 @@ Yap_SetGlobalVal(Atom at, Term t0) Term to; GlobalEntry *ge; ge = GetGlobalEntry(at); - to = CopyTermToArena(t0, GlobalArena, FALSE, TRUE, 2, &GlobalArena, &GlobalDelayArena, garena_overflow_size(ArenaPt(GlobalArena))); + to = CopyTermToArena(t0, GlobalArena, FALSE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena))); if (to == 0L) return to; WRITE_LOCK(ge->GRWLock); @@ -1193,7 +1012,7 @@ Term Yap_SaveTerm(Term t0) { Term to; - to = CopyTermToArena(t0, GlobalArena, FALSE, TRUE, 2, &GlobalArena, &GlobalDelayArena, garena_overflow_size(ArenaPt(GlobalArena))); + to = CopyTermToArena(t0, GlobalArena, FALSE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena))); if (to == 0L) return to; return to; @@ -1226,7 +1045,7 @@ p_nb_set_shared_val(void) return (FALSE); } ge = GetGlobalEntry(AtomOfTerm(t)); - to = CopyTermToArena(ARG2, GlobalArena, TRUE, TRUE, 2, &GlobalArena, &GlobalDelayArena, garena_overflow_size(ArenaPt(GlobalArena))); + to = CopyTermToArena(ARG2, GlobalArena, TRUE, TRUE, 2, &GlobalArena, garena_overflow_size(ArenaPt(GlobalArena))); if (to == 0L) return FALSE; WRITE_LOCK(ge->GRWLock); @@ -1463,9 +1282,6 @@ static Int nb_queue(UInt arena_sz) { Term queue_arena, queue, ar[5], *nar; -#if COROUTINING - Term delay_queue_arena; -#endif Term t = Deref(ARG1); DepthArenas++; @@ -1476,7 +1292,6 @@ nb_queue(UInt arena_sz) return (FunctorOfTerm(t) == FunctorNBQueue); } ar[QUEUE_ARENA] = - ar[QUEUE_DELAY_ARENA] = ar[QUEUE_HEAD] = ar[QUEUE_TAIL] = ar[QUEUE_SIZE] = @@ -1484,24 +1299,6 @@ nb_queue(UInt arena_sz) queue = Yap_MkApplTerm(FunctorNBQueue,5,ar); if (!Yap_unify(queue,ARG1)) return FALSE; -#if COROUTINING - { - UInt delay_arena_sz = 2; - if (DelayArenaOverflows) { - delay_arena_sz = ((attvar_record *)H0- DelayTop())/16; - if (delay_arena_sz <2) - delay_arena_sz = 2; - if (delay_arena_sz > 256) - delay_arena_sz = 256; - } - delay_queue_arena = NewDelayArena(delay_arena_sz); - if (delay_queue_arena == 0L) { - return FALSE; - } - nar = RepAppl(Deref(ARG1))+1; - nar[QUEUE_DELAY_ARENA] = delay_queue_arena; - } -#endif if (arena_sz < 4*1024) arena_sz = 4*1024; queue_arena = NewArena(arena_sz,1,NULL); @@ -1581,19 +1378,6 @@ GetQueueArena(CELL *qd, char* caller) return t; } -#if COROUTINING -static void -RecoverDelayArena(Term delay_arena) -{ - attvar_record *pt = DelayArenaPt(delay_arena), - *max = DelayTop(); - if (max == pt-DelayArenaSz(delay_arena)) { - SetDelayTop(pt); - } else { - } -} -#endif - static void RecoverArena(Term arena) { @@ -1622,10 +1406,6 @@ p_nb_queue_close(void) } if (qp[QUEUE_ARENA] != MkIntTerm(0)) RecoverArena(qp[QUEUE_ARENA]); -#if COROUTINING - if (qp[QUEUE_DELAY_ARENA] != MkIntTerm(0)) - RecoverDelayArena(qp[QUEUE_DELAY_ARENA]); -#endif if (qp[QUEUE_SIZE] == MkIntTerm(0)) { return Yap_unify(ARG3, ARG2); @@ -1635,7 +1415,6 @@ p_nb_queue_close(void) Yap_unify(ARG2, qp[QUEUE_HEAD]); qp[-1] = (CELL)Yap_MkFunctor(AtomHeap,1); qp[QUEUE_ARENA] = - qp[QUEUE_DELAY_ARENA] = qp[QUEUE_HEAD] = qp[QUEUE_TAIL] = MkIntegerTerm(0); return out; @@ -1662,7 +1441,7 @@ p_nb_queue_enqueue(void) } else { min_size = 0L; } - to = CopyTermToArena(ARG2, arena, FALSE, TRUE, 2, qd+QUEUE_ARENA, qd+QUEUE_DELAY_ARENA, min_size); + to = CopyTermToArena(ARG2, arena, FALSE, TRUE, 2, qd+QUEUE_ARENA, min_size); if (to == 0L) return FALSE; qd = GetQueue(ARG1,"enqueue"); @@ -1811,9 +1590,6 @@ static Int p_nb_heap(void) { Term heap_arena, heap, *ar, *nar; -#if COROUTINING - Term delay_heap_arena; -#endif UInt hsize; Term tsize = Deref(ARG1); UInt arena_sz = (H-H0)/16; @@ -1839,7 +1615,6 @@ p_nb_heap(void) return FALSE; ar = RepAppl(heap)+1; ar[HEAP_ARENA] = - ar[HEAP_DELAY_ARENA] = ar[HEAP_SIZE] = MkIntTerm(0); ar[HEAP_MAX] = tsize; @@ -1851,19 +1626,6 @@ p_nb_heap(void) } nar = RepAppl(Deref(ARG2))+1; nar[HEAP_ARENA] = heap_arena; -#if COROUTINING - arena_sz = ((attvar_record *)H0- DelayTop())/16; - if (arena_sz <2) - arena_sz = 2; - if (arena_sz > 256) - arena_sz = 256; - delay_heap_arena = NewDelayArena(arena_sz); - if (delay_heap_arena == 0L) { - return FALSE; - } - nar = RepAppl(Deref(ARG2))+1; - nar[HEAP_DELAY_ARENA] = delay_heap_arena; -#endif return TRUE; } @@ -1877,10 +1639,6 @@ p_nb_heap_close(void) qp = RepAppl(t)+1; if (qp[HEAP_ARENA] != MkIntTerm(0)) RecoverArena(qp[HEAP_ARENA]); -#if COROUTINING - if (qp[HEAP_DELAY_ARENA] != MkIntTerm(0)) - RecoverDelayArena(qp[HEAP_DELAY_ARENA]); -#endif qp[-1] = (CELL)Yap_MkFunctor(AtomHeap,1); qp[0] = MkIntegerTerm(0); return TRUE; @@ -1994,9 +1752,9 @@ p_nb_heap_add_to_heap(void) if (arena == 0L) return FALSE; mingrow = garena_overflow_size(ArenaPt(arena)); - key = CopyTermToArena(ARG2, arena, FALSE, TRUE, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA, mingrow); + key = CopyTermToArena(ARG2, arena, FALSE, TRUE, 3, qd+HEAP_ARENA, mingrow); arena = qd[HEAP_ARENA]; - to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA, mingrow); + to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, qd+HEAP_ARENA, mingrow); if (key == 0 || to == 0L) return FALSE; qd = GetHeap(ARG1,"add_to_heap"); @@ -2110,9 +1868,6 @@ static Int p_nb_beam(void) { Term beam_arena, beam, *ar, *nar; -#if COROUTINING - Term delay_beam_arena; -#endif UInt hsize; Term tsize = Deref(ARG1); UInt arena_sz = (H-H0)/16; @@ -2137,7 +1892,6 @@ p_nb_beam(void) return FALSE; ar = RepAppl(beam)+1; ar[HEAP_ARENA] = - ar[HEAP_DELAY_ARENA] = ar[HEAP_SIZE] = MkIntTerm(0); ar[HEAP_MAX] = tsize; @@ -2149,19 +1903,6 @@ p_nb_beam(void) } nar = RepAppl(Deref(ARG2))+1; nar[HEAP_ARENA] = beam_arena; -#if COROUTINING - arena_sz = ((attvar_record *)H0- DelayTop())/16; - if (arena_sz <2) - arena_sz = 2; - if (arena_sz > 256) - arena_sz = 256; - delay_beam_arena = NewDelayArena(arena_sz); - if (delay_beam_arena == 0L) { - return FALSE; - } - nar = RepAppl(Deref(ARG2))+1; - nar[HEAP_DELAY_ARENA] = delay_beam_arena; -#endif return TRUE; } @@ -2397,9 +2138,9 @@ p_nb_beam_add_to_beam(void) if (arena == 0L) return FALSE; mingrow = garena_overflow_size(ArenaPt(arena)); - key = CopyTermToArena(ARG2, qd[HEAP_ARENA], FALSE, TRUE, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA, mingrow); + key = CopyTermToArena(ARG2, qd[HEAP_ARENA], FALSE, TRUE, 3, qd+HEAP_ARENA, mingrow); arena = qd[HEAP_ARENA]; - to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, qd+HEAP_ARENA, qd+HEAP_DELAY_ARENA, mingrow); + to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, qd+HEAP_ARENA, mingrow); if (key == 0 || to == 0L) return FALSE; qd = GetHeap(ARG1,"add_to_beam"); From 34ca485e42c1761c43f3310dda5dbd704f24fa20 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 8 Mar 2010 09:23:58 +0000 Subject: [PATCH 13/37] new Atts code. --- C/grow.c | 23 ++--------- C/heapgc.c | 112 ++++++++++---------------------------------------- C/init.c | 2 - C/inlines.c | 6 +-- C/save.c | 13 ------ C/unify.c | 20 ++++----- C/utilpreds.c | 2 +- C/write.c | 9 ++-- 8 files changed, 46 insertions(+), 141 deletions(-) diff --git a/C/grow.c b/C/grow.c index 8df27b0e8..18a4e91ce 100644 --- a/C/grow.c +++ b/C/grow.c @@ -33,10 +33,6 @@ #define strncat(s0,s1,sz) strcat(s0,s1) #endif -#if !COROUTINING -#define DelayTop() H0 -#endif - typedef enum { STACK_SHIFTING = 0, STACK_COPYING = 1, @@ -134,7 +130,6 @@ SetHeapRegs(int copying_threads) OldTR = TR; OldHeapBase = Yap_HeapBase; OldHeapTop = HeapTop; - OldDelayTop = CurrentDelayTop; /* Adjust stack addresses */ Yap_TrailBase = TrailAddrAdjust(Yap_TrailBase); Yap_TrailTop = TrailAddrAdjust(Yap_TrailTop); @@ -172,8 +167,6 @@ SetHeapRegs(int copying_threads) HB = PtoGloAdjust(HB); if (B) B = ChoicePtrAdjust(B); - if (CurrentDelayTop) - CurrentDelayTop = PtoDelayAdjust(CurrentDelayTop); #ifdef TABLING if (B_FZ) B_FZ = ChoicePtrAdjust(B_FZ); @@ -195,12 +188,8 @@ SetHeapRegs(int copying_threads) if (!copying_threads) { if (GlobalArena) GlobalArena = AbsAppl(PtoGloAdjust(RepAppl(GlobalArena))); - if (GlobalDelayArena) - GlobalDelayArena = GlobalAdjust(GlobalDelayArena); } #ifdef COROUTINING - if (DelayedVars) - DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars))); if (AttsMutableList) AttsMutableList = AbsAppl(PtoGloAdjust(RepAppl(AttsMutableList))); if (WokenGoals) @@ -256,7 +245,7 @@ worker_p_binding(int worker_p, CELL *aux_ptr) reg = AdjustGlobTerm(reg); return reg; } else { - CELL reg = ThreadHandle[worker_p].current_yaam_regs->H0_[aux_ptr-H0]; + CELL reg = ThreadHandle[worker_p].current_yaam_regs-> H0_[aux_ptr-H0]; reg = AdjustGlobTerm(reg); return reg; } @@ -567,12 +556,12 @@ AdjustGlobal(long sz, int thread_copying) pt_max = (CELL *) (LOCAL_end_global_copy); } else { #endif - pt = CurrentDelayTop; + pt = H0; pt_max = (H-sz/CellSize); #if defined(YAPOR) && defined(THREADS) } #endif - pt = CurrentDelayTop; + pt = H0; while (pt < pt_max) { CELL reg; @@ -777,7 +766,6 @@ static_growheap(long size, int fix_code, struct intermediates *cip, tr_fr_ptr *o int gc_verbose; UInt minimal_request = 0L; - CurrentDelayTop = (CELL *)DelayTop(); /* adjust to a multiple of 256) */ if (size < YAP_ALLOC_SIZE) size = YAP_ALLOC_SIZE; @@ -859,7 +847,7 @@ static_growglobal(long request, CELL **ptr, CELL *hsplit) { UInt start_growth_time, growth_time; int gc_verbose; - char *omax = (ADDR)DelayTop(); + char *omax = (char *)H0; ADDR old_GlobalBase = Yap_GlobalBase; UInt minimal_request = 0L; long size = request; @@ -874,7 +862,6 @@ static_growglobal(long request, CELL **ptr, CELL *hsplit) do_grow is whether we expand stacks */ - CurrentDelayTop = (CELL *)omax; if (hsplit) { /* just a little bit of sanity checking */ if (hsplit < H0 && hsplit > (CELL *)Yap_GlobalBase) { @@ -1492,7 +1479,6 @@ execute_growstack(long size0, int from_trail, int in_parser, tr_fr_ptr *old_trp, long size = size0; ADDR old_Yap_GlobalBase = Yap_GlobalBase; - CurrentDelayTop = (CELL *)DelayTop(); if (!Yap_AllowGlobalExpansion) { Yap_ErrorMessage = "Database crashed against stacks"; return FALSE; @@ -1869,7 +1855,6 @@ Yap_CopyThreadStacks(int worker_q, int worker_p, int incremental) Yap_REGS.CUT_C_TOP = ThreadHandle[worker_p].current_yaam_regs->CUT_C_TOP; #endif DelayedVars = ThreadHandle[worker_p].current_yaam_regs->DelayedVars_; - CurrentDelayTop = (CELL *)DelayTop(); DynamicArrays = NULL; StaticArrays = NULL; GlobalVariables = NULL; diff --git a/C/heapgc.c b/C/heapgc.c index 9b8068e33..8beccde02 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -34,8 +34,8 @@ static char SccsId[] = "%W% %G%"; STATIC_PROTO(Int p_inform_gc, (void)); STATIC_PROTO(Int p_gc, (void)); STATIC_PROTO(void push_registers, (Int, yamop *)); -STATIC_PROTO(void marking_phase, (tr_fr_ptr, CELL *, yamop *, CELL *)); -STATIC_PROTO(void compaction_phase, (tr_fr_ptr, CELL *, yamop *, CELL *)); +STATIC_PROTO(void marking_phase, (tr_fr_ptr, CELL *, yamop *)); +STATIC_PROTO(void compaction_phase, (tr_fr_ptr, CELL *, yamop *)); STATIC_PROTO(void pop_registers, (Int, yamop *)); STATIC_PROTO(void init_dbtable, (tr_fr_ptr)); STATIC_PROTO(void mark_db_fixed, (CELL *)); @@ -442,7 +442,6 @@ push_registers(Int num_regs, yamop *nextop) ArrayEntry *al = DynamicArrays; GlobalEntry *gl = GlobalVariables; TrailTerm(TR++) = GlobalArena; - TrailTerm(TR++) = GlobalDelayArena; while (al) { check_pr_trail(TR); TrailTerm(TR++) = al->ValueOfVE; @@ -474,8 +473,7 @@ push_registers(Int num_regs, yamop *nextop) #ifdef COROUTINING TrailTerm(TR) = WokenGoals; TrailTerm(TR+1) = AttsMutableList; - TrailTerm(TR+2) = DelayedVars; - TR += 3; + TR += 2; #endif for (i = 1; i <= num_regs; i++) { check_pr_trail(TR); @@ -521,7 +519,6 @@ pop_registers(Int num_regs, yamop *nextop) GlobalEntry *gl = GlobalVariables; GlobalArena = TrailTerm(ptr++); - GlobalDelayArena = TrailTerm(ptr++); while (al) { al->ValueOfVE = TrailTerm(ptr++); al = al->NextAE; @@ -549,7 +546,6 @@ pop_registers(Int num_regs, yamop *nextop) #ifdef MULTI_ASSIGNMENT_VARIABLES WokenGoals = TrailTerm(ptr++); AttsMutableList = TrailTerm(ptr++); - DelayedVars = TrailTerm(ptr++); #endif #endif for (i = 1; i <= num_regs; i++) @@ -1580,6 +1576,18 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap) } } +static void +mark_att_var(CELL *hp) +{ + attvar_record *attv = RepAttVar(hp); + Functor *cptr = &(attv->AttFunc); + mark_external_reference2(CellPtr(cptr)); + mark_external_reference2(&attv->Done); + mark_external_reference2(&attv->Value); + mark_external_reference2(&attv->Atts); +} + + /* Cleaning the trail should be quick and simple, right? Well, not really :-(. The problem is that the trail includes a dumping ground @@ -1596,20 +1604,6 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap) */ -static void -mark_att_var(CELL *hp) -{ - attvar_record *top = (attvar_record *)Yap_GlobalBase; - Int relpos = top-(attvar_record *)hp; - attvar_record *attv = top-relpos; - if (attv != (attvar_record *)hp) - attv--; - mark_external_reference2(&attv->Done); - mark_external_reference2(&attv->Value); - mark_external_reference2(&attv->Atts); -} - - static void mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B) { @@ -1652,7 +1646,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B #endif discard_trail_entries++; } else { - if ( hp > (CELL*)Yap_GlobalBase && hp < H0) { + if ( IsAttVar(hp)) { if (!detatt || hp >= detatt) { mark_att_var(hp); } else { @@ -1712,9 +1706,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B */ if (cptr < (CELL *)gc_B && cptr >= gc_H) { goto remove_trash_entry; - } else if (!detatt && cptr == RepAppl(DelayedVars)+1) { - /* detatt = cptr; */ - } else if (cptr > (CELL*)Yap_GlobalBase && cptr < H0) { + } else if (IsAttVar(cptr)) { /* MABINDING that should be recovered */ if (detatt && cptr < detatt) { goto remove_trash_entry; @@ -1847,24 +1839,6 @@ mark_slots(CELL *ptr) } -#ifdef COROUTINING -static void -mark_delays(attvar_record *top, attvar_record *bottom) -{ - attvar_record *attv = (attvar_record *)top; - for (; attv < bottom; attv++) { - /* only mark what is accessible */ - if (IsVarTerm(attv->Done) && IsUnboundVar(&attv->Done)) { - mark_external_reference2(&attv->Done); - mark_external_reference2(&attv->Value); - mark_external_reference2(&attv->Atts); - } - } -} -#else -#define mark_delays(T,B) -#endif - #ifdef TABLING static choiceptr youngest_cp(choiceptr gc_B, dep_fr_ptr *depfrp) @@ -3595,7 +3569,7 @@ set_conditionals(tr_fr_ptr str) { */ static void -marking_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max) +marking_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp) { #ifdef EASY_SHUNTING @@ -3615,7 +3589,6 @@ marking_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max) values */ mark_regs(old_TR); /* active registers & trail */ /* active environments */ - mark_delays((attvar_record *)max, (attvar_record *)H0); mark_environments(current_env, EnvSize(curp), EnvBMap(curp)); mark_choicepoints(B, old_TR, is_gc_very_verbose()); /* choicepoints, and environs */ #ifdef EASY_SHUNTING @@ -3640,22 +3613,6 @@ sweep_oldgen(CELL *max, CELL *base) } } -#ifdef COROUTINING -static void -sweep_delays(CELL *max, CELL *myH0) -{ - while (max < myH0) { - if (MARKED_PTR(max)) { - UNMARK(max); - if (HEAP_PTR(*max)) { - into_relocation_chain(max, GET_NEXT(*max)); - } - } - max++; - } -} -#endif - /* * move marked heap objects upwards over unmarked objects, and reset all @@ -3663,9 +3620,9 @@ sweep_delays(CELL *max, CELL *myH0) */ static void -compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max) +compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp) { - CELL *CurrentH0 = NULL, *myH0 = H0; + CELL *CurrentH0 = NULL; int icompact = (iptop < (CELL_PTR *)ASP && 10*total_marked < H-H0); @@ -3682,9 +3639,6 @@ compaction_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max) sweep_oldgen(HGEN, CurrentH0); } } -#ifdef COROUTINING - sweep_delays(max, myH0); -#endif sweep_environments(current_env, EnvSize(curp), EnvBMap(curp)); sweep_choicepoints(B); sweep_trail(B, old_TR); @@ -3738,7 +3692,6 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop) int gc_verbose; volatile tr_fr_ptr old_TR = NULL; UInt m_time, c_time, time_start, gc_time; - CELL *max; Int effectiveness, tot; int gc_trace; UInt gc_phase; @@ -3795,24 +3748,9 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop) } current_env = (CELL *)*ASP; ASP++; -#if COROUTINING - max = (CELL *)DelayTop(); -#endif } #endif time_start = Yap_cputime(); -#if COROUTINING - max = (CELL *)DelayTop(); - while (max - (CELL*)Yap_GlobalBase < 1024+(2*NUM_OF_ATTS)) { - if (!Yap_growglobal(¤t_env)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); - return -1; - } - max = (CELL *)DelayTop(); - } -#else - max = NULL; -#endif if (setjmp(Yap_gc_restore) == 2) { UInt sz; @@ -3838,9 +3776,6 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop) discard_trail_entries = 0; current_env = (CELL *)*ASP; ASP++; -#if COROUTINING - max = (CELL *)DelayTop(); -#endif } } #if EASY_SHUNTING @@ -3862,9 +3797,6 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop) return -1; current_env = (CELL *)*ASP; ASP++; -#if COROUTINING - max = (CELL *)DelayTop(); -#endif } memset((void *)Yap_bp, 0, alloc_sz); #ifdef HYBRID_SCHEME @@ -3882,7 +3814,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop) OldTR = (tr_fr_ptr)(old_TR = TR); push_registers(predarity, nextop); /* make sure we clean bits after a reset */ - marking_phase(old_TR, current_env, nextop, max); + marking_phase(old_TR, current_env, nextop); if (total_oldies > ((HGEN-H0)*8)/10) { total_marked -= total_oldies; tot = total_marked+(HGEN-H0); @@ -3922,7 +3854,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop) #endif } time_start = m_time; - compaction_phase(old_TR, current_env, nextop, max); + compaction_phase(old_TR, current_env, nextop); TR = old_TR; pop_registers(predarity, nextop); TR = new_TR; diff --git a/C/init.c b/C/init.c index 50c9f0816..25d5b8fa8 100755 --- a/C/init.c +++ b/C/init.c @@ -1167,7 +1167,6 @@ InitCodes(void) Yap_heap_regs->wl[i].global_variables = NULL; Yap_heap_regs->wl[i].global_arena = 0L; Yap_heap_regs->wl[i].global_arena_overflows = 0; - Yap_heap_regs->wl[i].global_delay_arena = 0L; Yap_heap_regs->wl[i].allow_restart = FALSE; Yap_heap_regs->wl[i].tot_gc_time = 0; Yap_heap_regs->wl[i].tot_gc_recovered = 0; @@ -1193,7 +1192,6 @@ InitCodes(void) Yap_heap_regs->wl.global_arena = 0L; Yap_heap_regs->wl.global_arena_overflows = 0; Yap_heap_regs->wl.allow_restart = FALSE; - Yap_heap_regs->wl.global_delay_arena = 0L; Yap_heap_regs->wl.tot_gc_time = 0; Yap_heap_regs->wl.tot_gc_recovered = 0; Yap_heap_regs->wl.gc_calls = 0; diff --git a/C/inlines.c b/C/inlines.c index dfdadc9c8..0fc73ccc2 100755 --- a/C/inlines.c +++ b/C/inlines.c @@ -628,7 +628,7 @@ p_functor(void) /* functor(?,?,?) */ BIND(pt0, d0, bind_func_nvar_var); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_func_nvar_var: #endif /* have to buffer ENDP and label */ @@ -655,7 +655,7 @@ p_functor(void) /* functor(?,?,?) */ /* Done */ #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_func_nvar3_var: #endif return(TRUE); @@ -738,7 +738,7 @@ p_functor(void) /* functor(?,?,?) */ BIND(pt0, d0, bind_func_var_3nvar); #ifdef COROUTINING DO_TRAIL(pt0, d0); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_func_var_3nvar: #endif return(TRUE); diff --git a/C/save.c b/C/save.c index e9824f5da..cbd6bf567 100755 --- a/C/save.c +++ b/C/save.c @@ -409,9 +409,6 @@ save_regs(int mode) putcellptr((CELL *)P); putout(CreepFlag); putout(EX); -#ifdef COROUTINING - putout(DelayedVars); -#endif #if defined(SBA) || defined(TABLING) putcellptr(H_FZ); putcellptr((CELL *)B_FZ); @@ -807,11 +804,6 @@ get_regs(int flag) EX = get_cell(); if (Yap_ErrorMessage) return -1; -#ifdef COROUTINING - DelayedVars = get_cell(); - if (Yap_ErrorMessage) - return -1; -#endif #if defined(SBA) || defined(TABLING) H_FZ = get_cellptr(); if (Yap_ErrorMessage) @@ -1035,12 +1027,7 @@ restore_regs(int flag) S = PtoGloAdjust(S); if (EX) EX = AbsAppl(PtoGloAdjust(RepAppl(EX))); -#ifdef COROUTINING - DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars))); -#ifdef MULTI_ASSIGNMENT_VARIABLES WokenGoals = AbsAppl(PtoGloAdjust(RepAppl(WokenGoals))); -#endif -#endif } } diff --git a/C/unify.c b/C/unify.c index e5a04e281..77d0431d6 100644 --- a/C/unify.c +++ b/C/unify.c @@ -259,7 +259,7 @@ loop: BIND_GLOBAL(ptd1, d0, bind_ocunify1); #ifdef COROUTINING DO_TRAIL(ptd1, d0); - if (ptd1 < H0) Yap_WakeUp(ptd1); + if (IsAttVar(ptd1)) Yap_WakeUp(ptd1); bind_ocunify1: #endif if (Yap_rational_tree_loop(ptd1-1, ptd1, (CELL **)to_visit, (CELL **)unif)) @@ -282,7 +282,7 @@ loop: BIND_GLOBAL(ptd0, d1, bind_ocunify2); #ifdef COROUTINING DO_TRAIL(ptd0, d1); - if (ptd0 < H0) Yap_WakeUp(ptd0); + if (IsAttVar(ptd0)) Yap_WakeUp(ptd0); bind_ocunify2: #endif if (Yap_rational_tree_loop(ptd0-1, ptd0, (CELL **)to_visit, (CELL **)unif)) @@ -403,7 +403,7 @@ oc_unify_nvar_nvar: BIND(pt1, d0, bind_ocunify4); #ifdef COROUTINING DO_TRAIL(pt1, d0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); bind_ocunify4: #endif /* local variables cannot be in a term */ @@ -421,7 +421,7 @@ oc_unify_var_nvar: BIND(pt0, d1, bind_ocunify5); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_ocunify5: #endif /* local variables cannot be in a term */ @@ -436,14 +436,14 @@ oc_unify_var_nvar: UnifyCells(pt0, pt1, uc1, uc2); #ifdef COROUTINING DO_TRAIL(pt0, (CELL)pt1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); uc1: #endif return (TRUE); #ifdef COROUTINING uc2: DO_TRAIL(pt1, (CELL)pt0); - if (pt1 < H0) { + if (IsAttVar(pt1)) { Yap_WakeUp(pt1); } #endif @@ -550,7 +550,7 @@ unify_nvar_nvar: BIND(pt1, d0, bind_unify3); #ifdef COROUTINING DO_TRAIL(pt1, d0); - if (pt1 < H0) Yap_WakeUp(pt1); + if (IsAttVar(pt1)) Yap_WakeUp(pt1); bind_unify3: #endif return (TRUE); @@ -563,7 +563,7 @@ unify_var_nvar: BIND(pt0, d1, bind_unify4); #ifdef COROUTINING DO_TRAIL(pt0, d1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); bind_unify4: #endif return TRUE; @@ -579,14 +579,14 @@ unify_var_nvar_trail: UnifyCells(pt0, pt1, uc1, uc2); #ifdef COROUTINING DO_TRAIL(pt0, (CELL)pt1); - if (pt0 < H0) Yap_WakeUp(pt0); + if (IsAttVar(pt0)) Yap_WakeUp(pt0); uc1: #endif return (TRUE); #ifdef COROUTINING uc2: DO_TRAIL(pt1, (CELL)pt0); - if (pt1 < H0) { + if (IsAttVar(pt1)) { Yap_WakeUp(pt1); } return (TRUE); diff --git a/C/utilpreds.c b/C/utilpreds.c index 32e92df19..f478822f8 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -254,7 +254,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, struct cp_frame *bp[1]; if (dvars == NULL) { - dvars = (CELL *)DelayTop(); + dvars = H0; } if (ptd0 < dvars) { *ptf++ = (CELL) ptd0; diff --git a/C/write.c b/C/write.c index adffe0da6..4d594d8f8 100644 --- a/C/write.c +++ b/C/write.c @@ -406,8 +406,8 @@ write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt) wrputc('_', wglb->writewch); /* make sure we don't get no creepy spaces where they shouldn't be */ lastw = separator; - if (CellPtr(t) < H0) { - Int vcount = (H0-t); + if (IsAttVar(t)) { + Int vcount = (t-H0); #if COROUTINING #if DEBUG if (Yap_Portray_delays) { @@ -415,7 +415,7 @@ write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt) Yap_Portray_delays = FALSE; if (ext == attvars_ext) { - attvar_record *attv = (attvar_record *)t; + attvar_record *attv = RepAttVar(t); long sl = 0; Term l = attv->Atts; @@ -613,6 +613,9 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb, str case (CELL)FunctorDouble: wrputf(FloatOfTerm(t),wglb->writewch); return; + case (CELL)FunctorAttVar: + write_var(RepAppl(t)+1, wglb, &nrwt); + return; case (CELL)FunctorDBRef: wrputref(RefOfTerm(t), wglb->Quote_illegal, wglb->writewch); return; From 53b482800073cd4b034a6d7676bfec029e3e383d Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 8 Mar 2010 09:24:11 +0000 Subject: [PATCH 14/37] new Atts Code. --- H/Regs.h | 6 ------ H/TermExt.h | 13 ++++++++++--- H/YapHeap.h | 5 ----- H/Yapproto.h | 1 + H/Yatom.h | 1 + H/amidefs.h | 24 ++++++++++++++++++++++++ H/attvar.h | 18 +++++++++--------- H/rheap.h | 4 ---- 8 files changed, 45 insertions(+), 27 deletions(-) diff --git a/H/Regs.h b/H/Regs.h index 934c67d67..d51a155b0 100644 --- a/H/Regs.h +++ b/H/Regs.h @@ -110,9 +110,6 @@ typedef struct ADDR AuxTop_; /* 10 Auxiliary stack top */ /* visualc*/ CELL EX_; /* 18 */ -#ifdef COROUTINING - Term DelayedVars_; /* maximum number of attributed variables */ -#endif Term CurrentModule_; #if defined(SBA) || defined(TABLING) CELL *H_FZ_; @@ -697,9 +694,6 @@ EXTERN inline void restore_B(void) { #define frame_tail Yap_REGS.frame_tail_ #endif /* SBA */ #endif /* YAPOR */ -#ifdef COROUTINING -#define DelayedVars Yap_REGS.DelayedVars_ -#endif #if defined(YAPOR) || defined(TABLING) #define LOCAL Yap_REGS.LOCAL_ #endif diff --git a/H/TermExt.h b/H/TermExt.h index b893ac534..55359db18 100644 --- a/H/TermExt.h +++ b/H/TermExt.h @@ -58,6 +58,14 @@ blob_type; #define FunctorDouble ((Functor)(double_e)) #define EndSpecials (double_e+sizeof(Functor *)) +inline EXTERN int IsAttVar (CELL *pt); + +inline EXTERN int +IsAttVar (CELL *pt) +{ + return (pt)[-1] == (CELL)attvar_e; +} + typedef enum { BIG_INT = 0x01, @@ -452,7 +460,7 @@ inline EXTERN Int IsAttachedTerm (Term); inline EXTERN Int IsAttachedTerm (Term t) { - return (Int) ((IsVarTerm (t) && VarOfTerm (t) < H0)); + return (Int) ((IsVarTerm (t) && IsAttVar(VarOfTerm(t)))); } @@ -463,8 +471,7 @@ inline EXTERN Int SafeIsAttachedTerm (Term); inline EXTERN Int SafeIsAttachedTerm (Term t) { - return (Int) ((IsVarTerm (t) && VarOfTerm (t) < H0 - && VarOfTerm (t) >= (CELL *) Yap_GlobalBase)); + return (Int) (IsVarTerm (t) && IsAttVar(VarOfTerm(t))); } diff --git a/H/YapHeap.h b/H/YapHeap.h index 86eca7411..29ba8e612 100755 --- a/H/YapHeap.h +++ b/H/YapHeap.h @@ -91,7 +91,6 @@ typedef struct restore_info { CELL *g_split; tr_fr_ptr old_TR; CELL *old_GlobalBase, *old_H, *old_H0; - CELL *old_DelayTop, *current_DelayTop; ADDR old_TrailBase, old_TrailTop; ADDR old_HeapBase, old_HeapTop; } restoreinfo; @@ -183,7 +182,6 @@ typedef struct worker_local_struct { int allow_restart; Term global_arena; UInt global_arena_overflows; - Term global_delay_arena; yamop trust_lu_code[3]; #if (defined(YAPOR) || defined(TABLING) ) && defined(THREADS) #ifdef YAPOR @@ -293,8 +291,6 @@ extern struct various_codes *Yap_heap_regs; #define OldTrailTop RINFO.old_TrailTop #define OldHeapBase RINFO.old_HeapBase #define OldHeapTop RINFO.old_HeapTop -#define OldDelayTop RINFO.old_DelayTop -#define CurrentDelayTop RINFO.current_DelayTop #define ClDiff RINFO.cl_diff #define GDiff RINFO.g_diff #define GDiff0 RINFO.g_diff0 @@ -360,7 +356,6 @@ extern struct various_codes *Yap_heap_regs; #define GlobalArena Yap_heap_regs->WL.global_arena #define GlobalArenaOverflows Yap_heap_regs->WL.global_arena_overflows #define Yap_AllowRestart Yap_heap_regs->WL.allow_restart -#define GlobalDelayArena Yap_heap_regs->WL.global_delay_arena #define PredHashInitialSize 1039L #define PredHashIncrement 7919L diff --git a/H/Yapproto.h b/H/Yapproto.h index 65826d352..6bf271e5c 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -190,6 +190,7 @@ void STD_PROTO(Yap_inform_profiler_of_clause,(struct yami *,struct yami *,struct /* globals.c */ Term STD_PROTO(Yap_NewArena,(UInt,CELL *)); +CELL *STD_PROTO(Yap_GetFromArena,(Term *,UInt,UInt)); void STD_PROTO(Yap_InitGlobals,(void)); Term STD_PROTO(Yap_SaveTerm, (Term)); Term STD_PROTO(Yap_SetGlobalVal, (Atom, Term)); diff --git a/H/Yatom.h b/H/Yatom.h index 900f0596a..5496ed230 100644 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -216,6 +216,7 @@ typedef struct global_entry struct AtomEntryStruct *AtomOfGE; /* parent atom for deletion */ struct global_entry *NextGE; /* linked list of global entries */ Term global; /* index in module table */ + Term AttChain; /* index in module table */ } GlobalEntry; diff --git a/H/amidefs.h b/H/amidefs.h index 5e7dc7553..428cf8d9d 100644 --- a/H/amidefs.h +++ b/H/amidefs.h @@ -65,6 +65,30 @@ #include #endif +#ifdef FROZEN_STACKS +#ifdef SBA +#define PROTECT_FROZEN_H(CPTR) \ + ((Unsigned((Int)((CPTR)->cp_h)-(Int)(H_FZ)) < \ + Unsigned((Int)(B_FZ)-(Int)(H_FZ))) ? \ + (CPTR)->cp_h : H_FZ) +#define PROTECT_FROZEN_B(CPTR) \ + ((Unsigned((Int)(CPTR)-(Int)(H_FZ)) < \ + Unsigned((Int)(B_FZ)-(Int)(H_FZ))) ? \ + (CPTR) : B_FZ) + /* +#define PROTECT_FROZEN_H(CPTR) ((CPTR)->cp_h > H_FZ && (CPTR)->cp_h < (CELL *)B_FZ ? (CPTR)->cp_h : H_FZ ) + +#define PROTECT_FROZEN_B(CPTR) ((CPTR) < B_FZ && (CPTR) > (choiceptr)H_FZ ? (CPTR) : B_FZ ) + */ +#else /* TABLING */ +#define PROTECT_FROZEN_B(CPTR) (YOUNGER_CP(CPTR, B_FZ) ? CPTR : B_FZ) +#define PROTECT_FROZEN_H(CPTR) (((CPTR)->cp_h > H_FZ) ? (CPTR)->cp_h : H_FZ) +#endif /* SBA */ +#else +#define PROTECT_FROZEN_B(CPTR) (CPTR) +#define PROTECT_FROZEN_H(CPTR) (CPTR)->cp_h +#endif /* FROZEN_STACKS */ + #if ALIGN_LONGS /* */ typedef Int DISPREG; /* */ typedef CELL SMALLUNSGN; diff --git a/H/attvar.h b/H/attvar.h index efe4493b7..e1ed2747c 100644 --- a/H/attvar.h +++ b/H/attvar.h @@ -42,24 +42,24 @@ Each attribute contains; */ typedef struct attvar_struct { + Functor AttFunc; /* functor for attvar */ Term Done; /* if unbound suspension active, if bound terminated */ Term Value; /* value the variable will take */ Term Atts; /* actual data */ } attvar_record; +#define ATT_RECORD_ARITY 3 + /*********** tags for suspension variables */ -#define AbsAttVar(attvar_ptr) AbsAppl(((CELL *)(attvar_ptr))) -#define RepAttVar(val) ((attvar_record *)RepAppl(val)) - -static inline attvar_record * -DelayTop(void) { - return (attvar_record *)Yap_ReadTimedVar(DelayedVars); +static inline Term +AbsAttVar(attvar_record *attvar_ptr) { + return attvar_ptr->Done; } -static inline void -SetDelayTop(attvar_record *new_top) { - Yap_UpdateTimedVar(DelayedVars, (CELL)new_top); +static inline attvar_record * +RepAttVar(Term *var_ptr) { + return (attvar_record *)(var_ptr-1); } #endif diff --git a/H/rheap.h b/H/rheap.h index 1c4041c1a..9e125abca 100755 --- a/H/rheap.h +++ b/H/rheap.h @@ -1024,10 +1024,6 @@ restore_codes(void) AbsAppl(PtoGloAdjust(RepAppl(Yap_heap_regs->wl.global_arena))); } } - if (Yap_heap_regs->wl.global_delay_arena) { - Yap_heap_regs->wl.global_delay_arena = - GlobalAdjust(Yap_heap_regs->wl.global_delay_arena); - } Yap_heap_regs->wl.allow_restart = FALSE; #endif #endif From dd3645b5c82095863b9c8a27886752cb27c25443 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 8 Mar 2010 09:24:24 +0000 Subject: [PATCH 15/37] move to SWI like interface. --- pl/corout.yap | 56 ++++++++++++++------------------------------------- 1 file changed, 15 insertions(+), 41 deletions(-) diff --git a/pl/corout.yap b/pl/corout.yap index 21509fcea..d5d8b0521 100644 --- a/pl/corout.yap +++ b/pl/corout.yap @@ -37,17 +37,27 @@ '$show_frozen_goals'(Level))). '$project_and_delayed_goals'(G,LGs) :- - attributes:all_attvars(LAV), + '$att_vars'(G, LAV), LAV = [_|_], !, % SICStus compatible step, % just try to simplify store by projecting constraints % over query variables. '$project_attributes'(LAV, G), % now get a list of frozen goals. - attributes:all_attvars(NLAV), + '$att_vars'(G, NLAV), '$get_goalist_from_attvars'(NLAV, LGs). '$project_and_delayed_goals'(_,[]). +'$att_vars'(Term, LAV) :- + term_variables(Term, TVars), + '$select_atts'(TVars, LAV). + +'$select_atts'([], []). +'$select_atts'(V.TVars, V.LAV) :- + attvar(V), !, + '$select_atts'(TVars, LAV). +'$select_atts'(V.TVars, LAV) :- + '$select_atts'(TVars, LAV). % % wake_up_goal is called by the system whenever a suspended goal @@ -553,7 +563,8 @@ frozen(V, LG) :- '$fetch_same_done_goals'(G0, D0, LV, GF). -call_residue_vars(Goal,Residue) :- +/* +call_residue_vars(Goal,Vars) :- attributes:all_attvars(Vs0), call(Goal), attributes:all_attvars(Vs), @@ -575,50 +586,13 @@ call_residue_vars(Goal,Residue) :- ; '$ord_remove'([V1|Vss], Vs0s, Residue) ). +*/ copy_term(Term, Copy, Goals) :- term_variables(Term, TVars), '$get_goalist_from_attvars'(TVars, Goals0), copy_term_nat([Term|Goals0], [Copy|Goals]). -call_residue(Goal,Residue) :- - var(Goal), !, - '$do_error'(instantiation_error,call_residue(Goal,Residue)). -call_residue(Module:Goal,Residue) :- - atom(Module), !, - '$call_residue'(Goal,Module,Residue). -call_residue(Goal,Residue) :- - '$current_module'(Module), - '$call_residue'(Goal,Module,Residue). - -'$call_residue'(Goal,Module,Residue) :- - '$read_svar_list'(OldAttsList), - copy_term_nat(Goal, NGoal), - ( '$set_svar_list'(CurrentAttsList), - '$system_catch'(NGoal,Module,Error,'$residue_catch_trap'(Error,OldAttsList)), - '$project_and_delayed_goals'(NGoal,Residue0), - '$add_vs_to_vlist'(Residue0, Residue), - ( '$set_svar_list'(OldAttsList), - copy_term_nat(NGoal+NResidue, Goal+Residue) - ; - '$set_svar_list'(CurrentAttsList), fail - ) - ; - '$set_svar_list'(OldAttsList), fail - ). - -'$add_vs_to_vlist'([], []). -'$add_vs_to_vlist'([G|Residue0], [Vs-G|Residue]) :- - term_variables(G, TVs), - '$pick_att_vars'(TVs, Vs), - '$add_vs_to_vlist'(Residue0, Residue). - - -% make sure we set the suspended goal list to its previous state! -'$residue_catch_trap'(Error,OldAttsList) :- - '$set_svar_list'(OldAttsList), - throw(Error). - % make sure we have installed a SICStus like constraint solver. '$project_attributes'(_, _) :- '$undefined'(modules_with_attributes(_),attributes), !. From bb3c837ec5de375908b0df9287391a91fa60ee74 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 9 Mar 2010 22:00:46 +0000 Subject: [PATCH 16/37] fix unnecessary choicepoint in [a]. --- pl/consult.yap | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pl/consult.yap b/pl/consult.yap index 6a825be09..acda552b7 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -43,7 +43,7 @@ load_files(Files,Opts) :- '$check_files'(Files,Call) :- var(Files), !, '$do_error'(instantiation_error,Call). -'$check_files'(M:Files,Call) :- +'$check_files'(M:Files,Call) :- !, (var(M) -> '$do_error'(instantiation_error,Call) From 2c53542bb11dd4be45c3629f0661078d8560bdc1 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 9 Mar 2010 22:01:42 +0000 Subject: [PATCH 17/37] fix error handling. --- C/cmppreds.c | 23 ++++++++++++++++------- 1 file changed, 16 insertions(+), 7 deletions(-) diff --git a/C/cmppreds.c b/C/cmppreds.c index c829f54e9..795b522c5 100644 --- a/C/cmppreds.c +++ b/C/cmppreds.c @@ -643,8 +643,11 @@ p_acomp(void) { /* $a_compare(?R,+X,+Y) */ Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); + Int out; - return a_cmp(t1, t2); + out = a_cmp(t1, t2); + if (ArithError) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); return FALSE; } + return out; } static Int @@ -675,42 +678,48 @@ a_eq(Term t1, Term t2) } } out = a_cmp(t1,t2); - return !ArithError && (out == 0); + if (ArithError) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); return FALSE; } + return out == 0; } static Int a_dif(Term t1, Term t2) { Int out = a_cmp(Deref(t1),Deref(t2)); - return !ArithError && out != 0; + if (ArithError) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); return FALSE; } + return out != 0; } static Int a_gt(Term t1, Term t2) { /* A > B */ Int out = a_cmp(Deref(t1),Deref(t2)); - return !ArithError && out > 0; + if (ArithError) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); return FALSE; } + return out > 0; } static Int a_ge(Term t1, Term t2) { /* A >= B */ Int out = a_cmp(Deref(t1),Deref(t2)); - return !ArithError && out >= 0; + if (ArithError) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); return FALSE; } + return out >= 0; } static Int a_lt(Term t1, Term t2) { /* A < B */ Int out = a_cmp(Deref(t1),Deref(t2)); - return !ArithError && out < 0; + if (ArithError) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); return FALSE; } + return out < 0; } static Int a_le(Term t1, Term t2) { /* A <= B */ Int out = a_cmp(Deref(t1),Deref(t2)); - return !ArithError && out <= 0; + if (ArithError) { Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage); return FALSE; } + return out <= 0; } From 4a6bfe1fa064b5e06efd43bd6f39a965657839eb Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 9 Mar 2010 22:03:00 +0000 Subject: [PATCH 18/37] avoid unnecessary term construction. --- C/arith1.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/C/arith1.c b/C/arith1.c index 683f6b620..645b251ae 100644 --- a/C/arith1.c +++ b/C/arith1.c @@ -624,7 +624,7 @@ eval1(Int fi, Term t) { case long_int_e: RFLOAT(IntegerOfTerm(t)); case double_e: - RFLOAT(FloatOfTerm(t)); + return t; case big_int_e: #ifdef USE_GMP RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t))); From 3d10482cc7b225a3e07d3e26428d69e60b446cff Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Wed, 10 Mar 2010 14:06:07 +0000 Subject: [PATCH 19/37] more upgrades to new coroutining code. --- C/attvar.c | 69 ++++++++++++++++++++++++++++++++++++++++++++++++--- C/heapgc.c | 44 ++++++++++++++++++++++---------- C/utilpreds.c | 43 ++++++++++++++------------------ pl/corout.yap | 56 ++++++++++++++++++++++++++++++----------- 4 files changed, 157 insertions(+), 55 deletions(-) diff --git a/C/attvar.c b/C/attvar.c index 7c48d50f9..e64073917 100644 --- a/C/attvar.c +++ b/C/attvar.c @@ -79,7 +79,6 @@ BuildNewAttVar(void) RESET_VARIABLE(&(newv->Value)); RESET_VARIABLE(&(newv->Done)); RESET_VARIABLE(&(newv->Atts)); - HB = PROTECT_FROZEN_H(B); return newv; } @@ -104,7 +103,6 @@ CopyAttVar(CELL *orig, struct cp_frame **to_visit_ptr, CELL *res) to_visit->to = &(newv->Atts); } to_visit->oldv = vt[-1]; - /* you're coming from a variable */ to_visit->ground = FALSE; *to_visit_ptr = to_visit+1; *res = (CELL)&(newv->Done); @@ -879,10 +877,75 @@ p_swi_all_atts(void) { } } + +static Term +AllAttVars(void) { + CELL *pt = H0; + CELL *myH = H; + + while (pt < H) { + switch(*pt) { + case (CELL)FunctorAttVar: + if (IsUnboundVar(pt+1)) { + if (ASP - myH < 1024) { + Yap_Error_Size = (ASP-H)*sizeof(CELL); + return 0L; + } + if (myH != H) { + myH[-1] = AbsPair(myH); + } + myH[0] = AbsAttVar((attvar_record *)pt); + myH += 2; + } + pt += (1+ATT_RECORD_ARITY); + break; + case (CELL)FunctorDouble: +#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT + pt += 4; +#else + pt += 3; +#endif + break; + case (CELL)FunctorBigInt: + { + Int sz = 3 + + (sizeof(MP_INT)+ + (((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL); + pt += sz; + } + break; + case (CELL)FunctorLongInt: + pt += 3; + break; + default: + pt++; + } + } + if (myH != H) { + Term out = AbsPair(H); + myH[-1] = TermNil; + H = myH; + return out; + } else { + return TermNil; + } +} + static Int p_all_attvars(void) { - return Yap_unify(ARG1,TermNil); + do { + Term out; + + if (!(out = AllAttVars())) { + if (!Yap_gcl(Yap_Error_Size, 1, ENV, gc_P(P,CP))) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + return FALSE; + } + } else { + return Yap_unify(ARG1,out); + } + } while (TRUE); } static Int diff --git a/C/heapgc.c b/C/heapgc.c index 8beccde02..d7c62b97f 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -1150,6 +1150,33 @@ check_global(void) { /* mark a heap object and all heap objects accessible from it */ +static void +mark_variable(CELL_PTR current); + +static void +mark_att_var(CELL *hp) +{ + if (!MARKED_PTR(hp-1)) { + MARK(hp-1); + PUSH_POINTER(hp-1); + total_marked++; + if (hp < HGEN) { + total_oldies++; + } + } + if (!MARKED_PTR(hp)) { + MARK(hp); + PUSH_POINTER(hp); + total_marked++; + if (hp < HGEN) { + total_oldies++; + } + } + mark_variable(hp+1); + mark_variable(hp+2); +} + + static void mark_variable(CELL_PTR current) { @@ -1173,7 +1200,10 @@ mark_variable(CELL_PTR current) next = GET_NEXT(ccur); if (IsVarTerm(ccur)) { - if (ONHEAP(next)) { + if (IsAttVar(current) && current==next) { + mark_att_var(current); + POP_CONTINUATION(); + } else if (ONHEAP(next)) { #ifdef EASY_SHUNTING CELL cnext; /* do variable shunting between variables in the global */ @@ -1576,18 +1606,6 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap) } } -static void -mark_att_var(CELL *hp) -{ - attvar_record *attv = RepAttVar(hp); - Functor *cptr = &(attv->AttFunc); - mark_external_reference2(CellPtr(cptr)); - mark_external_reference2(&attv->Done); - mark_external_reference2(&attv->Value); - mark_external_reference2(&attv->Atts); -} - - /* Cleaning the trail should be quick and simple, right? Well, not really :-(. The problem is that the trail includes a dumping ground diff --git a/C/utilpreds.c b/C/utilpreds.c index f478822f8..3d81fbc47 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -69,8 +69,11 @@ clean_dirty_tr(tr_fr_ptr TR0) { RESET_VARIABLE(p); } else { /* copy downwards */ +#ifdef FROZEN_STACKS +#else TrailTerm(TR0+1) = TrailTerm(pt); TrailTerm(TR0) = TrailTerm(TR0+2) = p; +#endif pt+=2; TR0 += 3; } @@ -89,7 +92,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, tr_fr_ptr TR0 = TR; int ground = TRUE; #ifdef COROUTINING - CELL *dvars = NULL; + CELL *dvarsmin = NULL, *dvarsmax=NULL; #endif HB = HLow; @@ -251,32 +254,25 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, #if COROUTINING if (newattvs && IsAttachedTerm((CELL)ptd0)) { /* if unbound, call the standard copy term routine */ - struct cp_frame *bp[1]; + struct cp_frame *bp; - if (dvars == NULL) { - dvars = H0; - } - if (ptd0 < dvars) { + if (IN_BETWEEN(dvarsmin, ptd0, dvarsmax)) { *ptf++ = (CELL) ptd0; } else { - tr_fr_ptr CurTR; + CELL new; - CurTR = TR; - bp[0] = to_visit; - HB = HB0; - if (!attas[ExtFromCell(ptd0)].copy_term_op(ptd0, bp, ptf)) { + bp = to_visit; + if (!attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf)) { goto overflow; } - to_visit = bp[0]; - HB = HLow; - ptf++; - if (TR > (tr_fr_ptr)Yap_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } + to_visit = bp; + new = *ptf; + Bind(ptd0, new); + if (dvarsmin == NULL) { + dvarsmin = CellPtr(new); } - Bind(ptd0, ptf[-1]); + dvarsmax = CellPtr(new)+1; + ptf++; } } else { #endif @@ -288,8 +284,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, goto trail_overflow; } } - Bind(ptd0, (CELL)ptf); - ptf++; + Bind(ptd0, (CELL)ptf++); #ifdef COROUTINING } #endif @@ -320,8 +315,8 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, } /* restore our nice, friendly, term to its original state */ - HB = HB0; clean_dirty_tr(TR0); + HB = HB0; return ground; overflow: @@ -521,7 +516,7 @@ Yap_CopyTermNoShare(Term inp) { static Int p_copy_term(void) /* copy term t to a new instance */ { - Term t = CopyTerm(ARG1, 2, TRUE, TRUE); +v Term t = CopyTerm(ARG1, 2, TRUE, TRUE); if (t == 0L) return FALSE; /* be careful, there may be a stack shift here */ diff --git a/pl/corout.yap b/pl/corout.yap index d5d8b0521..21509fcea 100644 --- a/pl/corout.yap +++ b/pl/corout.yap @@ -37,27 +37,17 @@ '$show_frozen_goals'(Level))). '$project_and_delayed_goals'(G,LGs) :- - '$att_vars'(G, LAV), + attributes:all_attvars(LAV), LAV = [_|_], !, % SICStus compatible step, % just try to simplify store by projecting constraints % over query variables. '$project_attributes'(LAV, G), % now get a list of frozen goals. - '$att_vars'(G, NLAV), + attributes:all_attvars(NLAV), '$get_goalist_from_attvars'(NLAV, LGs). '$project_and_delayed_goals'(_,[]). -'$att_vars'(Term, LAV) :- - term_variables(Term, TVars), - '$select_atts'(TVars, LAV). - -'$select_atts'([], []). -'$select_atts'(V.TVars, V.LAV) :- - attvar(V), !, - '$select_atts'(TVars, LAV). -'$select_atts'(V.TVars, LAV) :- - '$select_atts'(TVars, LAV). % % wake_up_goal is called by the system whenever a suspended goal @@ -563,8 +553,7 @@ frozen(V, LG) :- '$fetch_same_done_goals'(G0, D0, LV, GF). -/* -call_residue_vars(Goal,Vars) :- +call_residue_vars(Goal,Residue) :- attributes:all_attvars(Vs0), call(Goal), attributes:all_attvars(Vs), @@ -586,13 +575,50 @@ call_residue_vars(Goal,Vars) :- ; '$ord_remove'([V1|Vss], Vs0s, Residue) ). -*/ copy_term(Term, Copy, Goals) :- term_variables(Term, TVars), '$get_goalist_from_attvars'(TVars, Goals0), copy_term_nat([Term|Goals0], [Copy|Goals]). +call_residue(Goal,Residue) :- + var(Goal), !, + '$do_error'(instantiation_error,call_residue(Goal,Residue)). +call_residue(Module:Goal,Residue) :- + atom(Module), !, + '$call_residue'(Goal,Module,Residue). +call_residue(Goal,Residue) :- + '$current_module'(Module), + '$call_residue'(Goal,Module,Residue). + +'$call_residue'(Goal,Module,Residue) :- + '$read_svar_list'(OldAttsList), + copy_term_nat(Goal, NGoal), + ( '$set_svar_list'(CurrentAttsList), + '$system_catch'(NGoal,Module,Error,'$residue_catch_trap'(Error,OldAttsList)), + '$project_and_delayed_goals'(NGoal,Residue0), + '$add_vs_to_vlist'(Residue0, Residue), + ( '$set_svar_list'(OldAttsList), + copy_term_nat(NGoal+NResidue, Goal+Residue) + ; + '$set_svar_list'(CurrentAttsList), fail + ) + ; + '$set_svar_list'(OldAttsList), fail + ). + +'$add_vs_to_vlist'([], []). +'$add_vs_to_vlist'([G|Residue0], [Vs-G|Residue]) :- + term_variables(G, TVs), + '$pick_att_vars'(TVs, Vs), + '$add_vs_to_vlist'(Residue0, Residue). + + +% make sure we set the suspended goal list to its previous state! +'$residue_catch_trap'(Error,OldAttsList) :- + '$set_svar_list'(OldAttsList), + throw(Error). + % make sure we have installed a SICStus like constraint solver. '$project_attributes'(_, _) :- '$undefined'(modules_with_attributes(_),attributes), !. From 30a4f3cfe74d5c5a1aaee051f804b99a7930e037 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 12 Mar 2010 08:24:58 +0000 Subject: [PATCH 20/37] fixes to support copy_term and nb_ --- C/attvar.c | 12 ++---- C/globals.c | 104 +++++++++++++++++++++++++++++++------------------- C/utilpreds.c | 35 ++++++++++------- 3 files changed, 89 insertions(+), 62 deletions(-) diff --git a/C/attvar.c b/C/attvar.c index e64073917..23fdc83ab 100644 --- a/C/attvar.c +++ b/C/attvar.c @@ -96,7 +96,7 @@ CopyAttVar(CELL *orig, struct cp_frame **to_visit_ptr, CELL *res) to_visit->start_cp = vt-1; to_visit->end_cp = vt; if (IsVarTerm(attv->Atts)) { - newv->Atts = (CELL)H; + Bind(&newv->Atts, (CELL)H); to_visit->to = H; H++; } else { @@ -123,7 +123,7 @@ TermToAttVar(Term attvar, Term to) attvar_record *attv = BuildNewAttVar(); if (!attv) return FALSE; - attv->Atts = attvar; + Bind(&attv->Atts, attvar); *VarOfTerm(to) = AbsAttVar(attv); return TRUE; } @@ -254,11 +254,7 @@ AddNewModule(attvar_record *attv, Term t, int new, int do_it) if (!do_it) return; if (IsVarTerm(attv->Atts)) { - if (new) { - attv->Atts = t; - } else { - Bind(&(attv->Atts),t); - } + Bind(&(attv->Atts),t); } else { Term *wherep = &attv->Atts; @@ -480,7 +476,7 @@ p_put_att_term(void) { } if (new) { Bind(VarOfTerm(inp), AbsAttVar(attv)); - attv->Atts = Deref(ARG2); + Bind(&attv->Atts, Deref(ARG2)); } else { MaBind(&(attv->Atts), Deref(ARG2)); } diff --git a/C/globals.c b/C/globals.c index 3ca7dded3..05fd9fe39 100644 --- a/C/globals.c +++ b/C/globals.c @@ -224,12 +224,17 @@ Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) CELL *newH; UInt old_sz = ArenaSz(arena), new_size; + if (IN_BETWEEN(base, H, max)) { + base = H; + H += cells; + return base; + } if (base+cells > ASP-1024) { if (!GrowArena(arena, max, old_sz, old_sz+sizeof(CELL)*1024, arity)) return NULL; goto restart; } - + newH = base+cells; new_size = old_sz - cells; *arenap = CreateNewArena(newH, new_size); @@ -280,6 +285,9 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop CELL *HB0 = HB; tr_fr_ptr TR0 = TR; int ground = TRUE; +#ifdef COROUTINING + CELL *dvarsmin = NULL, *dvarsmax=NULL; +#endif HB = HLow; to_visit0 = to_visit; @@ -455,52 +463,50 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop *ptf++ = (CELL) ptd0; } else { #if COROUTINING - if (IsAttVar(ptd0) && copy_att_vars) { - attvar_record *newv = (attvar_record *)H; - newv->AttFunc = FunctorAttVar; - RESET_VARIABLE(&newv->Done); - *ptf = AbsAttVar(newv); - ptf++; - /* store the terms to visit */ -#ifdef RATIONAL_TREES - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldv = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsAppl(H); - to_visit ++; -#else - if (pt0 < pt0_end) { - if (to_visit ++ >= (CELL **)AuxSp) { - goto heap_overflow; + if (copy_att_vars && IsAttachedTerm((CELL)ptd0)) { + /* if unbound, call the standard copy term routine */ + struct cp_frame *bp; + + if (IN_BETWEEN(dvarsmin, ptd0, dvarsmax)) { + *ptf++ = (CELL) ptd0; + } else { + CELL new; + + bp = to_visit; + if (!attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf)) { + goto overflow; } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit ++; - } -#endif - pt0 = ptd0+(1-1); - pt0_end = ptd0 + (ATT_RECORD_ARITY-1); - /* store the functor for the new term */ - ptf = H+2; - H = CellPtr(newv+1); - if (H > ASP - MIN_ARENA_SIZE) { - goto overflow; + to_visit = bp; + new = *ptf; + if (TR > (tr_fr_ptr)Yap_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + Bind_and_Trail(ptd0, new); + if (dvarsmin == NULL) { + dvarsmin = CellPtr(new); + } else { + *dvarsmax = (CELL)(CellPtr(new)+1); + } + dvarsmax = CellPtr(new)+1; + ptf++; } } else { - *ptf++ = d0; +#endif + /* first time we met this term */ + RESET_VARIABLE(ptf); + if ((ADDR)TR > Yap_TrailTop-MIN_ARENA_SIZE) + goto trail_overflow; + Bind_and_Trail(ptd0, (CELL)ptf); + ptf++; +#ifdef COROUTINING } - continue; #endif } } + /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { to_visit --; @@ -554,6 +560,24 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop #endif reset_trail(TR0); return -2; + + trail_overflow: + /* oops, we're in trouble */ + H = HLow; + /* we've done it */ + /* restore our nice, friendly, term to its original state */ + HB = HB0; +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit--; + pt0 = to_visit->start_cp; + pt0_end = to_visit->end_cp; + ptf = to_visit->to; + *pt0 = to_visit->oldv; + } +#endif + reset_trail(TR0); + return -4; } static Term diff --git a/C/utilpreds.c b/C/utilpreds.c index 3d81fbc47..cc3094cb1 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -65,18 +65,7 @@ clean_dirty_tr(tr_fr_ptr TR0) { do { Term p = TrailTerm(pt++); - if (IsVarTerm(p)) { - RESET_VARIABLE(p); - } else { - /* copy downwards */ -#ifdef FROZEN_STACKS -#else - TrailTerm(TR0+1) = TrailTerm(pt); - TrailTerm(TR0) = TrailTerm(TR0+2) = p; -#endif - pt+=2; - TR0 += 3; - } + RESET_VARIABLE(p); } while (pt != TR); TR = TR0; } @@ -270,6 +259,8 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, Bind(ptd0, new); if (dvarsmin == NULL) { dvarsmin = CellPtr(new); + } else { + *dvarsmax = (CELL)(CellPtr(new)+1); } dvarsmax = CellPtr(new)+1; ptf++; @@ -316,7 +307,23 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, /* restore our nice, friendly, term to its original state */ clean_dirty_tr(TR0); - HB = HB0; + /* follow chain of multi-assigned variables */ + if (dvarsmin) { + fprintf(stderr,"%ld--%ld\n", dvarsmin-H0,dvarsmax-H0); + dvarsmin += 1; + do { + CELL *newv; + fprintf(stderr,"mabind %ld %p %p\n", dvarsmin-H0, TR, dvarsmin+1); + Bind(dvarsmin+1, dvarsmin[1]); + fprintf(stderr,"redone %p\n", TR); + if (IsUnboundVar(dvarsmin)) + break; + newv = CellPtr(*dvarsmin); + RESET_VARIABLE(dvarsmin); + dvarsmin = newv; + } while (TRUE); + HB = HB0; + } return ground; overflow: @@ -516,7 +523,7 @@ Yap_CopyTermNoShare(Term inp) { static Int p_copy_term(void) /* copy term t to a new instance */ { -v Term t = CopyTerm(ARG1, 2, TRUE, TRUE); + Term t = CopyTerm(ARG1, 2, TRUE, TRUE); if (t == 0L) return FALSE; /* be careful, there may be a stack shift here */ From 613dfb0d951ce11080cc6bd676220266805ec7fa Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 12 Mar 2010 08:25:35 +0000 Subject: [PATCH 21/37] move away from SICStus: do not check all attvars. --- pl/corout.yap | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/pl/corout.yap b/pl/corout.yap index 21509fcea..0681d31f9 100644 --- a/pl/corout.yap +++ b/pl/corout.yap @@ -37,18 +37,32 @@ '$show_frozen_goals'(Level))). '$project_and_delayed_goals'(G,LGs) :- - attributes:all_attvars(LAV), + '$attributed'(G, LAV), +% attributes:all_attvars(LAV), LAV = [_|_], !, % SICStus compatible step, % just try to simplify store by projecting constraints % over query variables. '$project_attributes'(LAV, G), % now get a list of frozen goals. - attributes:all_attvars(NLAV), + '$attributed'(G, NLAV), +% attributes:all_attvars(NLAV), '$get_goalist_from_attvars'(NLAV, LGs). '$project_and_delayed_goals'(_,[]). +'$attributed'(G, Vs) :- + term_variables(G, LAV), + '$find_att_vars'(LAV, Vs). + +'$check_atts'([], []). +'$check_atts'(V.LAV, V.Vs) :- + attvar(V), !, + '$check_atts'(LAV, Vs). +'$check_atts'(_.LAV, Vs) :- + '$check_atts'(LAV, Vs). + + % % wake_up_goal is called by the system whenever a suspended goal % resumes. From c41f6e1906d65fbdf76a47f1e9d6581fa22a334b Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 12 Mar 2010 08:26:56 +0000 Subject: [PATCH 22/37] atts stuff is now a part of prolog. --- library/dialect/swi.yap | 32 ----------------------- pl/attributes.yap | 56 +++++++++++++++++++++++++++++++++++++++++ pl/init.yap | 1 + 3 files changed, 57 insertions(+), 32 deletions(-) create mode 100644 pl/attributes.yap diff --git a/library/dialect/swi.yap b/library/dialect/swi.yap index 2edeb4692..38952e273 100755 --- a/library/dialect/swi.yap +++ b/library/dialect/swi.yap @@ -268,38 +268,6 @@ slp(T) :- sleep(T). prolog:sleep(T) :- slp(T). -% SWI has a dynamic attribute scheme - -prolog:get_attr(Var, Mod, Att) :- - functor(AttTerm, Mod, 2), - arg(2, AttTerm, Att), - attributes:get_module_atts(Var, AttTerm). - -prolog:put_attr(Var, Mod, Att) :- - functor(AttTerm, Mod, 2), - arg(2, AttTerm, Att), - attributes:put_module_atts(Var, AttTerm). - -prolog:del_attr(Var, Mod) :- - functor(AttTerm, Mod, 2), - attributes:del_all_module_atts(Var, AttTerm). - -prolog:del_attrs(Var) :- - attributes:del_all_atts(Var). - -prolog:get_attrs(AttVar, SWIAtts) :- - get_all_swi_atts(AttVar,SWIAtts). - -prolog:put_attrs(_, []). -prolog:put_attrs(V, Atts) :- - cvt_to_swi_atts(Atts, YapAtts), - attributes:put_att_term(V, YapAtts). - -cvt_to_swi_atts([], _). -cvt_to_swi_atts(att(Mod,Attribute,Atts), ModAttribute) :- - ModAttribute =.. [Mod, YapAtts, Attribute], - cvt_to_swi_atts(Atts, YapAtts). - bindings_message(V) --> { cvt_bindings(V, Bindings) }, prolog:message(query(_YesNo,Bindings)), !. diff --git a/pl/attributes.yap b/pl/attributes.yap new file mode 100644 index 000000000..1cefa0c45 --- /dev/null +++ b/pl/attributes.yap @@ -0,0 +1,56 @@ +/************************************************************************* +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * +* * +************************************************************************** +* * +* File: atts.yap * +* Last rev: 8/2/88 * +* mods: * +* comments: attribute support for Prolog * +* * +*************************************************************************/ + +:- module('$attributes', [get_attr/3, + put_attr/3, + del_attr/2, + del_attrs/1, + get_attrs/2, + put_attrs/2 + ]). + + +get_attr(Var, Mod, Att) :- + functor(AttTerm, Mod, 2), + arg(2, AttTerm, Att), + attributes:get_module_atts(Var, AttTerm). + +put_attr(Var, Mod, Att) :- + functor(AttTerm, Mod, 2), + arg(2, AttTerm, Att), + attributes:put_module_atts(Var, AttTerm). + +del_attr(Var, Mod) :- + functor(AttTerm, Mod, 2), + attributes:del_all_module_atts(Var, AttTerm). + +del_attrs(Var) :- + attributes:del_all_atts(Var). + +get_attrs(AttVar, SWIAtts) :- + attributes:get_all_swi_atts(AttVar,SWIAtts). + +put_attrs(_, []). +put_attrs(V, Atts) :- + cvt_to_swi_atts(Atts, YapAtts), + attributes:put_att_term(V, YapAtts). + +cvt_to_swi_atts([], _). +cvt_to_swi_atts(att(Mod,Attribute,Atts), ModAttribute) :- + ModAttribute =.. [Mod, YapAtts, Attribute], + cvt_to_swi_atts(Atts, YapAtts). + diff --git a/pl/init.yap b/pl/init.yap index 47f5207ae..c473c61f3 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -83,6 +83,7 @@ lists:append([H|T], L, [H|R]) :- 'eam.yap', 'chtypes.yap', 'yapor.yap', + 'attributes.yap', 'udi.yap']. :- dynamic prolog:'$user_defined_flag'/4. From 222ead095c91b5c8e2ed62e555d724fa39e9830a Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 12 Mar 2010 08:49:12 +0000 Subject: [PATCH 23/37] term_attvars/2. --- C/utilpreds.c | 221 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 221 insertions(+) diff --git a/C/utilpreds.c b/C/utilpreds.c index cc3094cb1..e40244c78 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -841,6 +841,226 @@ p_term_variables(void) /* variables in term t */ return Yap_unify(ARG2,out); } +static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp) +{ + + register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); + register tr_fr_ptr TR0 = TR; + CELL *InitialH = H; + CELL output = AbsPair(H); + + to_visit0 = to_visit; + loop: + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + ++ pt0; + ptd0 = pt0; + d0 = *ptd0; + deref_head(d0, attvars_in_term_unk); + attvars_in_term_nvar: + { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } + continue; + } + + + derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar); + if (IsAttVar(ptd0)) { + /* do or pt2 are unbound */ + *ptd0 = TermNil; + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)Yap_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + TrailTerm(TR++) = (CELL)ptd0; + /* leave an empty slot to fill in later */ + if (H+1024 > ASP) { + goto global_overflow; + } + H[1] = AbsPair(H+2); + H += 2; + H[-2] = (CELL)ptd0; + /* store the terms to visit */ + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = &RepAttVar(ptd0)->Value; + pt0_end = &RepAttVar(ptd0)->Atts; + } + } + /* Do we still have compound terms to visit */ + if (to_visit > to_visit0) { +#ifdef RATIONAL_TREES + to_visit -= 3; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; + *pt0 = (CELL)to_visit[2]; +#else + to_visit -= 2; + pt0 = to_visit[0]; + pt0_end = to_visit[1]; +#endif + goto loop; + } + + clean_tr(TR0); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + if (H != InitialH) { + /* close the list */ + Term t2 = Deref(inp); + if (IsVarTerm(t2)) { + RESET_VARIABLE(H-1); + Yap_unify((CELL)(H-1),ARG2); + } else { + H[-1] = t2; /* don't need to trail */ + } + return(output); + } else { + return(inp); + } + + trail_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + Yap_Error_TYPE = OUT_OF_TRAIL_ERROR; + Yap_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + clean_tr(TR0); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + H = InitialH; + return 0L; + + aux_overflow: + Yap_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + Yap_Error_TYPE = OUT_OF_AUXSPACE_ERROR; + clean_tr(TR0); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + H = InitialH; + return 0L; + + global_overflow: +#ifdef RATIONAL_TREES + while (to_visit > to_visit0) { + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; + } +#endif + clean_tr(TR0); + Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); + H = InitialH; + Yap_Error_TYPE = OUT_OF_STACK_ERROR; + Yap_Error_Size = (ASP-H)*sizeof(CELL); + return 0L; + +} + +static Int +p_term_attvars(void) /* variables in term t */ +{ + Term out; + + do { + Term t = Deref(ARG1); + if (IsVarTerm(t)) { + out = attvars_in_complex_term(VarOfTerm(t)-1, + VarOfTerm(t)+1, TermNil); + } else if (IsPrimitiveTerm(t)) { + return Yap_unify(TermNil, ARG2); + } else if (IsPairTerm(t)) { + out = attvars_in_complex_term(RepPair(t)-1, + RepPair(t)+1, TermNil); + } + else { + Functor f = FunctorOfTerm(t); + out = attvars_in_complex_term(RepAppl(t), + RepAppl(t)+ + ArityOfFunctor(f), TermNil); + } + if (out == 0L) { + if (!expand_vts()) + return FALSE; + } + } while (out == 0L); + return Yap_unify(ARG2,out); +} + static Int p_term_variables3(void) /* variables in term t */ { @@ -2863,6 +3083,7 @@ void Yap_InitUtilCPreds(void) Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, SafePredFlag|HiddenPredFlag); Yap_InitCPred("term_variables", 2, p_term_variables, 0); Yap_InitCPred("term_variables", 3, p_term_variables3, 0); + Yap_InitCPred("term_attvars", 2, p_term_attvars, 0); Yap_InitCPred("is_list", 1, p_is_list, SafePredFlag); Yap_InitCPred("=@=", 2, p_variant, 0); CurrentModule = TERMS_MODULE; From c5002e4c9855319f427204862bf11fb63df2d18f Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 12 Mar 2010 10:19:55 +0000 Subject: [PATCH 24/37] update docummentation. --- docs/swi.tex | 191 ++----------------------------- docs/yap.tex | 318 +++++++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 280 insertions(+), 229 deletions(-) diff --git a/docs/swi.tex b/docs/swi.tex index c35d5e561..5a1452498 100644 --- a/docs/swi.tex +++ b/docs/swi.tex @@ -1,8 +1,8 @@ @chapter SWI-Prolog Emulation This library provides a number of SWI-Prolog builtins that are not by -default in YAP. This library is loaded with the -@code{use_module(library(swi))} command. +default in YAP. This support is loaded with the +@code{expects_dialect(swi)} command. @table @code @@ -168,7 +168,7 @@ triple. See the example above. @c @var{Pred} applies. @end table -@node Forall,hProlog and SWI-Prolog Attributed Variables,Invoking Predicates on all Members of a List, SWI-Prolog +@node Forall, ,Invoking Predicates on all Members of a List, SWI-Prolog @section Forall @c \label{sec:forall2} @@ -189,176 +189,8 @@ The next example verifies that all arithmetic statements in the list @end table -@node hProlog and SWI-Prolog Attributed Variables, SWI-Prolog Global Variables, Forall,SWI-Prolog -@section hProlog and SWI-Prolog Attributed Variables -@cindex hProlog Attributed Variables - -Attributed variables -@c @ref{Attributed variables} -provide a technique for extending the -Prolog unification algorithm by hooking the binding of attributed -variables. There is little consensus in the Prolog community on the -exact definition and interface to attributed variables. Yap Prolog -traditionally implements a SICStus-like interface, but to enable -SWI-compatibility we have implemented the SWI-Prolog interface, -identical to the one realised by Bart Demoen for hProlog. - -Binding an attributed variable schedules a goal to be executed at the -first possible opportunity. In the current implementation the hooks are -executed immediately after a successful unification of the clause-head -or successful completion of a foreign language (builtin) predicate. Each -attribute is associated to a module and the hook (attr_unify_hook/2) is -executed in this module. The example below realises a very simple and -incomplete finite domain reasoner. - -@example -:- module(domain, - [ domain/2 % Var, ?Domain - ]). -:- use_module(library(oset)). - -domain(X, Dom) :- - var(Dom), !, - get_attr(X, domain, Dom). -domain(X, List) :- - sort(List, Domain), - put_attr(Y, domain, Domain), - X = Y. - -% An attributed variable with attribute value Domain has been -% assigned the value Y - -attr_unify_hook(Domain, Y) :- - ( get_attr(Y, domain, Dom2) - -> oset_int(Domain, Dom2, NewDomain), - ( NewDomain == [] - -> fail - ; NewDomain = [Value] - -> Y = Value - ; put_attr(Y, domain, NewDomain) - ) - ; var(Y) - -> put_attr( Y, domain, Domain ) - ; memberchk(Y, Domain) - ). -@end example - - -Before explaining the code we give some example queries: - -@table @code -@item ?- domain(X, [a,b]), X = c -no -@item ?- domain(X, [a,b]), domain(X, [a,c]). - X = a -@item ?- domain(X, [a,b,c]), domain(X, [a,c]). - X = _D0 -@end table - -The predicate @code{domain/2} fetches (first clause) or assigns -(second clause) the variable a @emph{domain}, a set of values it can -be unified with. In the second clause first associates the domain -with a fresh variable and then unifies X to this variable to deal -with the possibility that X already has a domain. The -predicate @code{attr_unify_hook/2} is a hook called after a variable with -a domain is assigned a value. In the simple case where the variable -is bound to a concrete value we simply check whether this value is in -the domain. Otherwise we take the intersection of the domains and either -fail if the intersection is empty (first example), simply assign the -value if there is only one value in the intersection (second example) or -assign the intersection as the new domain of the variable (third -example). - - -@table @code - -@item put_attr(+@var{Var},+@var{Module},+@var{Value}) -@findex put_attr/3 -@snindex put_attr/3 -@cnindex put_attr/3 -If @var{Var} is a variable or attributed variable, set the value for the -attribute named @var{Module} to @var{Value}. If an attribute with this -name is already associated with @var{Var}, the old value is replaced. -Backtracking will restore the old value (i.e. an attribute is a mutable -term. See also @code{setarg/3}). This predicate raises a type error if -@var{Var} is not a variable or @var{Module} is not an atom. - -@item get_attr(+@var{Var},+@var{Module},+@var{Value}) -@findex get_attr/3 -@snindex get_attr/3 -@cnindex get_attr/3 -Request the current @var{value} for the attribute named @var{Module}. If -@var{Var} is not an attributed variable or the named attribute is not -associated to @var{Var} this predicate fails silently. If @var{Module} -is not an atom, a type error is raised. - -@item del_attr(+@var{Var},+@var{Module}) -@findex del_attr/2 -@snindex del_attr/2 -@cnindex del_attr/2 -Delete the named attribute. If @var{Var} loses its last attribute it -is transformed back into a traditional Prolog variable. If @var{Module} -is not an atom, a type error is raised. In all other cases this -predicate succeeds regardless of whether or not the named attribute is -present. - -@item attr_unify_hook(+@var{AttValue},+@var{VarValue}) -@findex attr_unify_hook/2 -@snindex attr_unify_hook/2 -@cnindex attr_unify_hook/2 -Hook that must be defined in the module an attributed variable refers -to. It is called @emph{after} the attributed variable has been -unified with a non-var term, possibly another attributed variable. -@var{AttValue} is the attribute that was associated to the variable -in this module and @var{VarValue} is the new value of the variable. -Normally this predicate fails to veto binding the variable to -@var{VarValue}, forcing backtracking to undo the binding. If -@var{VarValue} is another attributed variable the hook often combines -the two attribute and associates the combined attribute with -@var{VarValue} using @code{put_attr/3}. - -@c \predicate{attr_portray_hook}{2}{+AttValue, +Var} -@c Called by write_term/2 and friends for each attribute if the option -@c \term{attributes}{portray} is in effect. If the hook succeeds the -@c attribute is considered printed. Otherwise \exam{Module = ...} is -@c printed to indicate the existence of a variable. -@end table - -@subsection Special Purpose SWI Predicates for Attributes - -Normal user code should deal with @code{put_attr/3}, @code{get_attr/3} -and @code{del_attr/2}. The routines in this section fetch or set the -entire attribute list of a variables. Use of these predicates is -anticipated to be restricted to printing and other special purpose -operations. - -@table @code -@item get_attrs(+@var{Var},-@var{Attributes}) -@findex get_attrs/2 -@snindex get_attrs/2 -@cnindex get_attrs/2 -Get all attributes of @var{Var}. @var{Attributes} is a term of the form -@code{att(Module, Value, MoreAttributes)}, where @var{MoreAttributes} is -@code{[]} for the last attribute. - -@item put_attrs(+@var{Var},+@var{Attributes}) -@findex put_attrs/2 -@snindex put_attrs/2 -@cnindex put_attrs/2 -Set all attributes of @var{Var}. See get_attrs/2 for a description of -@var{Attributes}. - -@item copy_term_nat(?@var{TI},-@var{TF}) -@findex copy_term_nat/2 -@snindex copy_term_nat/2 -@cnindex copy_term_nat/2 -As @code{copy_term/2}. Attributes however, are @emph{not} copied but replaced -by fresh variables. -@end table - - -@node SWI-Prolog Global Variables, ,hProlog and SWI-Prolog Attributed Variables,SWI-Prolog -@section SWI Global variables +@node SWI-Prolog Global Variables, Extensions, SWI-Prolog, Top +@chapter SWI Global variables @c \label{sec:gvar} SWI-Prolog global variables are associations between names (atoms) and @@ -478,11 +310,11 @@ enumeration is undefined. Delete the named global variable. @end table -@subsection Compatibility of SWI-Prolog Global Variables +@section Compatibility of Global Variables Global variables have been introduced by various Prolog -implementations recently. The implementation of them in SWI-Prolog is -based on hProlog by Bart Demoen. In discussion with Bart it was +implementations recently. YAP follows their implementation in SWI-Prolog, itself +based on hProlog by Bart Demoen. Jan and Bart decided that the semantics if hProlog @code{nb_setval/2}, which is equivalent to @code{nb_linkval/2} is not acceptable for normal Prolog users as the behaviour is influenced by how builtin predicates @@ -493,10 +325,3 @@ Arrays can be implemented easily in SWI-Prolog using @code{functor/3} and @code{setarg/3} due to the unrestricted arity of compound terms. -@node Extensions,Debugging,SWI-Prolog,Top -@chapter Extensions to Prolog - -YAP includes several extensions that are not enabled by -default, but that can be used to extend the functionality of the -system. These options can be set at compilation time by enabling the -related compilation flag, as explained in the @code{Makefile} diff --git a/docs/yap.tex b/docs/yap.tex index b5d4701e8..cea429e7e 100644 --- a/docs/yap.tex +++ b/docs/yap.tex @@ -91,6 +91,7 @@ us to include his text in this document. * Built-ins:: Built In Predicates * Library:: Library Predicates * SWI-Prolog:: SWI-Prolog emulation +* Global Variables :: Global Variables for Prolog * Extensions:: Extensions to Standard YAP * Rational Trees:: Working with Rational Trees * Co-routining:: Changing the Execution of Goals @@ -242,7 +243,6 @@ Subnodes of Attributes Subnodes of SWI-Prolog * Invoking Predicates on all Members of a List :: maplist and friends -* hProlog and SWI-Prolog Attributed Variables :: Emulating SWI-like attributed variables * SWI-Prolog Global Variables :: Emulating SWI-like attributed variables @c Subnodes of CLP(Q,R) @@ -3317,22 +3317,6 @@ in @var{TI} are also duplicated. Also refer to @code{copy_term/2}. -@item copy_term(?@var{TI},-@var{TF},-@var{Goals}) -@findex copy_term/3 -@syindex copy_term/3 -@cnindex copy_term/3 -Term @var{TF} is a variant of the original term @var{TI}, such that for -each variable @var{V} in the term @var{TI} there is a new variable @var{V'} -in term @var{TF} without any attributes attached. Attributed -variables are thus converted to standard variables. @var{Goals} is -unified with a list that represents the attributes. The goal -@code{maplist(call,@var{Goals})} can be called to recreate the -attributes. - -Before the actual copying, @code{copy_term/3} calls -@code{attribute_goals/1} in the module where the attribute is -defined. - @end table @node Predicates on Atoms, Predicates on Characters, Testing Terms, Top @@ -6567,7 +6551,7 @@ Execute a new shell. @snindex alarm/3 @cnindex alarm/3 Arranges for YAP to be interrupted in @var{Seconds} seconds, or in -@var{[Seconds|MicroSeconds]}. When interrupted, YAP will execute +[@var{Seconds}|@var{MicroSeconds}]. When interrupted, YAP will execute @var{Callable} and then return to the previous execution. If @var{Seconds} is @code{0}, no new alarm is scheduled. In any event, any previously set alarm is canceled. @@ -12222,19 +12206,25 @@ are released. @end table -@node SWI-Prolog, Extensions, Library, Top +@node SWI-Prolog, SWI-Prolog Global Variables, Library, Top @cindex SWI-Prolog @menu SWI-Prolog Emulation Subnodes of SWI-Prolog * Invoking Predicates on all Members of a List :: maplist and friends * Forall :: forall built-in -* hProlog and SWI-Prolog Attributed Variables :: Emulating SWI-like attributed variables -* SWI-Prolog Global Variables :: Emulating SWI-like attributed variables @end menu @include swi.tex +@node Extensions,Debugging,SWI-Prolog Global Variables,Top +@chapter Extensions to Prolog + +YAP includes several extensions that are not enabled by +default, but that can be used to extend the functionality of the +system. These options can be set at compilation time by enabling the +related compilation flag, as explained in the @code{Makefile} + @menu Extensions to Traditional Prolog @@ -12401,16 +12391,11 @@ no @cindex attributed variables @menu - -* Attribute Declarations:: Declaring New Attributes -* Attribute Manipulation:: Setting and Reading Attributes -* Attributed Unification:: Tuning the Unification Algorithm -* Displaying Attributes:: Displaying Attributes in User-Readable Form -* Projecting Attributes:: Obtaining the Attributes of Interest -* Attribute Examples:: Two Simple Examples of how to use Attributes. +* New Style Attribute Declarations:: New Style code +* Old Style Attribute Declarations:: Old Style code (deprecated) @end menu -YAP now supports the attributed variables packaged developed at OFAI by +YAP supports attributed variables, originally developed at OFAI by Christian Holzbaur. Attributes are a means of declaring that an arbitrary term is a property for a variable. These properties can be updated during forward execution. Moreover, the unification algorithm is @@ -12419,16 +12404,257 @@ trying to unify these variables. Attributed variables provide an elegant abstraction over which one can extend Prolog systems. Their main application so far has been in -implementing constraint handlers, such as Holzbaur's CLPQR and Fruewirth -and Holzbaur's CHR, but other applications have been proposed in the -literature. +implementing constraint handlers, such as Holzbaur's CLPQR, Fruewirth +and Holzbaur's CHR, and CLP(BN). + +Different Prolog systems implement attributed variables in different +ways. Traditionally, YAP has used the interface designed by SICStus +Prolog. This interface is still +available in the @t{atts} library, but from YAP-6.0.3 we recommend using +the hProlog, SWI style interface. The main reason to do so is that +most packages included in YAP that use attributed variables, such as CHR, CLP(FD), and CLP(QR), +rely on the SWI-Prolog interface. -The command +@node New Style Attribute Declarations, Old Style Attribute Declarations, , Attributed Variables +@section hProlog and SWI-Prolog style Attribute Declarations + +The following documentation is taken from the SWI-Prolog manual. + +Binding an attributed variable schedules a goal to be executed at the +first possible opportunity. In the current implementation the hooks are +executed immediately after a successful unification of the clause-head +or successful completion of a foreign language (built-in) predicate. Each +attribute is associated to a module and the hook @code{attr_unify_hook/2} is +executed in this module. The example below realises a very simple and +incomplete finite domain reasoner. + +@example +:- module(domain, + [ domain/2 % Var, ?Domain + ]). +:- use_module(library(ordsets)). + +domain(X, Dom) :- + var(Dom), !, + get_attr(X, domain, Dom). +domain(X, List) :- + list_to_ord_set(List, Domain), + put_attr(Y, domain, Domain), + X = Y. + +% An attributed variable with attribute value Domain has been +% assigned the value Y + +attr_unify_hook(Domain, Y) :- + ( get_attr(Y, domain, Dom2) + -> ord_intersection(Domain, Dom2, NewDomain), + ( NewDomain == [] + -> fail + ; NewDomain = [Value] + -> Y = Value + ; put_attr(Y, domain, NewDomain) + ) + ; var(Y) + -> put_attr( Y, domain, Domain ) + ; ord_memberchk(Y, Domain) + ). + +% Translate attributes from this module to residual goals + +attribute_goals(X) --> + @{ get_attr(X, domain, List) @}, + [domain(X, List)]. +@end example + + +Before explaining the code we give some example queries: + +@multitable @columnfractions .70 .30 + @item @code{?- domain(X, [a,b]), X = c} +@tab @code{fail} +@item @code{domain(X, [a,b]), domain(X, [a,c]).} + @tab @code{X=a} + @item @code{domain(X, [a,b,c]), domain(X, [a,c]).} + @tab @code{domain(X, [a,c]).} + @end multitable + +The predicate @code{domain/2} fetches (first clause) or assigns +(second clause) the variable a @emph{domain}, a set of values it can +be unified with. In the second clause first associates the domain +with a fresh variable and then unifies X to this variable to deal +with the possibility that X already has a domain. The +predicate @code{attr_unify_hook/2} is a hook called after a variable with +a domain is assigned a value. In the simple case where the variable +is bound to a concrete value we simply check whether this value is in +the domain. Otherwise we take the intersection of the domains and either +fail if the intersection is empty (first example), simply assign the +value if there is only one value in the intersection (second example) or +assign the intersection as the new domain of the variable (third +example). The nonterminal @code{attribute_goals/3} is used to translate +remaining attributes to user-readable goals that, when executed, reinstate +these attributes. + +@table @code + +@item attvar(?@var{Term}) +@findex attvar/1 +@snindex attvar/1 +@cnindex attvar/1 + +Succeeds if @code{Term} is an attributed variable. Note that @code{var/1} also +succeeds on attributed variables. Attributed variables are created with +@code{put_attr/3}. + +@item put_attr(+@var{Var},+@var{Module},+@var{Value}) +@findex put_attr/3 +@snindex put_attr/3 +@cnindex put_attr/3 + +If @var{Var} is a variable or attributed variable, set the value for the +attribute named @var{Module} to @var{Value}. If an attribute with this +name is already associated with @var{Var}, the old value is replaced. +Backtracking will restore the old value (i.e., an attribute is a mutable +term. See also @code{setarg/3}). This predicate raises a representation error if +@var{Var} is not a variable and a type error if @var{Module} is not an atom. + +@item get_attr(+@var{Var},+@var{Module},-@var{Value}) +@findex get_attr/3 +@snindex get_attr/3 +@cnindex get_attr/3 + +Request the current @var{value} for the attribute named @var{Module}. If +@var{Var} is not an attributed variable or the named attribute is not +associated to @var{Var} this predicate fails silently. If @var{Module} +is not an atom, a type error is raised. + +@item del_attr(+@var{Var},+@var{Module}) +@findex del_attr/2 +@snindex del_attr/2 +@cnindex del_attr/2 + +Delete the named attribute. If @var{Var} loses its last attribute it +is transformed back into a traditional Prolog variable. If @var{Module} +is not an atom, a type error is raised. In all other cases this +predicate succeeds regardless whether or not the named attribute is +present. + +@item attr_unify_hook(+@var{AttValue},+@var{VarValue}) +@findex attr_unify_hook/2 +@snindex attr_unify_hook/2 +@cnindex attr_unify_hook/2 + +Hook that must be defined in the module an attributed variable refers +to. Is is called @emph{after} the attributed variable has been +unified with a non-var term, possibly another attributed variable. +@var{AttValue} is the attribute that was associated to the variable +in this module and @var{VarValue} is the new value of the variable. +Normally this predicate fails to veto binding the variable to +@var{VarValue}, forcing backtracking to undo the binding. If +@var{VarValue} is another attributed variable the hook often combines +the two attribute and associates the combined attribute with +@var{VarValue} using @code{put_attr/3}. + +@item attr_portray_hook(+@var{AttValue},+@var{Var}) +@findex attr_portray_hook/2 +@snindex attr_portray_hook/2 +@cnindex attr_portray_hook/2 + +Called by @code{write_term/2} and friends for each attribute if the option +@code{attributes(portray)} is in effect. If the hook succeeds the +attribute is considered printed. Otherwise @code{Module = ...} is +printed to indicate the existence of a variable. + +@item attribute_goals(+@var{Var},-@var{Gs},+@var{GsRest}) +@findex attribute_goals/2 +@snindex attribute_goals/2 +@cnindex attribute_goals/2 + +This nonterminal, if it is defined in a module, is used by @var{copy_term/3} +to project attributes of that module to residual goals. It is also +used by the toplevel to obtain residual goals after executing a query. +@end table + +Normal user code should deal with @code{put_attr/3}, @code{get_attr/3} and @code{del_attr/2}. +The routines in this section fetch or set the entire attribute list of a +variables. Use of these predicates is anticipated to be restricted to +printing and other special purpose operations. + +@table @code + +@item get_attrs(+@var{Var},-@var{Attributes}) +@findex get_attrs/2 +@snindex get_attrs/2 +@cnindex get_attrs/2 + +Get all attributes of @var{Var}. @var{Attributes} is a term of the form +@code{att(@var{Module}, @var{Value}, @var{MoreAttributes})}, where @var{MoreAttributes} is +@code{[]} for the last attribute. + +@item put_attrs(+@var{Var},+@var{Attributes}) +@findex put_attrs/2 +@snindex put_attrs/2 +@cnindex put_attrs/2 +Set all attributes of @var{Var}. See @code{get_attrs/2} for a description of +@var{Attributes}. + +@item del_attrs(+@var{Var}) +@findex del_attrs/1 +@snindex del_attrs/1 +@cnindex del_attrs/1 +If @var{Var} is an attributed variable, delete @emph{all} its +attributes. In all other cases, this predicate succeeds without +side-effects. + +@item term_attvars(+@var{Term},-@var{AttVars}) +@findex term_attvars/2 +@snindex term_attvars/2 +@cnindex term_attvars/2 +@var{AttVars} is a list of all attributed variables in @var{Term} and +its attributes. I.e., @code{term_attvars/2} works recursively through +attributes. This predicate is Cycle-safe. + +@item copy_term(?@var{TI},-@var{TF},-@var{Goals}) +@findex copy_term/3 +@syindex copy_term/3 +@cnindex copy_term/3 +Term @var{TF} is a variant of the original term @var{TI}, such that for +each variable @var{V} in the term @var{TI} there is a new variable @var{V'} +in term @var{TF} without any attributes attached. Attributed +variables are thus converted to standard variables. @var{Goals} is +unified with a list that represents the attributes. The goal +@code{maplist(call,@var{Goals})} can be called to recreate the +attributes. + +Before the actual copying, @code{copy_term/3} calls +@code{attribute_goals/1} in the module where the attribute is +defined. + +@item copy_term_nat(?@var{TI},-@var{TF}) +@findex copy_term_nat/2 +@syindex copy_term_nat/2 +@cnindex copy_term_nat/2 +As @code{copy_term/2}. Attributes however, are @emph{not} copied but replaced +by fresh variables. +@end table + +@node Old Style Attribute Declarations, , New Style Attribute Declarations, Attributed Variables +@section SICStus Prolog style Attribute Declarations + +@menu +* Attribute Declarations:: Declaring New Attributes +* Attribute Manipulation:: Setting and Reading Attributes +* Attributed Unification:: Tuning the Unification Algorithm +* Displaying Attributes:: Displaying Attributes in User-Readable Form +* Projecting Attributes:: Obtaining the Attributes of Interest +* Attribute Examples:: Two Simple Examples of how to use Attributes. +@end menu + +Old style attribute declarations are activated through loading the library @t{atts} . The command @example | ?- use_module(library(atts)). @end example -enables the use of attributed variables. The package provides the +enables this form of use of attributed variables. The package provides the following functionality: @itemize @bullet @item Each attribute must be declared first. Attributes are described by a functor @@ -12453,8 +12679,8 @@ the top-level, where it is used to output the set of floundered constraints at the end of a query. @end itemize -@node Attribute Declarations, Attribute Manipulation, , Attributed Variables -@section Attribute Declarations +@node Attribute Declarations, Attribute Manipulation, , Old Style Attribute Declarations +@subsection Attribute Declarations Attributes are compound terms associated with a variable. Each attribute has a @emph{name} which is @emph{private} to the module in which the @@ -12480,8 +12706,8 @@ preprocessed depending on the module. The @code{user:goal_expansion/3} mechanism is used for this purpose. -@node Attribute Manipulation, Attributed Unification, Attribute Declarations, Attributed Variables -@section Attribute Manipulation +@node Attribute Manipulation, Attributed Unification, Attribute Declarations, Old Style Attribute Declarations +@subsection Attribute Manipulation The attribute manipulation predicates always work as follows: @@ -12531,8 +12757,8 @@ Remove the attribute with the same name. If no such attribute existed, simply succeed. @end table -@node Attributed Unification, Displaying Attributes, Attribute Manipulation, Attributed Variables -@section Attributed Unification +@node Attributed Unification, Displaying Attributes, Attribute Manipulation, Old Style Attribute Declarations +@subsection Attributed Unification The user-predicate predicate @code{verify_attributes/3} is called when attempting to unify an attributed variable which might have attributes @@ -12569,8 +12795,8 @@ Succeed if @var{Var} is an attributed variable. -@node Displaying Attributes, Projecting Attributes,Attributed Unification, Attributed Variables -@section Displaying Attributes +@node Displaying Attributes, Projecting Attributes,Attributed Unification, Old Style Attribute Declarations +@subsection Displaying Attributes Attributes are usually presented as goals. The following routines are used by built-in predicates such as @code{call_residue/2} and by the @@ -12594,8 +12820,8 @@ User-defined procedure, called to project the attributes in the query, @end table -@node Projecting Attributes, Attribute Examples, Displaying Attributes, Attributed Variables -@section Projecting Attributes +@node Projecting Attributes, Attribute Examples, Displaying Attributes, Old Style Attribute Declarations +@subsection Projecting Attributes Constraint solvers must be able to project a set of constraints to a set of variables. This is useful when displaying the solution to a goal, but @@ -12626,8 +12852,8 @@ original constraints into a set of new constraints on the projection, and these constraints are the ones that will have an @code{attribute_goal/2} handler. -@node Attribute Examples, ,Projecting Attributes, Attributed Variables -@section Attribute Examples +@node Attribute Examples, ,Projecting Attributes, Old Style Attribute Declarations +@subsection Attribute Examples The following two examples example is taken from the SICStus Prolog manual. It sketches the implementation of a simple finite domain ``solver''. Note From c4b39d3ab9e54e80707335ee27accf338c55934b Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 12 Mar 2010 14:26:35 +0000 Subject: [PATCH 25/37] update Prolog code: do a cleanup and make delays use SWI interface. --- Makefile.in | 5 +- library/atts.yap | 70 +--- library/dialect/swi.yap | 2 - pl/attributes.yap | 283 +++++++++++++++- pl/boot.yap | 2 +- pl/corout.yap | 704 +++++++++++----------------------------- pl/init.yap | 8 +- 7 files changed, 467 insertions(+), 607 deletions(-) diff --git a/Makefile.in b/Makefile.in index 14c2d951e..c5d24b221 100755 --- a/Makefile.in +++ b/Makefile.in @@ -210,7 +210,10 @@ C_SOURCES= \ $(srcdir)/MYDDAS/myddas_wkb2prolog.c PL_SOURCES= \ - $(srcdir)/pl/arith.yap $(srcdir)/pl/arrays.yap $(srcdir)/pl/boot.yap \ + $(srcdir)/pl/arith.yap \ + $(srcdir)/pl/arrays.yap \ + $(srcdir)/pl/attributes.yap \ + $(srcdir)/pl/boot.yap \ $(srcdir)/pl/callcount.yap\ $(srcdir)/pl/checker.yap $(srcdir)/pl/chtypes.yap \ $(srcdir)/pl/consult.yap \ diff --git a/library/atts.yap b/library/atts.yap index e76d91b57..86f8380f4 100644 --- a/library/atts.yap +++ b/library/atts.yap @@ -156,21 +156,12 @@ expand_put_attributes(Atts,Mod,Var,attributes:put_module_atts(Var,AccessTerm)) : expand_put_attributes(Att,Mod,Var,Goal) :- expand_put_attributes([Att],Mod,Var,Goal). -woken_att_do(AttVar, Binding) :- - get_all_swi_atts(AttVar,SWIAtts), +woken_att_do(AttVar, Binding, NGoals, DoNotBind) :- modules_with_attributes(AttVar,Mods0), modules_with_attributes(Mods), find_used(Mods,Mods0,[],ModsI), do_verify_attributes(ModsI, AttVar, Binding, Goals), - process_goals(Goals, NGoals, DoNotBind), - ( DoNotBind == true - -> - unbind_attvar(AttVar) - ; - bind_attvar(AttVar) - ), - do_hook_attributes(SWIAtts, Binding), - lcall(NGoals). + process_goals(Goals, NGoals, DoNotBind). % dirty trick to be able to unbind a variable that has been constrained. process_goals([], [], _). @@ -198,62 +189,5 @@ do_verify_attributes([Mod|Mods], AttVar, Binding, [Mod:Goal|Goals]) :- do_verify_attributes([_|Mods], AttVar, Binding, Goals) :- do_verify_attributes(Mods, AttVar, Binding, Goals). -do_hook_attributes([], _). -do_hook_attributes(att(Mod,Att,Atts), Binding) :- - current_predicate(attr_unify_hook,Mod:attr_unify_hook(_,_)), - !, - Mod:attr_unify_hook(Att, Binding), - do_hook_attributes(Atts, Binding). -do_hook_attributes(att(_,_,Atts), Binding) :- - do_hook_attributes(Atts, Binding). - -lcall([]). -lcall([Mod:Gls|Goals]) :- - lcall2(Gls,Mod), - lcall(Goals). - -lcall2([], _). -lcall2([Goal|Goals], Mod) :- - call(Mod:Goal), - lcall2(Goals, Mod). - -convert_att_var(V, Gs) :- - modules_with_attributes(V,LMods), - fetch_att_goals(LMods,V,Gs0), !, - simplify_trues(Gs0, Gs). -convert_att_var(_, true). - -fetch_att_goals([Mod], Att, G1) :- - call_module_attributes(Mod, Att, G1), !. -fetch_att_goals([_], _, true) :- !. -fetch_att_goals([Mod|LMods], Att, (G1,LGoal)) :- - call_module_attributes(Mod, Att, G1), !, - fetch_att_goals(LMods, Att, LGoal). -fetch_att_goals([_|LMods], Att, LGoal) :- - fetch_att_goals(LMods, Att, LGoal). - -% -% if there is an active attribute for this module call attribute_goal. -% -call_module_attributes(Mod, AttV, G1) :- - current_predicate(attribute_goal, Mod:attribute_goal(AttV,G1)), - Mod:attribute_goal(AttV, G1). - -simplify_trues((A,B), NG) :- !, - simplify_trues(A, NA), - simplify_trues(B, NB), - simplify_true(NA, NB, NG). -simplify_trues(G, G). - -simplify_true(true, G, G) :- !. -simplify_true(G, true, G) :- !. -simplify_true(A, B, (A,B)). - - -convert_to_goals([G],G) :- !. -convert_to_goals([A|G],(A,Gs)) :- - convert_to_goals(G,Gs). - - \ No newline at end of file diff --git a/library/dialect/swi.yap b/library/dialect/swi.yap index 38952e273..497d052b9 100755 --- a/library/dialect/swi.yap +++ b/library/dialect/swi.yap @@ -15,8 +15,6 @@ :- set_prolog_flag(user_flags,silent). -:- ensure_loaded(library(atts)). - :- use_module(library(charsio),[write_to_chars/2,read_from_chars/2]). :- use_module(library(lists),[append/2, diff --git a/pl/attributes.yap b/pl/attributes.yap index 1cefa0c45..4d08ec6ab 100644 --- a/pl/attributes.yap +++ b/pl/attributes.yap @@ -15,37 +15,32 @@ * * *************************************************************************/ -:- module('$attributes', [get_attr/3, - put_attr/3, - del_attr/2, - del_attrs/1, - get_attrs/2, - put_attrs/2 +:- module('$attributes', [ + project_delayed_goals/2 ]). - -get_attr(Var, Mod, Att) :- +prolog:get_attr(Var, Mod, Att) :- functor(AttTerm, Mod, 2), arg(2, AttTerm, Att), attributes:get_module_atts(Var, AttTerm). -put_attr(Var, Mod, Att) :- +prolog:put_attr(Var, Mod, Att) :- functor(AttTerm, Mod, 2), arg(2, AttTerm, Att), attributes:put_module_atts(Var, AttTerm). -del_attr(Var, Mod) :- +prolog:del_attr(Var, Mod) :- functor(AttTerm, Mod, 2), attributes:del_all_module_atts(Var, AttTerm). -del_attrs(Var) :- +prolog:del_attrs(Var) :- attributes:del_all_atts(Var). -get_attrs(AttVar, SWIAtts) :- +prolog:get_attrs(AttVar, SWIAtts) :- attributes:get_all_swi_atts(AttVar,SWIAtts). -put_attrs(_, []). -put_attrs(V, Atts) :- +prolog:put_attrs(_, []). +prolog:put_attrs(V, Atts) :- cvt_to_swi_atts(Atts, YapAtts), attributes:put_att_term(V, YapAtts). @@ -54,3 +49,263 @@ cvt_to_swi_atts(att(Mod,Attribute,Atts), ModAttribute) :- ModAttribute =.. [Mod, YapAtts, Attribute], cvt_to_swi_atts(Atts, YapAtts). +% +% wake_up_goal is called by the system whenever a suspended goal +% resumes. +% + +/* The first case may happen if this variable was used for dif. + In this case, we need a way to keep the original + suspended goal around +*/ +%'$wake_up_goal'([Module1|Continuation],G) :- +% '$write'(4,vsc_woke:G+[Module1|Continuation]:' +%'), fail. +prolog:'$wake_up_goal'([Module1|Continuation], LG) :- + execute_woken_system_goals(LG), + do_continuation(Continuation, Module1). + + +% +% in the first two cases restore register immediately and proceed +% to continuation. In the last case take care with modules, but do +% not act as if a meta-call. +% +% +do_continuation('$cut_by'(X), _) :- !, + '$$cut_by'(X). +do_continuation('$restore_regs'(X), _) :- !, + '$restore_regs'(X). +do_continuation('$restore_regs'(X,Y), _) :- !, + '$restore_regs'(X,Y). +do_continuation(Continuation, Module1) :- + execute_continuation(Continuation,Module1). + +execute_continuation(Continuation, Module1) :- + '$undefined'(Continuation, Module1), !, + '$undefp'([Module1|Continuation]). +execute_continuation(Continuation, Mod) :- + % do not do meta-expansion nor any fancy stuff. + '$execute0'(Continuation, Mod). + + +execute_woken_system_goals([]). +execute_woken_system_goals([G|LG]) :- + execute_woken_system_goals(LG), + execute_woken_system_goal(G). + +% +% X surely was bound, otherwise we would not be awaken. +% +execute_woken_system_goal('$att_do'(V,New)) :- + call_atts(V,New). + +% +% what to do when an attribute gets bound +% +call_atts(V,_) :- + nonvar(V), !. +call_atts(V,_) :- + '$att_bound'(V), !. +call_atts(V,New) :- + attributes:get_all_swi_atts(V,SWIAtts), + ( + '$undefined'(woken_att_do(V, New, LGoals, DoNotBind), attributes) + -> + LGoals = [], + DoNotBind = false + ; + attributes:woken_att_do(V, New, LGoals, DoNotBind) + ), + ( DoNotBind == true + -> + attributes:unbind_attvar(V) + ; + attributes:bind_attvar(V) + ), + do_hook_attributes(SWIAtts, New), + lcall(LGoals). + +do_hook_attributes([], _). +do_hook_attributes(att(Mod,Att,Atts), Binding) :- + ('$undefined'(attr_unify_hook(Att,Binding), Mod) + -> + true + ; + Mod:attr_unify_hook(Att, Binding) + ), + do_hook_attributes(Atts, Binding). + + +lcall([]). +lcall([Mod:Gls|Goals]) :- + lcall2(Gls,Mod), + lcall(Goals). + +lcall2([], _). +lcall2([Goal|Goals], Mod) :- + call(Mod:Goal), + lcall2(Goals, Mod). + + + +prolog:call_residue_vars(Goal,Residue) :- + attributes:all_attvars(Vs0), + call(Goal), + attributes:all_attvars(Vs), + % this should not be actually strictly necessary right now. + % but it makes it a safe bet. + sort(Vs, Vss), + sort(Vs0, Vs0s), + '$ord_remove'(Vss, Vs0s, Residue). + +'$ord_remove'([], _, []). +'$ord_remove'([V|Vs], [], [V|Vs]). +'$ord_remove'([V1|Vss], [V2|Vs0s], Residue) :- + ( V1 == V2 -> + '$ord_remove'(Vss, Vs0s, Residue) + ; + V1 @< V2 -> + Residue = [V1|ResidueF], + '$ord_remove'(Vss, [V2|Vs0s], ResidueF) + ; + '$ord_remove'([V1|Vss], Vs0s, Residue) + ). + +prolog:copy_term(Term, Copy, Goals) :- + term_variables(Term, TVars), + '$get_goalist_from_attvars'(TVars, Goals0), + copy_term_nat([Term|Goals0], [Copy|Goals]). + +prolog:call_residue(Goal,Residue) :- + var(Goal), !, + '$do_error'(instantiation_error,call_residue(Goal,Residue)). +prolog:call_residue(Module:Goal,Residue) :- + atom(Module), !, + call_residue(Goal,Module,Residue). +prolog:call_residue(Goal,Residue) :- + '$current_module'(Module), + call_residue(Goal,Module,Residue). + +call_residue(Goal,Module,Residue) :- + call(Module:Goal). + +% called by top_level to find out about delayed goals +project_delayed_goals(G,LGs) :- + % SICStus compatible step, + % just try to simplify store by projecting constraints + % over query variables. + ( + current_predicate(attributes:modules_with_attributes/1), false + -> + attributes:all_attvars(LAV), + LAV = [_|_], + !, + project_attributes(LAV, G), + % now get a list of frozen goals. + attributes:all_attvars(NLAV) + ; + attributed(G, NLAV), + NLAV = [_|_] + ), + !, + get_goalist_from_attvars(NLAV, LGs). +project_delayed_goals(_,[]). + + +attributed(G, Vs) :- + term_variables(G, LAV), + att_vars(LAV, Vs). + +att_vars([], []). +att_vars([V|LGs], [V|AttVars]) :- attvar(V), !, + att_vars(LGs, AttVars). +att_vars([_|LGs], AttVars) :- + att_vars(LGs, AttVars). + +% make sure we set the suspended goal list to its previous state! +% make sure we have installed a SICStus like constraint solver. +project_attributes(_, _) :- + '$undefined'(modules_with_attributes(_),attributes), !. +project_attributes(AllVs, G) :- + attributes:modules_with_attributes(LMods), + term_variables(G, InputVs), + pick_att_vars(InputVs, AttIVs), + project_module(LMods, AttIVs, AllVs). + +pick_att_vars([],[]). +pick_att_vars([V|L],[V|NL]) :- attvar(V), !, + pick_att_vars(L,NL). +pick_att_vars([_|L],NL) :- + pick_att_vars(L,NL). + +project_module([], _, _). +project_module([Mod|LMods], LIV, LAV) :- + '$pred_exists'(project_attributes(LIV, LAV),Mod), + '$notrace'(Mod:project_attributes(LIV, LAV)), !, + attributes:all_attvars(NLAV), + project_module(LMods,LIV,NLAV). +project_module([_|LMods], LIV, LAV) :- + project_module(LMods,LIV,LAV). + +% given a list of attributed variables, generate a conjunction of goals. +% +get_conj_from_attvars(TVars, Goals) :- + get_goalist_from_attvars(TVars, [], GoalList, []), + list_to_conjunction(GoalList, Goals). + +% +% same, but generate list +% +get_goalist_from_attvars(TVars, GoalList) :- + get_goalist_from_attvars(TVars, GoalList, []). + +get_goalist_from_attvars([]) --> []. +get_goalist_from_attvars([V|TVars]) --> + get_goalist_from_attvar(V), + get_goalist_from_attvars(TVars). + +get_goalist_from_attvar(V) --> { attvar(V) }, !, + { attributes:get_all_atts(V, AllAtts) }, + all_atts_to_goals(AllAtts, V). +get_goalist_from_attvar(_) --> []. + +all_atts_to_goals(AllAtts, _) --> { var(AllAtts) }, !. +all_atts_to_goals(AllAtts, V) --> + { + functor(AllAtts, Mod, _), + arg(1, AllAtts, MoreAtts) + }, + attgoals_for_module(Mod, V, AllAtts), + all_atts_to_goals(MoreAtts, V). + +% +% check constraints for variable +% +attgoals_for_module(Mod, V, _Gs, GoalListF, GoalList0) :- + % SWI, HProlog + '$pred_exists'(attribute_goals(V,GoalListF,GoalList0), Mod), !, + ( + '$notrace'(Mod:attribute_goals(V,GoalListF,GoalList0)) + -> + true + ; + GoalListF = GoalList0 + ). +attgoals_for_module(Mod, V, _, GoalListF, GoalList0) :- + % SICStus + '$pred_exists'(attribute_goal(V,G),Mod), !, + ( + '$notrace'(Mod:attribute_goal(V,G)) + -> + GoalListF = [G|GoalList0] + ; + GoalListF = GoalList0 + ). +attgoals_for_module(Mod, V, _, GoalList, GoalList). + +list_to_conjunction([], true). +list_to_conjunction([G], G) :- !. +list_to_conjunction([G|GoalList], (G,Goals0)) :- + list_to_conjunction(GoalList, Goals0). + diff --git a/pl/boot.yap b/pl/boot.yap index 96c0aa5aa..209d14973 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -567,7 +567,7 @@ true :- true. \+ '$undefined'(bindings_message(_,_,_), swi), swi:bindings_message(V, LGs, []), !. '$output_frozen'(G,V,LGs) :- - '$project_and_delayed_goals'(G,LGs). + '$attributes':project_delayed_goals(G,LGs). % % present_answer has three components. First it flushes the streams, diff --git a/pl/corout.yap b/pl/corout.yap index 0681d31f9..8fd3c7be3 100644 --- a/pl/corout.yap +++ b/pl/corout.yap @@ -16,152 +16,69 @@ *************************************************************************/ -%:- module(coroutining,[ -%dif/2, -%when/2, -%block/1, -%wait/1, -%frozen/2 -%]). + %dif/2, + %when/2, + %block/1, + %wait/1, + %frozen/2 +:- module('$coroutining',[]). + + +attr_unify_hook(DelayList, _) :- + wake_delays(DelayList). + +wake_delays([]). +wake_delays(Delay.List) :- + wake_delay(Delay), + wake_delays(List). % +% Interface to attributed variables. +% +wake_delay(redo_dif(Done, X, Y)) :- + redo_dif(Done, X, Y). +wake_delay(redo_freeze(Done, V, Goal)) :- + redo_freeze(Done, V, Goal). +wake_delay(redo_eq(Done, X, Y, Goal)) :- + redo_eq(Done, X, Y, Goal, G). +wake_delay(redo_ground(Done, X, Goal)) :- + redo_ground(Done, X, Goal). + +attribute_goals(Var) --> + { get_attr(Var, '$coroutining', Delays) }, + attgoal_for_delays(Delays, Var). + +attgoal_for_delays([], V) --> []. +attgoal_for_delays([G|AllAtts], V) --> + attgoal_for_delay(G, V), + attgoal_for_delays(AllAtts, V). + +attgoal_for_delay(redo_dif(Done, X, Y), V) --> { var(Done), first_att(dif(X,Y), V) }, !, [prolog:dif(X,Y)]. +attgoal_for_delay(redo_freeze(Done, V, Goal), V) --> { var(Done) }, !, [prolog:freeze(V,Goal)]. +attgoal_for_delay(redo_eq(Done, X, Y, Goal), V) --> { var(Done), first_att(Goal, V) }, !, [prolog:when(X=Y,Goal)]. +attgoal_for_delay(redo_ground(Done, X, Goal), V) --> { var(Done) }, !, [prolog:when(ground(X),Goal)]. +attgoal_for_delay(_, V) --> []. + + % % operators defined in this module: % :- op(1150, fx, block). -% -% Tell the system how to present frozen goals. -% - -:- assert((extensions_to_present_answer(Level) :- - '$show_frozen_goals'(Level))). - -'$project_and_delayed_goals'(G,LGs) :- - '$attributed'(G, LAV), -% attributes:all_attvars(LAV), - LAV = [_|_], !, - % SICStus compatible step, - % just try to simplify store by projecting constraints - % over query variables. - '$project_attributes'(LAV, G), - % now get a list of frozen goals. - '$attributed'(G, NLAV), -% attributes:all_attvars(NLAV), - '$get_goalist_from_attvars'(NLAV, LGs). -'$project_and_delayed_goals'(_,[]). - - -'$attributed'(G, Vs) :- - term_variables(G, LAV), - '$find_att_vars'(LAV, Vs). - -'$check_atts'([], []). -'$check_atts'(V.LAV, V.Vs) :- - attvar(V), !, - '$check_atts'(LAV, Vs). -'$check_atts'(_.LAV, Vs) :- - '$check_atts'(LAV, Vs). - - -% -% wake_up_goal is called by the system whenever a suspended goal -% resumes. -% - -/* The first case may happen if this variable was used for dif. - In this case, we need a way to keep the original - suspended goal around -*/ -%'$wake_up_goal'([Module1|Continuation],G) :- -% '$write'(4,vsc_woke:G+[Module1|Continuation]:' -%'), fail. -'$wake_up_goal'([Module1|Continuation], LG) :- -%write(waking:LG),nl, - '$execute_woken_system_goals'(LG), - '$do_continuation'(Continuation, Module1). - - -% -% in the first two cases restore register immediately and proceed -% to continuation. In the last case take care with modules, but do -% not act as if a meta-call. -% -% -'$do_continuation'('$cut_by'(X), _) :- !, - '$$cut_by'(X). -'$do_continuation'('$restore_regs'(X), _) :- !, - '$restore_regs'(X). -'$do_continuation'('$restore_regs'(X,Y), _) :- !, - '$restore_regs'(X,Y). -'$do_continuation'(Continuation, Module1) :- - '$execute_continuation'(Continuation,Module1). - -'$execute_continuation'(Continuation, Module1) :- - '$undefined'(Continuation, Module1), !, - '$undefp'([Module1|Continuation]). -'$execute_continuation'(Continuation, Mod) :- - % do not do meta-expansion nor any fancy stuff. - '$execute0'(Continuation, Mod). - - -'$execute_woken_system_goals'([]). -'$execute_woken_system_goals'([G|LG]) :- - '$execute_woken_system_goals'(LG), - '$execute_woken_system_goal'(G). - -% -% X surely was bound, otherwise we would not be awaken. -% -'$execute_woken_system_goal'('$att_do'(V,New)) :- - ( '$frozen_goals'(V, Goals) -> - '$call_atts'(V,New), - '$execute_frozen_goals'(Goals) - ; - '$call_atts'(V,New) - ). - -'$call_atts'(V,_) :- - nonvar(V), !. -'$call_atts'(V,_) :- - '$undefined'(woken_att_do(_,_), attributes), !, - attributes:bind_attvar(V). -'$call_atts'(V,_) :- - '$att_bound'(V), !. -'$call_atts'(V,New) :- - attributes:woken_att_do(V,New). - -'$execute_frozen_goals'([]). -'$execute_frozen_goals'([G0|Gs]) :- - '$execute_frozen_goal'(G0,G0), - '$execute_frozen_goals'(Gs). - -% -% X and Y may not be bound (multiple suspensions on the same goal). -% -'$execute_frozen_goal'('$redo_dif'(Done, X, Y), G) :- - '$redo_dif'(Done, X, Y, G). -'$execute_frozen_goal'('$redo_freeze'(Done, V, Goal), _) :- - '$redo_freeze'(Done, V, Goal). -'$execute_frozen_goal'('$redo_eq'(Done, X, Y, Goal), G) :- - '$redo_eq'(Done, X, Y, Goal, G). -'$execute_frozen_goal'('$redo_ground'(Done, X, Goal), _) :- - '$redo_ground'(Done, X, Goal). - -freeze(V, G) :- +prolog:freeze(V, G) :- var(V), !, - '$freeze_goal'(V,G). -freeze(_, G) :- + freeze_goal(V,G). +prolog:freeze(_, G) :- '$execute'(G). -'$freeze_goal'(V,VG) :- +freeze_goal(V,VG) :- var(VG), !, '$current_module'(M), - '$freeze'(V, '$redo_freeze'(_Done,V,M:VG)). -'$freeze_goal'(V,M:G) :- !, - '$freeze'(V, '$redo_freeze'(_Done,V,M:G)). -'$freeze_goal'(V,G) :- + internal_freeze(V, redo_freeze(_Done,V,M:VG)). +freeze_goal(V,M:G) :- !, + internal_freeze(V, redo_freeze(_Done,V,M:G)). +freeze_goal(V,G) :- '$current_module'(M), - '$freeze'(V, '$redo_freeze'(_Done,V,M:G)). + internal_freeze(V, redo_freeze(_Done,V,M:G)). % % @@ -199,16 +116,17 @@ freeze(_, G) :- % several times. dif calls a special version of freeze that checks % whether that is in fact the case. % -dif(X, Y) :- '$can_unify'(X, Y, LVars), !, +prolog:dif(X, Y) :- + '$can_unify'(X, Y, LVars), !, LVars = [_|_], - '$dif_suspend_on_lvars'(LVars, '$redo_dif'(_Done, X, Y)). -dif(_, _). + dif_suspend_on_lvars(LVars, redo_dif(_Done, X, Y)). +prolog:dif(_, _). -'$dif_suspend_on_lvars'([], _). -'$dif_suspend_on_lvars'([H|T], G) :- - '$freeze'(H, G), - '$dif_suspend_on_lvars'(T, G). +dif_suspend_on_lvars([], _). +dif_suspend_on_lvars([H|T], G) :- + internal_freeze(H, G), + dif_suspend_on_lvars(T, G). % % This predicate is called whenever a variable dif was suspended on is @@ -219,72 +137,72 @@ dif(_, _). % we try to increase the number of suspensions; last, the two terms % did not unify, we are done, so we succeed and bind the Done variable. % -'$redo_dif'(Done, _, _, _) :- nonvar(Done), !. -'$redo_dif'(_, X, Y, G) :- +redo_dif(Done, _, _) :- nonvar(Done), !. +redo_dif(Done, X, Y) :- '$can_unify'(X, Y, LVars), !, LVars = [_|_], - '$dif_suspend_on_lvars'(LVars, G). -'$redo_dif'('$done', _, _, _). + dif_suspend_on_lvars(LVars, redo_dif(Done, X, Y)). +redo_dif('$done', _, _). % If you called nonvar as condition for when, then you may find yourself % here. % % someone else (that is Cond had ;) did the work, do nothing % -'$redo_freeze'(Done, _, _) :- nonvar(Done), !. +redo_freeze(Done, _, _) :- nonvar(Done), !. % % We still have some more conditions: continue the analysis. % -'$redo_freeze'(Done, _, '$when'(C, G, Done)) :- !, +redo_freeze(Done, _, '$when'(C, G, Done)) :- !, '$when'(C, G, Done). % % check if the variable was really bound % -'$redo_freeze'(Done, V, G) :- var(V), !, - '$freeze'(V, '$redo_freeze'(Done,V,G)). +redo_freeze(Done, V, G) :- var(V), !, + internal_freeze(V, redo_freeze(Done,V,G)). % % I can't believe it: we're done and can actually execute our % goal. Notice we have to say we are done, otherwise someone else in % the disjunction might decide to wake up the goal themselves. % -'$redo_freeze'('$done', _, G) :- +redo_freeze('$done', _, G) :- '$execute'(G). % % eq is a combination of dif and freeze -'$redo_eq'(Done, _, _, _, _) :- nonvar(Done), !. -'$redo_eq'(_, X, Y, _, G) :- +redo_eq(Done, _, _, _, _) :- nonvar(Done), !. +redo_eq(_, X, Y, _, G) :- '$can_unify'(X, Y, LVars), LVars = [_|_], !, - '$dif_suspend_on_lvars'(LVars, G). -'$redo_eq'(Done, _, _, '$when'(C, G, Done), _) :- !, - '$when'(C, G, Done). -'$redo_eq'('$done', _ ,_ , Goal, _) :- + dif_suspend_on_lvars(LVars, G). +redo_eq(Done, _, _, when(C, G, Done), _) :- !, + when(C, G, Done). +redo_eq('$done', _ ,_ , Goal, _) :- '$execute'(Goal). % % ground is similar to freeze -'$redo_ground'(Done, _, _) :- nonvar(Done), !. -'$redo_ground'(Done, X, Goal) :- +redo_ground(Done, _, _) :- nonvar(Done), !. +redo_ground(Done, X, Goal) :- '$non_ground'(X, Var), !, - '$freeze'(Var, '$redo_ground'(Done, X, Goal)). -'$redo_ground'(Done, _, '$when'(C, G, Done)) :- !, - '$when'(C, G, Done). -'$redo_ground'('$done', _, Goal) :- + internal_freeze(Var, redo_ground(Done, X, Goal)). +redo_ground(Done, _, when(C, G, Done)) :- !, + when(C, G, Done). +redo_ground('$done', _, Goal) :- '$execute'(Goal). % % support for when/2 built-in % -when(Conds,Goal) :- +prolog:when(Conds,Goal) :- '$current_module'(Mod), - '$prepare_goal_for_when'(Goal, Mod, ModG), - '$when'(Conds, ModG, Done, [], LG), !, + prepare_goal_for_when(Goal, Mod, ModG), + when(Conds, ModG, Done, [], LG), !, %write(vsc:freezing(LG,Done)),nl, - '$suspend_when_goals'(LG, Done). -when(_,Goal) :- + suspend_when_goals(LG, Done). +prolog:when(_,Goal) :- '$execute'(Goal). % @@ -296,7 +214,7 @@ when(_,Goal) :- % % '$declare_when'(Cond, G) :- - '$generate_code_for_when'(Cond, G, Code), + generate_code_for_when(Cond, G, Code), '$current_module'(Module), '$$compile'(Code, Code, 5, Module), fail. '$declare_when'(_,_). @@ -304,19 +222,19 @@ when(_,Goal) :- % % use a meta interpreter for now % -'$generate_code_for_when'(Conds, G, - ( G :- '$when'(Conds, ModG, Done, [], LG), !, - '$suspend_when_goals'(LG, Done)) ) :- +generate_code_for_when(Conds, G, + ( G :- when(Conds, ModG, Done, [], LG), !, + suspend_when_goals(LG, Done)) ) :- '$current_module'(Mod), - '$prepare_goal_for_when'(G, Mod, ModG). + prepare_goal_for_when(G, Mod, ModG). % % make sure we have module info for G! % -'$prepare_goal_for_when'(G, Mod, Mod:call(G)) :- var(G), !. -'$prepare_goal_for_when'(M:G, _, M:G) :- !. -'$prepare_goal_for_when'(G, Mod, Mod:G). +prepare_goal_for_when(G, Mod, Mod:call(G)) :- var(G), !. +prepare_goal_for_when(M:G, _, M:G) :- !. +prepare_goal_for_when(G, Mod, Mod:G). % @@ -329,39 +247,39 @@ when(_,Goal) :- % $when/5 and $when_suspend succeds when there is need to suspend a goal % % -'$when'(V, G, Done, LG0, LGF) :- var(V), !, +when(V, G, Done, LG0, LGF) :- var(V), !, '$do_error'(instantiation_error,when(V,G)). -'$when'(nonvar(V), G, Done, LG0, LGF) :- - '$when_suspend'(nonvar(V), G, Done, LG0, LGF). -'$when'(?=(X,Y), G, Done, LG0, LGF) :- - '$when_suspend'(?=(X,Y), G, Done, LG0, LGF). -'$when'(ground(T), G, Done, LG0, LGF) :- - '$when_suspend'(ground(T), G, Done, LG0, LGF). -'$when'((C1, C2), G, Done, LG0, LGF) :- +when(nonvar(V), G, Done, LG0, LGF) :- + when_suspend(nonvar(V), G, Done, LG0, LGF). +when(?=(X,Y), G, Done, LG0, LGF) :- + when_suspend(?=(X,Y), G, Done, LG0, LGF). +when(ground(T), G, Done, LG0, LGF) :- + when_suspend(ground(T), G, Done, LG0, LGF). +when((C1, C2), G, Done, LG0, LGF) :- % leave it open to continue with when. ( - '$when'(C1, '$when'(C2, G, Done), Done, LG0, LGI) + when(C1, when(C2, G, Done), Done, LG0, LGI) -> LGI = LGF ; % we solved C1, great, now we just have to solve C2! - '$when'(C2, G, Done, LG0, LGF) + when(C2, G, Done, LG0, LGF) ). -'$when'((G1 ; G2), G, Done, LG0, LGF) :- - '$when'(G1, G, Done, LG0, LGI), - '$when'(G2, G, Done, LGI, LGF). +when((G1 ; G2), G, Done, LG0, LGF) :- + when(G1, G, Done, LG0, LGI), + when(G2, G, Done, LGI, LGF). % % Auxiliary predicate called from within a conjunction. % Repeat basic code for when, as inserted in first clause for predicate. % -'$when'(_, _, Done) :- +when(_, _, Done) :- nonvar(Done), !. -'$when'(Cond, G, Done) :- - '$when'(Cond, G, Done, [], LG), +when(Cond, G, Done) :- + when(Cond, G, Done, [], LG), !, - '$suspend_when_goals'(LG, Done). -'$when'(_, G, '$done') :- + suspend_when_goals(LG, Done). +when(_, G, '$done') :- '$execute'(G). % @@ -369,47 +287,47 @@ when(_,Goal) :- % % some one else did the work. % -'$when_suspend'(_, _, Done, _, []) :- nonvar(Done), !. +when_suspend(_, _, Done, _, []) :- nonvar(Done), !. % % now for the serious stuff. % -'$when_suspend'(nonvar(V), G, Done, LG0, LGF) :- - '$try_freeze'(V, G, Done, LG0, LGF). -'$when_suspend'(?=(X,Y), G, Done, LG0, LGF) :- - '$try_eq'(X, Y, G, Done, LG0, LGF). -'$when_suspend'(ground(X), G, Done, LG0, LGF) :- - '$try_ground'(X, G, Done, LG0, LGF). +when_suspend(nonvar(V), G, Done, LG0, LGF) :- + try_freeze(V, G, Done, LG0, LGF). +when_suspend(?=(X,Y), G, Done, LG0, LGF) :- + try_eq(X, Y, G, Done, LG0, LGF). +when_suspend(ground(X), G, Done, LG0, LGF) :- + try_ground(X, G, Done, LG0, LGF). -'$try_freeze'(V, G, Done, LG0, LGF) :- +try_freeze(V, G, Done, LG0, LGF) :- var(V), - LGF = ['$freeze'(V, '$redo_freeze'(Done, V, G))|LG0]. + LGF = ['$coroutining':internal_freeze(V, redo_freeze(Done, V, G))|LG0]. -'$try_eq'(X, Y, G, Done, LG0, LGF) :- +try_eq(X, Y, G, Done, LG0, LGF) :- '$can_unify'(X, Y, LVars), LVars = [_|_], - LGF = ['$dif_suspend_on_lvars'(LVars, '$redo_eq'(Done, X, Y, G))|LG0]. + LGF = ['$coroutining':dif_suspend_on_lvars(LVars, redo_eq(Done, X, Y, G))|LG0]. -'$try_ground'(X, G, Done, LG0, LGF) :- +try_ground(X, G, Done, LG0, LGF) :- '$non_ground'(X, Var), % the C predicate that succeds if % finding out the term is nonground % and gives the first variable it % finds. Notice that this predicate % must know about svars. - LGF = ['$freeze'(Var, '$redo_ground'(Done, X, G))| LG0]. + LGF = ['$coroutining':internal_freeze(Var, redo_ground(Done, X, G))| LG0]. % % When executing a when, if nobody succeeded, we need to create suspensions. % -'$suspend_when_goals'([], _). -'$suspend_when_goals'(['$freeze'(V, G)|Ls], Done) :- +suspend_when_goals([], _). +suspend_when_goals(['$coroutining':internal_freeze(V, G)|Ls], Done) :- var(Done), !, - '$freeze'(V, G), - '$suspend_when_goals'(Ls, Done). -'$suspend_when_goals'(['$dif_suspend_on_lvars'(LVars, G)|LG], Done) :- + internal_freeze(V, G), + suspend_when_goals(Ls, Done). +suspend_when_goals([dif_suspend_on_lvars(LVars, G)|LG], Done) :- var(Done), !, - '$dif_suspend_on_lvars'(LVars, G), - '$suspend_when_goals'(LG, Done). -'$suspend_when_goals'([_|_], _). + dif_suspend_on_lvars(LVars, G), + suspend_when_goals(LG, Done). +suspend_when_goals([_|_], _). % % Support for wait declarations on goals. @@ -424,31 +342,31 @@ when(_,Goal) :- % choicepoint and make things a bit slower, but it's probably not as % significant as the remaining overheads. % -'$block'(Conds) :- - '$generate_blocking_code'(Conds, _, Code), +prolog:'$block'(Conds) :- + generate_blocking_code(Conds, _, Code), '$current_module'(Module), '$$compile'(Code, Code, 5, Module), fail. -'$block'(_). +prolog:'$block'(_). -'$generate_blocking_code'(Conds, G, Code) :- +generate_blocking_code(Conds, G, Code) :- '$extract_head_for_block'(Conds, G), '$recorded'('$blocking_code','$code'(G,OldConds),R), !, erase(R), functor(G, Na, Ar), '$current_module'(M), abolish(M:Na, Ar), - '$generate_blocking_code'((Conds,OldConds), G, Code). -'$generate_blocking_code'(Conds, G, (G :- (If, !, when(When, G)))) :- - '$extract_head_for_block'(Conds, G), + generate_blocking_code((Conds,OldConds), G, Code). +generate_blocking_code(Conds, G, (G :- (If, !, when(When, G)))) :- + extract_head_for_block(Conds, G), recorda('$blocking_code','$code'(G,Conds),_), - '$generate_body_for_block'(Conds, G, If, When). + generate_body_for_block(Conds, G, If, When). % % find out what we are blocking on. % -'$extract_head_for_block'((C1, _), G) :- !, - '$extract_head_for_block'(C1, G). -'$extract_head_for_block'(C, G) :- +extract_head_for_block((C1, _), G) :- !, + extract_head_for_block(C1, G). +extract_head_for_block(C, G) :- functor(C, Na, Ar), functor(G, Na, Ar). @@ -472,323 +390,73 @@ when(_,Goal) :- % (var(A1), var(A2) -> true ; (var(A2), var(A3) -> true ; fail)), !, % when(((nonvar(A1);nonvar(A2)),(nonvar(A2);nonvar(A3))),G). -'$generate_body_for_block'((C1, C2), G, (Code1 -> true ; Code2), (WhenConds,OtherWhenConds)) :- !, - '$generate_for_cond_in_block'(C1, G, Code1, WhenConds), - '$generate_body_for_block'(C2, G, Code2, OtherWhenConds). -'$generate_body_for_block'(C, G, (Code -> true ; fail), WhenConds) :- - '$generate_for_cond_in_block'(C, G, Code, WhenConds). +generate_body_for_block((C1, C2), G, (Code1 -> true ; Code2), (WhenConds,OtherWhenConds)) :- !, + generate_for_cond_in_block(C1, G, Code1, WhenConds), + generate_body_for_block(C2, G, Code2, OtherWhenConds). +generate_body_for_block(C, G, (Code -> true ; fail), WhenConds) :- + generate_for_cond_in_block(C, G, Code, WhenConds). -'$generate_for_cond_in_block'(C, G, Code, Whens) :- +generate_for_cond_in_block(C, G, Code, Whens) :- C =.. [_|Args], G =.. [_|GArgs], - '$fetch_out_variables_for_block'(Args,GArgs,L0Vars), - '$add_blocking_vars'(L0Vars, LVars), - '$generate_for_each_arg_in_block'(LVars, Code, Whens). + fetch_out_variables_for_block(Args,GArgs,L0Vars), + add_blocking_vars(L0Vars, LVars), + generate_for_each_arg_in_block(LVars, Code, Whens). -'$add_blocking_vars'([], [_]) :- !. -'$add_blocking_vars'(LV, LV). +add_blocking_vars([], [_]) :- !. +add_blocking_vars(LV, LV). -'$fetch_out_variables_for_block'([], [], []). -'$fetch_out_variables_for_block'(['?'|Args], [_|GArgs], LV) :- - '$fetch_out_variables_for_block'(Args, GArgs, LV). -'$fetch_out_variables_for_block'(['-'|Args], [GArg|GArgs], +fetch_out_variables_for_block([], [], []). +fetch_out_variables_for_block(['?'|Args], [_|GArgs], LV) :- + fetch_out_variables_for_block(Args, GArgs, LV). +fetch_out_variables_for_block(['-'|Args], [GArg|GArgs], [GArg|LV]) :- - '$fetch_out_variables_for_block'(Args, GArgs, LV). + fetch_out_variables_for_block(Args, GArgs, LV). -'$generate_for_each_arg_in_block'([], false, true). -'$generate_for_each_arg_in_block'([V], var(V), nonvar(V)) :- !. -'$generate_for_each_arg_in_block'([V|L], (var(V),If), (nonvar(V);Whens)) :- - '$generate_for_each_arg_in_block'(L, If, Whens). +generate_for_each_arg_in_block([], false, true). +generate_for_each_arg_in_block([V], var(V), nonvar(V)) :- !. +generate_for_each_arg_in_block([V|L], (var(V),If), (nonvar(V);Whens)) :- + generate_for_each_arg_in_block(L, If, Whens). % % The wait declaration is a simpler and more efficient version of block. % -'$wait'(Na/Ar) :- +prolog:'$wait'(Na/Ar) :- functor(S, Na, Ar), arg(1, S, A), '$current_module'(M), '$$compile'((S :- var(A), !, freeze(A, S)), (S :- var(A), !, freeze(A, S)), 5, M), fail. -'$wait'(_). +prolog:'$wait'(_). frozen(V, G) :- nonvar(V), !, '$do_error'(type_error(variable,V),frozen(V,G)). frozen(V, LG) :- - '$get_conj_from_attvars'([V], LG). + '$attributes':get_conj_from_attvars([V], LG). -'$find_att_vars'([], []). -'$find_att_vars'([V|LGs], [V|AttVars]) :- attvar(V), !, - '$find_att_vars'(LGs, AttVars). -'$find_att_vars'([_|LGs], AttVars) :- - '$find_att_vars'(LGs, AttVars). - -'$purge_done_goals'([], []). -'$purge_done_goals'([V|G0], GF) :- attvar(V), !, - '$purge_done_goals'(G0, GF). -'$purge_done_goals'(['$redo_dif'(Done, _ , _)|G0], GF) :- nonvar(Done), !, - '$purge_done_goals'(G0, GF). -'$purge_done_goals'(['$redo_freeze'(Done, _, _)|G0], GF) :- nonvar(Done), !, - '$purge_done_goals'(G0, GF). -'$purge_done_goals'(['$redo_freeze'(_Done, _, CallCleanup)|G0], GF) :- - nonvar(CallCleanup), - % be careful about possibly adding extra binding at this point. - CallCleanup = _:T, nonvar(T), T = '$clean_call'(_,_), !, - '$purge_done_goals'(G0, GF). -'$purge_done_goals'(['$redo_eq'(Done, _, _, _)|G0], GF) :- nonvar(Done), !, - '$purge_done_goals'(G0, GF). -'$purge_done_goals'(['$redo_ground'(Done, _, _)|G0], GF) :- nonvar(Done), !, - '$purge_done_goals'(G0, GF). -'$purge_done_goals'([G|G0], [G|GF]) :- - '$purge_done_goals'(G0, GF). - - -'$convert_frozen_goal'(V, _, _, V, _) :- attvar(V), !. -'$convert_frozen_goal'('$redo_dif'(Done, X, Y), LV, Done, [X,Y|LV], dif(X,Y)). -'$convert_frozen_goal'('$redo_freeze'(Done, FV, G), LV, Done, [FV|LV], G). -'$convert_frozen_goal'('$redo_eq'(Done, X, Y, G), LV, Done, [X,Y|LV], G). -'$convert_frozen_goal'('$redo_ground'(Done, V, G), LV, Done, [V|LV], G). - -'$fetch_same_done_goals'([], _, [], []). -'$fetch_same_done_goals'([V|G0], Done, NL, GF) :- attvar(V), !, - '$fetch_same_done_goals'(G0, Done, NL, GF). -'$fetch_same_done_goals'(['$redo_dif'(Done, X , Y)|G0], D0, [X,Y|LV], GF) :- - Done == D0, !, - '$fetch_same_done_goals'(G0, D0, LV, GF). -'$fetch_same_done_goals'(['$redo_freeze'(Done, V, _)|G0], D0, [V|LV], GF) :- - Done == D0, !, - '$fetch_same_done_goals'(G0, D0, LV, GF). -'$fetch_same_done_goals'(['$redo_eq'(Done, X, Y, _)|G0], D0, [X,Y|LV], GF) :- - Done == D0, !, - '$fetch_same_done_goals'(G0, D0, LV, GF). -'$fetch_same_done_goals'(['$redo_ground'(Done, G, _)|G0], D0, [G|LV], GF) :- - Done == D0, !, - '$fetch_same_done_goals'(G0, D0, LV, GF). -'$fetch_same_done_goals'([G|G0], D0, LV, [G|GF]) :- - '$fetch_same_done_goals'(G0, D0, LV, GF). - - -call_residue_vars(Goal,Residue) :- - attributes:all_attvars(Vs0), - call(Goal), - attributes:all_attvars(Vs), - % this should not be actually strictly necessary right now. - % but it makes it a safe bet. - sort(Vs, Vss), - sort(Vs0, Vs0s), - '$ord_remove'(Vss, Vs0s, Residue). - -'$ord_remove'([], _, []). -'$ord_remove'([V|Vs], [], [V|Vs]). -'$ord_remove'([V1|Vss], [V2|Vs0s], Residue) :- - ( V1 == V2 -> - '$ord_remove'(Vss, Vs0s, Residue) - ; - V1 @< V2 -> - Residue = [V1|ResidueF], - '$ord_remove'(Vss, [V2|Vs0s], ResidueF) - ; - '$ord_remove'([V1|Vss], Vs0s, Residue) - ). - -copy_term(Term, Copy, Goals) :- - term_variables(Term, TVars), - '$get_goalist_from_attvars'(TVars, Goals0), - copy_term_nat([Term|Goals0], [Copy|Goals]). - -call_residue(Goal,Residue) :- - var(Goal), !, - '$do_error'(instantiation_error,call_residue(Goal,Residue)). -call_residue(Module:Goal,Residue) :- - atom(Module), !, - '$call_residue'(Goal,Module,Residue). -call_residue(Goal,Residue) :- - '$current_module'(Module), - '$call_residue'(Goal,Module,Residue). - -'$call_residue'(Goal,Module,Residue) :- - '$read_svar_list'(OldAttsList), - copy_term_nat(Goal, NGoal), - ( '$set_svar_list'(CurrentAttsList), - '$system_catch'(NGoal,Module,Error,'$residue_catch_trap'(Error,OldAttsList)), - '$project_and_delayed_goals'(NGoal,Residue0), - '$add_vs_to_vlist'(Residue0, Residue), - ( '$set_svar_list'(OldAttsList), - copy_term_nat(NGoal+NResidue, Goal+Residue) - ; - '$set_svar_list'(CurrentAttsList), fail - ) - ; - '$set_svar_list'(OldAttsList), fail - ). - -'$add_vs_to_vlist'([], []). -'$add_vs_to_vlist'([G|Residue0], [Vs-G|Residue]) :- - term_variables(G, TVs), - '$pick_att_vars'(TVs, Vs), - '$add_vs_to_vlist'(Residue0, Residue). - - -% make sure we set the suspended goal list to its previous state! -'$residue_catch_trap'(Error,OldAttsList) :- - '$set_svar_list'(OldAttsList), - throw(Error). - -% make sure we have installed a SICStus like constraint solver. -'$project_attributes'(_, _) :- - '$undefined'(modules_with_attributes(_),attributes), !. -'$project_attributes'(AllVs, G) :- - attributes:modules_with_attributes(LMods), - term_variables(G, InputVs), - '$pick_att_vars'(InputVs, AttIVs), - '$project_module'(LMods, AttIVs, AllVs). - -'$pick_att_vars'([],[]). -'$pick_att_vars'([V|L],[V|NL]) :- attvar(V), !, - '$pick_att_vars'(L,NL). -'$pick_att_vars'([_|L],NL) :- - '$pick_att_vars'(L,NL). - -'$project_module'([], _, _). -'$project_module'([Mod|LMods], LIV, LAV) :- - '$pred_exists'(project_attributes(LIV, LAV),Mod), - '$notrace'(Mod:project_attributes(LIV, LAV)), !, - attributes:all_attvars(NLAV), - '$project_module'(LMods,LIV,NLAV). -'$project_module'([_|LMods], LIV, LAV) :- - '$project_module'(LMods,LIV,LAV). - - -'$convert_att_vars'(_, []) :- - % do nothing - '$undefined'(convert_att_var(Vs,LIV),attributes), !. -'$convert_att_vars'(Vs0, LGs) :- - '$sort'(Vs0, Vs), - '$do_convert_att_vars'(Vs0, LGs). - -'$do_convert_att_vars'([],[]). -'$do_convert_att_vars'([V|LAV], NGs) :- - attvar(V), - attributes:convert_att_var(V,G), - G \= true, - !, - '$split_goals_for_catv'(G,V,NGs,IGs), - '$do_convert_att_vars'(LAV, IGs). -'$do_convert_att_vars'([_|LAV], Gs) :- - '$do_convert_att_vars'(LAV, Gs). - -'$split_goals_for_catv'((G,NG),V,[V-G|Gs],Gs0) :- !, - '$split_goals_for_catv'(NG,V,Gs,Gs0). -'$split_goals_for_catv'(NG,V,[V-NG|Gs],Gs). - -'$vars_interset_for_constr'([V1|_],[V2|_]) :- - V1 == V2, !. -'$vars_interset_for_constr'([V1|GV],[V2|LIV]) :- - V1 @< V2, !, - '$vars_interset_for_constr'(GV,[V2|LIV]). -'$vars_interset_for_constr'([V1|GV],[_|LIV]) :- - '$vars_interset_for_constr'([V1|GV],LIV). - -'$process_when'('$when'(_,G,_), NG) :- !, - '$process_when'(G, NG). -'$process_when'(G, G). - -%'$freeze'(V,G) :- +%internal_freeze(V,G) :- % attributes:get_att(V, 0, Gs), write(G+Gs),nl,fail. -'$freeze'(V,G) :- - '$update_att'(V, G). +internal_freeze(V,G) :- + update_att(V, G). -'$update_att'(V, G) :- - attributes:get_module_atts(V, prolog(_,Gs)), !, - attributes:put_module_atts(V, prolog(_,[G|Gs])). -'$update_att'(V, G) :- - attributes:put_module_atts(V, prolog(_,[G])). +update_att(V, G) :- + attributes:get_module_atts(V, '$coroutining'(_,Gs)), + not_vmember(G, Gs), !, + attributes:put_module_atts(V, '$coroutining'(_,[G|Gs])). +update_att(V, G) :- + attributes:put_module_atts(V, '$coroutining'(_,[G])). -'$goal_in'(G,[G1|_]) :- G == G1, !. -'$goal_in'(G,[_|Gs]) :- - '$goal_in'(G,Gs). -'$frozen_goals'(V,Gs) :- - var(V), - attributes:get_att(V, prolog, 2, Gs), nonvar(Gs). - -% -% given a list of attributed variables, generate a conjunction of goals. -% -'$get_conj_from_attvars'(TVars, Goals) :- - '$get_goalist_from_attvars'(TVars, [], GoalList, []), - '$list_to_conjunction'(GoalList, Goals). - -% -% same, but generate list -% -'$get_goalist_from_attvars'(TVars, GoalList) :- - '$get_goalist_from_attvars'(TVars, [], GoalList, []). - -'$get_goalist_from_attvars'([], _, GoalList, GoalList). -'$get_goalist_from_attvars'([V|TVars], DonesSoFar, GoalListF, GoalList0) :- - '$get_goalist_from_attvar'(V, DonesSoFar, MoreDonesSoFar, GoalListF, GoalListI), - '$get_goalist_from_attvars'(TVars, MoreDonesSoFar, GoalListI, GoalList0). - -'$get_goalist_from_attvar'(V, DonesSoFar, MoreDonesSoFar, GoalListF, GoalList0) :- attvar(V), !, - attributes:get_all_atts(V, AllAtts), - '$all_atts_to_goals'(AllAtts, V, DonesSoFar, MoreDonesSoFar, GoalListF, GoalList0). -'$get_goalist_from_attvar'(_, DonesSoFar, DonesSoFar, GoalList, GoalList). - -'$all_atts_to_goals'(AllAtts, _, DonesSoFar, DonesSoFar, GoalList, GoalList) :- var(AllAtts), !. -'$all_atts_to_goals'(AllAtts, V, DonesSoFar, MoreDonesSoFar, GoalListF, GoalList0) :- - functor(AllAtts, Mod, _), - arg(1, AllAtts, MoreAtts), - '$attgoals_for_module'(Mod, V, AllAtts, DonesSoFar, IDonesSoFar, GoalListF, GoalListI), - '$all_atts_to_goals'(MoreAtts, V, IDonesSoFar, MoreDonesSoFar, GoalListI, GoalList0). - -% -% check constraints for variable -% -'$attgoals_for_module'(prolog, V, prolog(_,Gs), DonesSoFar, MoreDonesSoFar, GoalListF, GoalList0) :- !, - % dif, when, freeze - '$attgoals_for_prolog'(Gs, V, DonesSoFar, MoreDonesSoFar, GoalListF, GoalList0). -'$attgoals_for_module'(Mod, V, _Gs, DonesSoFar, DonesSoFar, GoalListF, GoalList0) :- - % SWI, HProlog - current_predicate(Mod:attribute_goals/3), !, - ( - '$notrace'(Mod:attribute_goals(V,GoalListF,GoalList0)) - -> - true - ; - GoalListF = GoalList0 - ). -'$attgoals_for_module'(Mod, V, _, DonesSoFar, DonesSoFar, GoalListF, GoalList0) :- - % SICStus - current_predicate(Mod:attribute_goal/2), !, - ( - '$notrace'(Mod:attribute_goal(V,G)) - -> - GoalListF = [G|GoalList0] - ; - GoalListF = GoalList0 - ). -'$attgoals_for_module'(Mod, V, _, DonesSoFar, DonesSoFar, GoalList, GoalList). - -'$attgoals_for_prolog'([], _, DonesSoFar, DonesSoFar, GoalList, GoalList). -'$attgoals_for_prolog'([G|AllAtts], V, DonesSoFar, MoreDonesSoFar, [AttGoal|GoalListI], GoalList0) :- - '$attgoal_for_prolog'(G, Done, AttGoal), - '$not_vmember'(Done, DonesSoFar), !, - '$attgoals_for_prolog'(AllAtts, V, [Done|DonesSoFar], MoreDonesSoFar, GoalListI, GoalList0). -'$attgoals_for_prolog'([_|AllAtts], V, DonesSoFar, MoreDonesSoFar, GoalListI, GoalList0) :- - '$attgoals_for_prolog'(AllAtts, V, DonesSoFar, MoreDonesSoFar, GoalListI, GoalList0). - -'$attgoal_for_prolog'('$redo_dif'(Done, X, Y), Done, prolog:dif(X,Y)). -'$attgoal_for_prolog'('$redo_freeze'(_, _, _:'$clean_call'(_,_)), _, _) :- !, fail. -'$attgoal_for_prolog'('$redo_freeze'(Done, V, Goal), Done, prolog:freeze(V,Goal)). -'$attgoal_for_prolog'('$redo_eq'(Done, X, Y, Goal), Done, prolog:when(X=Y,Goal)). -'$attgoal_for_prolog'('$redo_ground'(Done, X, Goal), Done, prolog:when(ground(X),Goal)). - -'$not_vmember'(_, []). -'$not_vmember'(V, [V1|DonesSoFar]) :- +not_vmember(_, []). +not_vmember(V, [V1|DonesSoFar]) :- V \== V1, - '$not_vmember'(V, DonesSoFar). + not_vmember(V, DonesSoFar). + +first_att(T, V) :- + term_variables(T, Vs), + check_first_attvar(Vs, V). + +check_first_attvar(V.Vs, V0) :- attvar(V), !, V == V0. +check_first_attvar(_.Vs, V0) :- + check_first_attvar(Vs, V0). -'$list_to_conjunction'([], true). -'$list_to_conjunction'([G], G) :- !. -'$list_to_conjunction'([G|GoalList], (G,Goals0)) :- - '$list_to_conjunction'(GoalList, Goals0). diff --git a/pl/init.yap b/pl/init.yap index c473c61f3..88f3fe32a 100644 --- a/pl/init.yap +++ b/pl/init.yap @@ -83,7 +83,6 @@ lists:append([H|T], L, [H|R]) :- 'eam.yap', 'chtypes.yap', 'yapor.yap', - 'attributes.yap', 'udi.yap']. :- dynamic prolog:'$user_defined_flag'/4. @@ -126,14 +125,17 @@ system_mode(verbose,off) :- set_value('$verbose',off). :- dynamic 'extensions_to_present_answer'/1. -:- ['corout.yap', - 'arrays.yap']. +:- ['arrays.yap']. :- use_module('messages.yap'). :- use_module('hacks.yap'). +:- use_module('attributes.yap'). +:- use_module('corout.yap'). '$system_module'('$messages'). '$system_module'('$hacks'). +'$system_module'('$attributes'). +'$system_module'('$coroutining'). yap_hacks:cut_by(CP) :- '$$cut_by'(CP). From 2908d4ccbd14ea72d0b17d48ee6013b6edbf93a4 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 12 Mar 2010 22:40:17 +0000 Subject: [PATCH 26/37] fix: size of quue went down. --- C/globals.c | 12 ++++++++---- H/iatoms.h | 2 +- misc/ATOMS | 4 ++-- 3 files changed, 11 insertions(+), 7 deletions(-) diff --git a/C/globals.c b/C/globals.c index 05fd9fe39..1bbf726bd 100644 --- a/C/globals.c +++ b/C/globals.c @@ -32,11 +32,15 @@ static char SccsId[] = "%W% %G%"; */ +#define QUEUE_FUNCTOR_ARITY 4 + #define QUEUE_ARENA 0 #define QUEUE_HEAD 1 #define QUEUE_TAIL 2 #define QUEUE_SIZE 3 +#define HEAP_FUNCTOR_MIN_ARITY + #define HEAP_SIZE 0 #define HEAP_MAX 1 #define HEAP_ARENA 2 @@ -1305,7 +1309,7 @@ p_nb_create2(void) static Int nb_queue(UInt arena_sz) { - Term queue_arena, queue, ar[5], *nar; + Term queue_arena, queue, ar[QUEUE_FUNCTOR_ARITY], *nar; Term t = Deref(ARG1); DepthArenas++; @@ -1320,7 +1324,7 @@ nb_queue(UInt arena_sz) ar[QUEUE_TAIL] = ar[QUEUE_SIZE] = MkIntTerm(0); - queue = Yap_MkApplTerm(FunctorNBQueue,5,ar); + queue = Yap_MkApplTerm(FunctorNBQueue,QUEUE_FUNCTOR_ARITY,ar); if (!Yap_unify(queue,ARG1)) return FALSE; if (arena_sz < 4*1024) @@ -1419,7 +1423,7 @@ p_nb_queue_close(void) Term t = Deref(ARG1); Int out; - DepthArenas--; + DepthArenas--; if (!IsVarTerm(t)) { CELL *qp; @@ -1907,7 +1911,7 @@ p_nb_beam(void) hsize = IntegerOfTerm(tsize); } while ((beam = MkZeroApplTerm(Yap_MkFunctor(AtomHeap,5*hsize+HEAP_START+1),5*hsize+HEAP_START+1)) == TermNil) { - if (!Yap_gcl((5*hsize+HEAP_START+1)*sizeof(CELL), 2, ENV, P)) { + if (!Yap_gcl((4*hsize+HEAP_START+1)*sizeof(CELL), 2, ENV, P)) { Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); return FALSE; } diff --git a/H/iatoms.h b/H/iatoms.h index aeefbb2d7..c835df88a 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -374,7 +374,7 @@ FunctorMultiFileClause = Yap_MkFunctor(AtomMfClause,5); FunctorMutable = Yap_MkFunctor(AtomMutableVariable,(sizeof(timed_var)/sizeof(CELL))); FunctorNotImplemented = Yap_MkFunctor(AtomNotImplemented,2); - FunctorNBQueue = Yap_MkFunctor(AtomQueue,5); + FunctorNBQueue = Yap_MkFunctor(AtomQueue,4); FunctorNot = Yap_MkFunctor(AtomNot,1); FunctorOr = Yap_MkFunctor(AtomSemic,2); FunctorPermissionError = Yap_MkFunctor(AtomPermissionError,3); diff --git a/misc/ATOMS b/misc/ATOMS index 3e5eb05d1..48a18259d 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -86,7 +86,7 @@ A DollarUndef F "$undef" A DomainError N "domain_error" A E N "e" A EOFBeforeEOT N "end_of_file_found_before_end_of_term" -A EQ N "=" + A EQ N "=" A EmptyAtom N "" A EndOfStream N "$end_of_stream" A Eof N "end_of_file" @@ -383,7 +383,7 @@ F Module Colomn 2 F MultiFileClause MfClause 5 F Mutable MutableVariable (sizeof(timed_var)/sizeof(CELL)) F NotImplemented NotImplemented 2 -F NBQueue Queue 5 +F NBQueue Queue 4 F Not Not 1 F Or Semic 2 F PermissionError PermissionError 3 From 26e0bfdf060641e76b824cb16d7c5587274e4464 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 12 Mar 2010 22:41:30 +0000 Subject: [PATCH 27/37] fix op --- pl/corout.yap | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/pl/corout.yap b/pl/corout.yap index 8fd3c7be3..1518c29c0 100644 --- a/pl/corout.yap +++ b/pl/corout.yap @@ -16,12 +16,14 @@ *************************************************************************/ +:- module('$coroutining',[ + op(1150, fx, block) %dif/2, %when/2, %block/1, %wait/1, %frozen/2 -:- module('$coroutining',[]). + ]). attr_unify_hook(DelayList, _) :- @@ -62,8 +64,6 @@ attgoal_for_delay(_, V) --> []. % % operators defined in this module: % -:- op(1150, fx, block). - prolog:freeze(V, G) :- var(V), !, freeze_goal(V,G). From 32358429478696f0f493fab999a44d17aabf502a Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Fri, 12 Mar 2010 22:41:49 +0000 Subject: [PATCH 28/37] small optimisation --- pl/attributes.yap | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/pl/attributes.yap b/pl/attributes.yap index 4d08ec6ab..1637cfc69 100644 --- a/pl/attributes.yap +++ b/pl/attributes.yap @@ -90,14 +90,8 @@ execute_continuation(Continuation, Mod) :- execute_woken_system_goals([]). -execute_woken_system_goals([G|LG]) :- +execute_woken_system_goals(['$att_do'(V,New)|LG]) :- execute_woken_system_goals(LG), - execute_woken_system_goal(G). - -% -% X surely was bound, otherwise we would not be awaken. -% -execute_woken_system_goal('$att_do'(V,New)) :- call_atts(V,New). % @@ -190,14 +184,14 @@ prolog:call_residue(Goal,Residue) :- call_residue(Goal,Module,Residue) :- call(Module:Goal). -% called by top_level to find out about delayed goals project_delayed_goals(G,LGs) :- - % SICStus compatible step, - % just try to simplify store by projecting constraints - % over query variables. ( current_predicate(attributes:modules_with_attributes/1), false -> +% SICStus compatible step, +% just try to simplify store by projecting constraints +% over query variables. +% called by top_level to find out about delayed goals attributes:all_attvars(LAV), LAV = [_|_], !, From 2ba051e9085fdd40f8f2fd4e35eac249d4038d26 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 14 Mar 2010 09:30:24 +0000 Subject: [PATCH 29/37] SWI compatibility for term_expansion --- pl/boot.yap | 2 ++ 1 file changed, 2 insertions(+) diff --git a/pl/boot.yap b/pl/boot.yap index 209d14973..8206e8e07 100755 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -401,6 +401,8 @@ true :- true. ( '$notrace'(M:G) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ), '$enter_system_mode'. + '$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :- !, + '$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source). '$continue_with_command'(reconsult,V,Pos,G,Source) :- '$go_compile_clause'(G,V,Pos,5,Source), fail. From 3683da028ac730e3ac5b027a2d627f49c9bc685f Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 14 Mar 2010 09:31:04 +0000 Subject: [PATCH 30/37] use correct tests. --- C/tracer.c | 2 +- H/amiops.h | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/C/tracer.c b/C/tracer.c index 54e333105..720839e11 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -113,7 +113,7 @@ check_trail_consistency(void) { } else { if (IsPairTerm(TrailTerm(ptr))) { CELL *p = RepPair(TrailTerm(ptr)); - if (p < H0) continue; + if IsAttVar(p) continue; } printf("Oops at call %ld, B->cp(%p) TR(%p) pt(%p)\n", vsc_count,B->cp_tr, TR, ptr); return(FALSE); diff --git a/H/amiops.h b/H/amiops.h index a4111c514..b2968f037 100644 --- a/H/amiops.h +++ b/H/amiops.h @@ -354,7 +354,7 @@ Binding Macros for Multiple Assignment Variables. #define BIND_GLOBALCELL(A,D) *(A) = (D); \ if ((A) >= HBREG) continue; \ - TRAIL_GLOBAL(A,D); if ((A) >= H0) continue; \ + TRAIL_GLOBAL(A,D); if (!IsAttVar(A)) continue; \ Yap_WakeUp((A)); continue #define BIND_GLOBALCELL_NONATT(A,D) *(A) = (D); \ @@ -502,7 +502,7 @@ Yap_unify_constant(register Term a, register Term cons) BIND(pt,cons,wake_for_cons); #ifdef COROUTINING DO_TRAIL(pt, cons); - if (pt < H0) Yap_WakeUp(pt); + if (IsAttVar(pt)) Yap_WakeUp(pt); wake_for_cons: #endif return(TRUE); From d33be134879e0c0244f3b41ef13cbe47290e980a Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 14 Mar 2010 09:31:25 +0000 Subject: [PATCH 31/37] SWI compatibility --- pl/protect.yap | 1 + 1 file changed, 1 insertion(+) diff --git a/pl/protect.yap b/pl/protect.yap index a1538558b..b847548b5 100644 --- a/pl/protect.yap +++ b/pl/protect.yap @@ -39,6 +39,7 @@ '$hide'('$stream') :- !, fail. /* not $STREAM */ '$hide'('$stream_position') :- !, fail. /* not stream position */ '$hide'('$hacks') :- !, fail. +'$hide'('$source_location') :- !, fail. '$hide'('$messages') :- !, fail. '$hide'(Name) :- hide(Name), fail. From 4fafe10fbe38415538801d10e25899ec34d7fa19 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 14 Mar 2010 09:32:04 +0000 Subject: [PATCH 32/37] fix error messages --- C/utilpreds.c | 3 --- 1 file changed, 3 deletions(-) diff --git a/C/utilpreds.c b/C/utilpreds.c index e40244c78..9cf729b64 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -309,13 +309,10 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, clean_dirty_tr(TR0); /* follow chain of multi-assigned variables */ if (dvarsmin) { - fprintf(stderr,"%ld--%ld\n", dvarsmin-H0,dvarsmax-H0); dvarsmin += 1; do { CELL *newv; - fprintf(stderr,"mabind %ld %p %p\n", dvarsmin-H0, TR, dvarsmin+1); Bind(dvarsmin+1, dvarsmin[1]); - fprintf(stderr,"redone %p\n", TR); if (IsUnboundVar(dvarsmin)) break; newv = CellPtr(*dvarsmin); From 117647f5522d8048df82d258e8338ee7f119fe81 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sun, 14 Mar 2010 09:32:31 +0000 Subject: [PATCH 33/37] fix test --- H/trim_trail.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/H/trim_trail.h b/H/trim_trail.h index afd2720de..d29179b54 100644 --- a/H/trim_trail.h +++ b/H/trim_trail.h @@ -27,7 +27,7 @@ /* skip, this is a problem because we lose information, namely active references */ pt1 = (tr_fr_ptr)pt; - } else if (IN_BETWEEN(Yap_GlobalBase, pt, H0)) { + } else if (IsAttVar(pt)) { CELL val = Deref(*pt); if (IsVarTerm(val)) { Bind(pt, MkAtomTerm(AtomCut)); @@ -130,7 +130,7 @@ } else if (IsPairTerm(d1)) { CELL *pt = RepPair(d1); - if (IN_BETWEEN(Yap_GlobalBase, pt, H0)) { + if (IsAttVar(pt)) { CELL val = Deref(*pt); if (IsVarTerm(val)) { Bind(VarOfTerm(val), MkAtomTerm(AtomCut)); From 8b6b9e9ac34e81a4801d4caabfcd0cc9453c6d9c Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 15 Mar 2010 14:17:30 +0000 Subject: [PATCH 34/37] we don't need to wakeup variables that have no attributes, even if they have been bound. --- C/attvar.c | 4 ++++ C/globals.c | 5 +++++ C/utilpreds.c | 20 ++++++-------------- 3 files changed, 15 insertions(+), 14 deletions(-) diff --git a/C/attvar.c b/C/attvar.c index 23fdc83ab..3fefd0597 100644 --- a/C/attvar.c +++ b/C/attvar.c @@ -137,6 +137,10 @@ WakeAttVar(CELL* pt1, CELL reg2) CELL *myH = H; CELL *bind_ptr; + if (IsVarTerm(Deref(attv->Atts))) { + /* no attributes to wake */ + return; + } if (IsVarTerm(reg2)) { if (pt1 == VarOfTerm(reg2)) return; diff --git a/C/globals.c b/C/globals.c index 1bbf726bd..240c9171d 100644 --- a/C/globals.c +++ b/C/globals.c @@ -527,6 +527,8 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop /* restore our nice, friendly, term to its original state */ HB = HB0; clean_dirty_tr(TR0); + /* follow chain of multi-assigned variables */ + close_attvar_chain(dvarsmin, dvarsmax); return 0; overflow: @@ -545,6 +547,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop } #endif reset_trail(TR0); + reset_attvars(dvarsmin, dvarsmax); return -1; heap_overflow: @@ -563,6 +566,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop } #endif reset_trail(TR0); + reset_attvars(dvarsmin, dvarsmax); return -2; trail_overflow: @@ -581,6 +585,7 @@ copy_complex_term(register CELL *pt0, register CELL *pt0_end, int share, int cop } #endif reset_trail(TR0); + reset_attvars(dvarsmin, dvarsmax); return -4; } diff --git a/C/utilpreds.c b/C/utilpreds.c index 9cf729b64..ec9439430 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -307,20 +307,8 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, /* restore our nice, friendly, term to its original state */ clean_dirty_tr(TR0); - /* follow chain of multi-assigned variables */ - if (dvarsmin) { - dvarsmin += 1; - do { - CELL *newv; - Bind(dvarsmin+1, dvarsmin[1]); - if (IsUnboundVar(dvarsmin)) - break; - newv = CellPtr(*dvarsmin); - RESET_VARIABLE(dvarsmin); - dvarsmin = newv; - } while (TRUE); - HB = HB0; - } + close_attvar_chain(dvarsmin, dvarsmax); + HB = HB0; return ground; overflow: @@ -339,6 +327,8 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, } #endif reset_trail(TR0); + /* follow chain of multi-assigned variables */ + reset_attvars(dvarsmin, dvarsmax); return -1; trail_overflow: @@ -359,6 +349,7 @@ trail_overflow: { tr_fr_ptr oTR = TR; reset_trail(TR0); + reset_attvars(dvarsmin, dvarsmax); if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { return -4; } @@ -381,6 +372,7 @@ trail_overflow: } #endif reset_trail(TR0); + reset_attvars(dvarsmin, dvarsmax); Yap_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; return -3; } From 9cce7df45bd07e21654afa98b913334a944fdc7c Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 15 Mar 2010 14:18:25 +0000 Subject: [PATCH 35/37] output unification should go after cut. --- pl/setof.yap | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/pl/setof.yap b/pl/setof.yap index 6fb150946..a626b6947 100644 --- a/pl/setof.yap +++ b/pl/setof.yap @@ -122,7 +122,8 @@ bagof(Template, Generator, Bag) :- % The fourth gives the free variables being currently used. % The fifth outputs the current solution. % -'$decide'([], Bag, Key, Key, Bag) :- !. +'$decide'([], Bag, Key0, Key, Bag) :- !, + Key0=Key. '$decide'(_, Bag, Key, Key, Bag). '$decide'(Bags, _, _, Key, Bag) :- '$pick'(Bags, Key, Bag). From cfc0a23953ec6a88cee0780aeefdbeb8ed1a9ff1 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 15 Mar 2010 14:19:05 +0000 Subject: [PATCH 36/37] make sublist from hprolog and sublist from yap be the same beast. --- library/dialect/hprolog.yap | 37 ++++++++++++++++++++----------------- library/lists.yap | 19 +++++++++++++++---- 2 files changed, 35 insertions(+), 21 deletions(-) diff --git a/library/dialect/hprolog.yap b/library/dialect/hprolog.yap index 572f58dec..1592c9d08 100644 --- a/library/dialect/hprolog.yap +++ b/library/dialect/hprolog.yap @@ -38,7 +38,7 @@ split_at/4, % +N, +List, -FirstElements, -LastElements max_go_list/2, % +List, -Max or_list/2, % +ListOfInts, -BitwiseOr - chr_sublist/2, % ?Sublist, +List + sublist/2, % ?Sublist, +List bounded_sublist/3, % ?Sublist, +List, +Bound chr_delete/3, init_store/2, @@ -54,7 +54,10 @@ put_ds/4 % lookup_ht1/4 ]). -:- use_module(library(lists)). + +:- reexport('../lists',[sublist/2]). + +%:- use_module(library(lists)). :- use_module(library(assoc)). /** hProlog compatibility library @@ -93,7 +96,7 @@ make_update_store_goal(Name,Value,Goal) :- Goal = b_setval(Name,Value). *******************************/ %% substitute_eq(+OldVal, +OldList, +NewVal, -NewList) -% +% % Substitute OldVal by NewVal in OldList and unify the result % with NewList. @@ -107,7 +110,7 @@ substitute_eq(X, [U|Us], Y, [V|Vs]) :- ). %% memberchk_eq(+Val, +List) -% +% % Deterministic check of membership using == rather than % unification. @@ -120,7 +123,7 @@ memberchk_eq(X, [Y|Ys]) :- % :- load_foreign_library(chr_support). %% list_difference_eq(+List, -Subtract, -Rest) -% +% % Delete all elements of Subtract from List and unify the result % with Rest. Element comparision is done using ==/2. @@ -133,7 +136,7 @@ list_difference_eq([X|Xs],Ys,L) :- ). %% intersect_eq(+List1, +List2, -Intersection) -% +% % Determine the intersection of two lists without unifying values. intersect_eq([], _, []). @@ -146,7 +149,7 @@ intersect_eq([X|Xs], Ys, L) :- %% take(+N, +List, -FirstElements) -% +% % Take the first N elements from List and unify this with % FirstElements. The definition is based on the GNU-Prolog lists % library. Implementation by Jan Wielemaker. @@ -178,7 +181,7 @@ split_at(N,[H|T],[H|L1],L2) :- split_at(M,T,L1,L2). %% max_go_list(+List, -Max) -% +% % Return the maximum of List in the standard order of terms. max_go_list([H|T], Max) :- @@ -192,7 +195,7 @@ max_go_list([H|T], X, Max) :- ). %% or_list(+ListOfInts, -BitwiseOr) -% +% % Do a bitwise disjuction over all integer members of ListOfInts. or_list(L, Or) :- @@ -210,15 +213,15 @@ or_list([H|T], Or0, Or) :- % % True if all elements of Sub appear in List in the same order. -chr_sublist(L, L). -chr_sublist(Sub, [H|T]) :- - '$sublist1'(T, H, Sub). +%sublist(L, L). +%sublist(Sub, [H|T]) :- +% '$sublist1'(T, H, Sub). -'$sublist1'(Sub, _, Sub). -'$sublist1'([H|T], _, Sub) :- - '$sublist1'(T, H, Sub). -'$sublist1'([H|T], X, [X|Sub]) :- - '$sublist1'(T, H, Sub). +%'$sublist1'(Sub, _, Sub). +%'$sublist1'([H|T], _, Sub) :- +% '$sublist1'(T, H, Sub). +%'$sublist1'([H|T], X, [X|Sub]) :- +% '$sublist1'(T, H, Sub). %% bounded_sublist(?Sub, +List, +Bound:integer) % diff --git a/library/lists.yap b/library/lists.yap index 698262fa2..327b39a56 100644 --- a/library/lists.yap +++ b/library/lists.yap @@ -267,10 +267,21 @@ select(Element, [Head|Tail], [Head|Rest]) :- % sublist(Sublist, List) % is true when both append(_,Sublist,S) and append(S,_,List) hold. -sublist(Sublist, List) :- - prefix(Sublist, List). -sublist(Sublist, [_|List]) :- - sublist(Sublist, List). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% sublist(?Sub, +List) is nondet. +% +% True if all elements of Sub appear in List in the same order. + +sublist(L, L). +sublist(Sub, [H|T]) :- + '$sublist1'(T, H, Sub). + +'$sublist1'(Sub, _, Sub). +'$sublist1'([H|T], _, Sub) :- + '$sublist1'(T, H, Sub). +'$sublist1'([H|T], X, [X|Sub]) :- + '$sublist1'(T, H, Sub). % substitute(X, XList, Y, YList) % is true when XList and YList only differ in that the elements X in XList From 54c0209d3aab77c23f9d34274cf6340b15bc03c0 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Mon, 15 Mar 2010 14:19:45 +0000 Subject: [PATCH 37/37] give macros to reset and update chain of attvars in term copy. --- H/amiops.h | 32 ++++++++++++++++++++++++++++++++ packages/chr | 2 +- 2 files changed, 33 insertions(+), 1 deletion(-) diff --git a/H/amiops.h b/H/amiops.h index b2968f037..bd6d25c09 100644 --- a/H/amiops.h +++ b/H/amiops.h @@ -436,6 +436,38 @@ reset_trail(tr_fr_ptr TR0) { } } +inline EXTERN void +reset_attvars(CELL *dvarsmin, CELL *dvarsmax) { + if (dvarsmin) { + dvarsmin += 1; + do { + CELL *newv; + newv = CellPtr(*dvarsmin); + RESET_VARIABLE(dvarsmin+1); + if (IsUnboundVar(dvarsmin)) + break; + RESET_VARIABLE(dvarsmin); + dvarsmin = newv; + } while (TRUE); + } +} + +inline EXTERN void +close_attvar_chain(CELL *dvarsmin, CELL *dvarsmax) { + if (dvarsmin) { + dvarsmin += 1; + do { + CELL *newv; + Bind(dvarsmin+1, dvarsmin[1]); + if (IsUnboundVar(dvarsmin)) + break; + newv = CellPtr(*dvarsmin); + RESET_VARIABLE(dvarsmin); + dvarsmin = newv; + } while (TRUE); + } +} + EXTERN inline Int Yap_unify(Term t0, Term t1) { diff --git a/packages/chr b/packages/chr index 99090acf4..91ad6583a 160000 --- a/packages/chr +++ b/packages/chr @@ -1 +1 @@ -Subproject commit 99090acf47044ad4a6dc78da634668bdc2bae485 +Subproject commit 91ad6583a1387ad6c645c46f258fd671d92fe9fb