diff --git a/C/absmi.c b/C/absmi.c index 033228f6c..3d155242a 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -10,8 +10,13 @@ * * * File: absmi.c * * comments: Portable abstract machine interpreter * -* Last rev: $Date: 2005-11-26 02:57:25 $,$Author: vsc $ * +* Last rev: $Date: 2005-12-05 17:16:10 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.187 2005/11/26 02:57:25 vsc +* improvements to debugger +* overflow fixes +* reading attvars from DB was broken. +* * Revision 1.186 2005/11/23 03:01:32 vsc * fix several bugs in save/restore.b * @@ -10545,6 +10550,7 @@ Yap_absmi(int inp) GONext(); } { + Int opresult; #ifdef COROUTINING /* * We may wake up goals during our attempt to unify the @@ -10568,24 +10574,21 @@ Yap_absmi(int inp) B = (choiceptr) H; SET_BB(B); save_hb(); - if (Yap_IUnify(d0, d1)) { - /* restore B, no need to restore HB */ - PREG = PREG->u.l.l; - B = pt1; + opresult = Yap_IUnify(d0, d1); #ifdef COROUTINING - /* now restore Woken Goals to its old value */ - Yap_UpdateTimedVar(WokenGoals, OldWokenGoals); - if (OldWokenGoals == TermNil) { - Yap_undo_signal(YAP_WAKEUP_SIGNAL); - } -#endif - GONext(); + /* now restore Woken Goals to its old value */ + Yap_UpdateTimedVar(WokenGoals, OldWokenGoals); + if (OldWokenGoals == TermNil) { + Yap_undo_signal(YAP_WAKEUP_SIGNAL); } - /* restore B, and later HB */ - PREG = NEXTOP(PREG, l); +#endif + /* restore B */ B = pt1; SET_BB(PROTECT_FROZEN_B(pt1)); - ENDCHO(pt1); +#ifdef COROUTINING + H = HBREG; +#endif + HBREG = B->cp_h; /* untrail all bindings made by Yap_IUnify */ while (TR != pt0) { BEGD(d1); @@ -10616,14 +10619,14 @@ Yap_absmi(int inp) } ENDD(d1); } - HBREG = B->cp_h; -#ifdef COROUTINING - /* now restore Woken Goals to its old value */ - Yap_UpdateTimedVar(WokenGoals, OldWokenGoals); - if (OldWokenGoals == TermNil) { - Yap_undo_signal(YAP_WAKEUP_SIGNAL); + if (opresult) { + /* restore B, no need to restore HB */ + PREG = PREG->u.l.l; + GONext(); } -#endif + /* restore B, and later HB */ + PREG = NEXTOP(PREG, l); + ENDCHO(pt1); } GONext(); diff --git a/C/computils.c b/C/computils.c index b2f212c7d..376bc2132 100644 --- a/C/computils.c +++ b/C/computils.c @@ -11,8 +11,11 @@ * File: computils.c * * comments: some useful routines for YAP's compiler * * * -* Last rev: $Date: 2005-09-08 22:06:44 $ * +* Last rev: $Date: 2005-12-05 17:16:10 $ * * $Log: not supported by cvs2svn $ +* Revision 1.28 2005/09/08 22:06:44 rslopes +* BEAM for YAP update... +* * Revision 1.27 2005/07/06 15:10:04 vsc * improvements to compiler: merged instructions and fixes for -> * @@ -287,10 +290,10 @@ static void write_address(CELL address) { if (address < (CELL)AtomBase) { - Yap_DebugPutc(Yap_c_error_stream,'L'); - Yap_plwrite (MkIntTerm (address), Yap_DebugPutc, 0); + Yap_DebugErrorPutc('L'); + Yap_DebugPlWrite (MkIntTerm (address)); } else if (address == (CELL) FAILCODE) { - Yap_plwrite (MkAtomTerm (AtomFail), Yap_DebugPutc, 0); + Yap_DebugPlWrite (MkAtomTerm (AtomFail)); } else { char buf[32], *p = buf; @@ -300,10 +303,10 @@ write_address(CELL address) snprintf(buf,"%p",(void *)address); #endif p[31] = '\0'; /* so that I don't have to worry */ - Yap_DebugPutc(Yap_c_error_stream,'0'); - Yap_DebugPutc(Yap_c_error_stream,'x'); + Yap_DebugErrorPutc('0'); + Yap_DebugErrorPutc('x'); while (*p != '\0') { - Yap_DebugPutc(Yap_c_error_stream,*p++); + Yap_DebugErrorPutc(*p++); } } } @@ -313,16 +316,16 @@ write_functor(Functor f) { if (IsExtensionFunctor(f)) { if (f == FunctorDBRef) { - Yap_plwrite(MkAtomTerm(Yap_LookupAtom("DBRef")), Yap_DebugPutc, 0); + Yap_DebugPlWrite(MkAtomTerm(Yap_LookupAtom("DBRef"))); } else if (f == FunctorLongInt) { - Yap_plwrite(MkAtomTerm(Yap_LookupAtom("LongInt")), Yap_DebugPutc, 0); + Yap_DebugPlWrite(MkAtomTerm(Yap_LookupAtom("LongInt"))); } else if (f == FunctorDouble) { - Yap_plwrite(MkAtomTerm(Yap_LookupAtom("Double")), Yap_DebugPutc, 0); + Yap_DebugPlWrite(MkAtomTerm(Yap_LookupAtom("Double"))); } } else { - Yap_plwrite(MkAtomTerm(NameOfFunctor (f)), Yap_DebugPutc, 0); - Yap_DebugPutc (Yap_c_error_stream,'/'); - Yap_plwrite(MkIntTerm(ArityOfFunctor (f)), Yap_DebugPutc, 0); + Yap_DebugPlWrite(MkAtomTerm(NameOfFunctor (f))); + Yap_DebugErrorPutc ('/'); + Yap_DebugPlWrite(MkIntTerm(ArityOfFunctor (f))); } } @@ -341,15 +344,15 @@ ShowOp (char *f, struct PSEUDO *cpc) { #ifdef BEAM case '1': - Yap_plwrite(MkIntTerm(rn), Yap_DebugPutc, 0); + Yap_DebugPlWrite(MkIntTerm(rn)); break; case '4': - Yap_plwrite(MkIntTerm(arg), Yap_DebugPutc, 0); + Yap_DebugPlWrite(MkIntTerm(arg)); break; #endif case 'a': case 'n': - Yap_plwrite ((Term) arg, Yap_DebugPutc, 0); + Yap_DebugPlWrite ((Term) arg); break; case 'b': /* write a variable bitmap for a call */ @@ -357,7 +360,7 @@ ShowOp (char *f, struct PSEUDO *cpc) int max = arg/(8*sizeof(CELL)), i; CELL *ptr = cptr; for (i = 0; i <= max; i++) { - Yap_plwrite(MkIntegerTerm((Int)(*ptr++)), Yap_DebugPutc, 0); + Yap_DebugPlWrite(MkIntegerTerm((Int)(*ptr++))); } } break; @@ -369,20 +372,20 @@ ShowOp (char *f, struct PSEUDO *cpc) char s[32]; bip_name(rn,s); - Yap_plwrite (MkAtomTerm(Yap_LookupAtom(s)), Yap_DebugPutc, 0); + Yap_DebugPlWrite (MkAtomTerm(Yap_LookupAtom(s))); } break; case 'd': - Yap_plwrite (MkIntTerm (rn), Yap_DebugPutc, 0); + Yap_DebugPlWrite (MkIntTerm (rn)); break; case 'z': - Yap_plwrite (MkIntTerm (cpc->rnd3), Yap_DebugPutc, 0); + Yap_DebugPlWrite (MkIntTerm (cpc->rnd3)); break; case 'v': { Ventry *v = (Ventry *) arg; - Yap_DebugPutc (Yap_c_error_stream,v->KindOfVE == PermVar ? 'Y' : 'X'); - Yap_plwrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs), Yap_DebugPutc, 0); + Yap_DebugErrorPutc (v->KindOfVE == PermVar ? 'Y' : 'X'); + Yap_DebugPlWrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs)); } break; case 'N': @@ -392,13 +395,13 @@ ShowOp (char *f, struct PSEUDO *cpc) cpc = cpc->nextInst; arg = cpc->rnd1; v = (Ventry *) arg; - Yap_DebugPutc (Yap_c_error_stream,v->KindOfVE == PermVar ? 'Y' : 'X'); - Yap_plwrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs), Yap_DebugPutc, 0); + Yap_DebugErrorPutc (v->KindOfVE == PermVar ? 'Y' : 'X'); + Yap_DebugPlWrite (MkIntTerm ((v->NoOfVE) & MaskVarAdrs)); } case 'm': - Yap_plwrite (MkAtomTerm ((Atom) arg), Yap_DebugPutc, 0); - Yap_DebugPutc (Yap_c_error_stream,'/'); - Yap_plwrite (MkIntTerm (rn), Yap_DebugPutc, 0); + Yap_DebugPlWrite (MkAtomTerm ((Atom) arg)); + Yap_DebugErrorPutc ('/'); + Yap_DebugPlWrite (MkIntTerm (rn)); break; case 'p': { @@ -411,14 +414,14 @@ ShowOp (char *f, struct PSEUDO *cpc) mod = p->ModuleOfPred; else mod = TermProlog; - Yap_plwrite (mod, Yap_DebugPutc, 0); - Yap_DebugPutc (Yap_c_error_stream,':'); + Yap_DebugPlWrite (mod); + Yap_DebugErrorPutc (':'); if (arity == 0) - Yap_plwrite (MkAtomTerm ((Atom)f), Yap_DebugPutc, 0); + Yap_DebugPlWrite (MkAtomTerm ((Atom)f)); else - Yap_plwrite (MkAtomTerm (NameOfFunctor (f)), Yap_DebugPutc, 0); - Yap_DebugPutc (Yap_c_error_stream,'/'); - Yap_plwrite (MkIntTerm (arity), Yap_DebugPutc, 0); + Yap_DebugPlWrite (MkAtomTerm (NameOfFunctor (f))); + Yap_DebugErrorPutc ('/'); + Yap_DebugPlWrite (MkIntTerm (arity)); } break; case 'P': @@ -429,22 +432,22 @@ ShowOp (char *f, struct PSEUDO *cpc) Term mod = TermProlog; if (p->ModuleOfPred) mod = p->ModuleOfPred; - Yap_plwrite (mod, Yap_DebugPutc, 0); - Yap_DebugPutc (Yap_c_error_stream,':'); + Yap_DebugPlWrite (mod); + Yap_DebugErrorPutc (':'); if (arity == 0) - Yap_plwrite (MkAtomTerm ((Atom)f), Yap_DebugPutc, 0); + Yap_DebugPlWrite (MkAtomTerm ((Atom)f)); else - Yap_plwrite (MkAtomTerm (NameOfFunctor (f)), Yap_DebugPutc, 0); - Yap_DebugPutc (Yap_c_error_stream,'/'); - Yap_plwrite (MkIntTerm (arity), Yap_DebugPutc, 0); + Yap_DebugPlWrite (MkAtomTerm (NameOfFunctor (f))); + Yap_DebugErrorPutc ('/'); + Yap_DebugPlWrite (MkIntTerm (arity)); } break; case 'f': write_functor((Functor)arg); break; case 'r': - Yap_DebugPutc (Yap_c_error_stream,'A'); - Yap_plwrite (MkIntTerm (rn), Yap_DebugPutc, 0); + Yap_DebugErrorPutc ('A'); + Yap_DebugPlWrite (MkIntTerm (rn)); break; case 'h': { @@ -463,47 +466,47 @@ ShowOp (char *f, struct PSEUDO *cpc) Functor fun = (Functor)*cptr++; if (IsExtensionFunctor(fun)) { if (fun == FunctorDBRef) { - Yap_plwrite(MkAtomTerm(Yap_LookupAtom("DBRef")), Yap_DebugPutc, 0); + Yap_DebugPlWrite(MkAtomTerm(Yap_LookupAtom("DBRef"))); } else if (fun == FunctorLongInt) { - Yap_plwrite(MkAtomTerm(Yap_LookupAtom("LongInt")), Yap_DebugPutc, 0); + Yap_DebugPlWrite(MkAtomTerm(Yap_LookupAtom("LongInt"))); } else if (fun == FunctorDouble) { - Yap_plwrite(MkAtomTerm(Yap_LookupAtom("Double")), Yap_DebugPutc, 0); + Yap_DebugPlWrite(MkAtomTerm(Yap_LookupAtom("Double"))); } } else { - Yap_plwrite (MkAtomTerm(NameOfFunctor(fun)), Yap_DebugPutc, 0); - Yap_DebugPutc (Yap_c_error_stream,'/'); - Yap_plwrite (MkIntTerm(ArityOfFunctor(fun)), Yap_DebugPutc, 0); + Yap_DebugPlWrite (MkAtomTerm(NameOfFunctor(fun))); + Yap_DebugErrorPutc ('/'); + Yap_DebugPlWrite (MkIntTerm(ArityOfFunctor(fun))); } } break; case 'O': - Yap_plwrite(AbsAppl(cptr), Yap_DebugPutc, 0); + Yap_DebugPlWrite(AbsAppl(cptr)); break; case 'x': - Yap_plwrite (MkIntTerm (rn >> 1), Yap_DebugPutc, 0); - Yap_DebugPutc (Yap_c_error_stream,'\t'); - Yap_plwrite (MkIntTerm (rn & 1), Yap_DebugPutc, 0); + Yap_DebugPlWrite (MkIntTerm (rn >> 1)); + Yap_DebugErrorPutc ('\t'); + Yap_DebugPlWrite (MkIntTerm (rn & 1)); break; case 'o': - Yap_plwrite ((Term) * cptr++, Yap_DebugPutc, 0); + Yap_DebugPlWrite ((Term) * cptr++); case 'c': { int i; CELL *ptr = (CELL *)cptr[0]; for (i = 0; i < arg; ++i) { CELL my_arg; - Yap_DebugPutc(Yap_c_error_stream,'\t'); + Yap_DebugErrorPutc('\t'); if (*ptr) { - Yap_plwrite ((Term) *ptr++, Yap_DebugPutc, 0); + Yap_DebugPlWrite ((Term) *ptr++); } else { - Yap_plwrite (MkIntTerm (0), Yap_DebugPutc, 0); + Yap_DebugPlWrite (MkIntTerm (0)); ptr++; } - Yap_DebugPutc (Yap_c_error_stream,'\t'); + Yap_DebugErrorPutc ('\t'); my_arg = *ptr++; write_address (my_arg); if (i+1 < arg) - Yap_DebugPutc (Yap_c_error_stream,'\n'); + Yap_DebugErrorPutc ('\n'); } } break; @@ -513,28 +516,28 @@ ShowOp (char *f, struct PSEUDO *cpc) CELL *ptr = (CELL *)cptr[0]; for (i = 0; i < arg; ++i) { CELL my_arg = ptr[0], lbl = ptr[1]; - Yap_DebugPutc(Yap_c_error_stream,'\t'); + Yap_DebugErrorPutc('\t'); if (my_arg) { write_functor((Functor)my_arg); } else { - Yap_plwrite(MkIntTerm (0), Yap_DebugPutc, 0); + Yap_DebugPlWrite(MkIntTerm (0)); } - Yap_DebugPutc(Yap_c_error_stream,'\t'); + Yap_DebugErrorPutc('\t'); write_address(lbl); ptr += 2; if (i+1 < arg) - Yap_DebugPutc(Yap_c_error_stream,'\n'); + Yap_DebugErrorPutc('\n'); } } break; default: - Yap_DebugPutc (Yap_c_error_stream,'%'); - Yap_DebugPutc (Yap_c_error_stream,ch); + Yap_DebugErrorPutc ('%'); + Yap_DebugErrorPutc (ch); } else - Yap_DebugPutc (Yap_c_error_stream,ch); + Yap_DebugErrorPutc (ch); } - Yap_DebugPutc (Yap_c_error_stream,'\n'); + Yap_DebugErrorPutc ('\n'); } static char *opformat[] = @@ -729,7 +732,7 @@ Yap_ShowCode (struct intermediates *cint) } cpc = cpc->nextInst; } - Yap_DebugPutc (Yap_c_error_stream,'\n'); + Yap_DebugErrorPutc ('\n'); H = oldH; } diff --git a/C/exec.c b/C/exec.c index b8a5ee39b..156811dd9 100644 --- a/C/exec.c +++ b/C/exec.c @@ -1793,7 +1793,6 @@ Yap_InitYaamRegs(void) RESET_VARIABLE((CELL *)Yap_GlobalBase); DelayedVars = Yap_NewTimedVar(MkIntTerm(0)); WokenGoals = Yap_NewTimedVar(TermNil); - MutableList = Yap_NewTimedVar(TermNil); AttsMutableList = Yap_NewTimedVar(MkIntTerm(0)); #endif GcGeneration = Yap_NewTimedVar(MkIntTerm(0)); diff --git a/C/grow.c b/C/grow.c index 3e5e518a3..c4f891612 100644 --- a/C/grow.c +++ b/C/grow.c @@ -159,8 +159,6 @@ SetHeapRegs(void) #ifdef COROUTINING if (DelayedVars) DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars))); - if (MutableList) - MutableList = AbsAppl(PtoGloAdjust(RepAppl(MutableList))); if (AttsMutableList) AttsMutableList = AbsAppl(PtoGloAdjust(RepAppl(AttsMutableList))); if (WokenGoals) @@ -214,8 +212,6 @@ SetStackRegs(void) #ifdef COROUTINING if (DelayedVars) DelayedVars = AbsAppl(PtoGloAdjust(RepAppl(DelayedVars))); - if (MutableList) - MutableList = AbsAppl(PtoGloAdjust(RepAppl(MutableList))); if (AttsMutableList) AttsMutableList = AbsAppl(PtoGloAdjust(RepAppl(AttsMutableList))); if (WokenGoals) diff --git a/C/heapgc.c b/C/heapgc.c index 7b4ab37de..ea7619dae 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -401,10 +401,9 @@ push_registers(Int num_regs, yamop *nextop) TR++; #ifdef COROUTINING TrailTerm(TR) = WokenGoals; - TrailTerm(TR+1) = MutableList; - TrailTerm(TR+2) = AttsMutableList; - TrailTerm(TR+3) = DelayedVars; - TR += 4; + TrailTerm(TR+1) = AttsMutableList; + TrailTerm(TR+2) = DelayedVars; + TR += 3; #endif for (i = 1; i <= num_regs; i++) TrailTerm(TR++) = (CELL) XREGS[i]; @@ -465,7 +464,6 @@ pop_registers(Int num_regs, yamop *nextop) #ifdef COROUTINING #ifdef MULTI_ASSIGNMENT_VARIABLES WokenGoals = TrailTerm(ptr++); - MutableList = TrailTerm(ptr++); AttsMutableList = TrailTerm(ptr++); DelayedVars = TrailTerm(ptr++); #endif diff --git a/C/init.c b/C/init.c index 30f1bb4da..2796bfc3d 100644 --- a/C/init.c +++ b/C/init.c @@ -982,8 +982,9 @@ InitCodes(void) Yap_heap_regs->consultlow + Yap_heap_regs->consultcapacity; Yap_heap_regs->compiler_compile_mode = 0; /* fast will be for native code */ Yap_heap_regs->compiler_optimizer_on = TRUE; - Yap_heap_regs->maxdepth = 0; - Yap_heap_regs->maxlist = 0; + Yap_heap_regs->maxdepth = 0; + Yap_heap_regs->maxlist = 0; + Yap_heap_regs->maxwriteargs = 0; Yap_heap_regs->atprompt = 0; #ifdef COROUTINING diff --git a/C/inlines.c b/C/inlines.c index 6780d3700..3fb162a15 100755 --- a/C/inlines.c +++ b/C/inlines.c @@ -369,94 +369,107 @@ static Int p_dif(void) { /* ? \= ? */ #if SHADOW_HB - register CELL *HBREG = HB; + register CELL *HBREG = HB; #endif - BEGD(d0); + BEGD(d0); + BEGD(d1); + d0 = ARG1; + deref_head(d0, dif_unk1); + dif_nvar1: + /* first argument is bound */ + d1 = ARG2; + deref_head(d1, dif_nvar1_unk2); + dif_nvar1_nvar2: + /* both arguments are bound */ + if (d0 == d1) { + return FALSE; + } + if (IsAtomOrIntTerm(d0) || IsAtomOrIntTerm(d1)) { + return TRUE; + } else { +#ifdef COROUTINING + /* + * We may wake up goals during our attempt to unify the + * two terms. If we are adding to the tail of a list of + * woken goals that should be ok, but otherwise we need + * to restore WokenGoals to its previous value. + */ + CELL OldWokenGoals = Yap_ReadTimedVar(WokenGoals); +#endif + register tr_fr_ptr pt0; + /* store the old value of TR for clearing bindings */ + pt0 = TR; + BEGCHO(pt1); + pt1 = B; + /* make B and HB point to H to guarantee all bindings will + * be trailed + */ + HBREG = H; + B = (choiceptr) H; + SET_BB(B); + save_hb(); + d0 = Yap_IUnify(d0, d1); +#ifdef COROUTINING + /* now restore Woken Goals to its old value */ + Yap_UpdateTimedVar(WokenGoals, OldWokenGoals); + if (OldWokenGoals == TermNil) { + Yap_undo_signal(YAP_WAKEUP_SIGNAL); + } +#endif + /* restore B */ + B = pt1; + SET_BB(PROTECT_FROZEN_B(pt1)); +#ifdef COROUTINING + H = HBREG; +#endif + HBREG = B->cp_h; + /* untrail all bindings made by Yap_IUnify */ + while (TR != pt0) { BEGD(d1); - d0 = ARG1; - deref_head(d0, dif_unk1); - dif_nvar1: - /* first argument is bound */ - d1 = ARG2; - deref_head(d1, dif_nvar1_unk2); - dif_nvar1_nvar2: - /* both arguments are bound */ - if (d0 == d1) { - return(FALSE); - } - if (IsAtomOrIntTerm(d0) || IsAtomOrIntTerm(d1)) { - return(TRUE); - } - { -#ifdef COROUTINING - /* - * We may wake up goals during our attempt to unify the - * two terms. If we are adding to the tail of a list of - * woken goals that should be ok, but otherwise we need - * to restore WokenGoals to its previous value. - */ - CELL OldWokenGoals = Yap_ReadTimedVar(WokenGoals); - + d1 = TrailTerm(--TR); + if (IsVarTerm(d1)) { +#if defined(SBA) && defined(YAPOR) + /* clean up the trail when we backtrack */ + if (Unsigned((Int)(d1)-(Int)(H_FZ)) > + Unsigned((Int)(B_FZ)-(Int)(H_FZ))) { + RESET_VARIABLE(STACK_TO_SBA(d1)); + } else #endif - /* We will have to look inside compound terms */ - BEGP(pt0); - /* store the old value of TR for clearing bindings */ - pt0 = (CELL *)TR; - BEGCHO(pt1); - pt1 = B; - /* make B and HB point to H to guarantee all bindings will - * be trailed - */ - HBREG = H; - B = (choiceptr) H; - save_hb(); - if (Yap_IUnify(d0, d1)) { - /* restore B, no need to restore HB */ - B = pt1; -#ifdef COROUTINING - /* now restore Woken Goals to its old value */ - Yap_UpdateTimedVar(WokenGoals, OldWokenGoals); - if (OldWokenGoals == TermNil) { - Yap_undo_signal(YAP_WAKEUP_SIGNAL); - } -#endif - return FALSE; - } - B = pt1; - /* restore B, and later HB */ - ENDCHO(pt1); - BEGP(pt1); - /* untrail all bindings made by Yap_IUnify */ - while (TR != (tr_fr_ptr)pt0) { - pt1 = (CELL *) TrailTerm(--TR); - RESET_VARIABLE(pt1); - } - HBREG = B->cp_h; - ENDP(pt1); + /* normal variable */ + RESET_VARIABLE(d1); +#ifdef MULTI_ASSIGNMENT_VARIABLES + } else /* if (IsApplTerm(d1)) */ { + CELL *pt = RepAppl(d1); + /* AbsAppl means */ + /* multi-assignment variable */ + /* so the next cell is the old value */ +#ifdef FROZEN_STACKS + pt[0] = TrailVal(--TR); +#else + pt[0] = TrailTerm(--TR); + TR--; +#endif /* FROZEN_STACKS */ +#endif /* MULTI_ASSIGNMENT_VARIABLES */ } -#ifdef COROUTINING - /* now restore Woken Goals to its old value */ - Yap_UpdateTimedVar(WokenGoals, OldWokenGoals); - if (OldWokenGoals == TermNil) { - Yap_undo_signal(YAP_WAKEUP_SIGNAL); - } -#endif - return TRUE; - ENDP(pt0); - - BEGP(pt0); - deref_body(d0, pt0, dif_unk1, dif_nvar1); - ENDP(pt0); - /* first argument is unbound */ - return(FALSE); - - BEGP(pt0); - deref_body(d1, pt0, dif_nvar1_unk2, dif_nvar1_nvar2); - ENDP(pt0); - /* second argument is unbound */ - return FALSE; ENDD(d1); - ENDD(d0); + } + return !d0; + ENDP(pt0); + } + + BEGP(pt0); + deref_body(d0, pt0, dif_unk1, dif_nvar1); + ENDP(pt0); + /* first argument is unbound */ + return FALSE; + + BEGP(pt0); + deref_body(d1, pt0, dif_nvar1_unk2, dif_nvar1_nvar2); + ENDP(pt0); + /* second argument is unbound */ + return FALSE; + ENDD(d1); + ENDD(d0); } static Int diff --git a/C/iopreds.c b/C/iopreds.c index bc7097c60..040813cc6 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -608,6 +608,19 @@ Yap_DebugPutc(int sno, int ch) (void) putc(ch, Yap_logfile); return (putc(ch, Yap_stderr)); } + +void +Yap_DebugPlWrite(Term t) +{ + Yap_plwrite(t, Yap_DebugPutc, 0); +} + +void +Yap_DebugErrorPutc(int c) +{ + Yap_DebugPutc (Yap_c_error_stream, c); +} + #endif /* static */ @@ -4589,27 +4602,45 @@ p_write_depth (void) { /* write_depth(Old,New) */ Term t1 = Deref (ARG1); Term t2 = Deref (ARG2); - if (!IsVarTerm (t1) && !IsIntTerm (t1)) - return (FALSE); - if (!IsVarTerm (t2) && !IsIntTerm (t2)) - return (FALSE); + Term t3 = Deref (ARG3); + + if (!IsVarTerm (t1) && !IsIntegerTerm (t1)) { + Yap_Error(TYPE_ERROR_INTEGER,t1,"write_depth/3"); + return FALSE; + } + if (!IsVarTerm (t2) && !IsIntegerTerm (t2)) { + Yap_Error(TYPE_ERROR_INTEGER,t2,"write_depth/3"); + return FALSE; + } + if (!IsVarTerm (t3) && !IsIntegerTerm (t3)) { + Yap_Error(TYPE_ERROR_INTEGER,t3,"write_depth/3"); + return FALSE; + } if (IsVarTerm (t1)) { - Term t = MkIntTerm (max_depth); - if (!Yap_unify_constant(ARG1, t)) - return (FALSE); + Term t = MkIntegerTerm (max_depth); + if (!Yap_unify_constant(t1, t)) + return FALSE; } else - max_depth = IntOfTerm (t1); - if (IsVarTerm (ARG2)) + max_depth = IntegerOfTerm (t1); + if (IsVarTerm (t2)) { - Term t = MkIntTerm (max_list); - if (!Yap_unify_constant (ARG2, t)) - return (FALSE); + Term t = MkIntegerTerm (max_list); + if (!Yap_unify_constant (t2, t)) + return FALSE; } else - max_list = IntOfTerm (t2); - return (TRUE); + max_list = IntegerOfTerm (t2); + if (IsVarTerm (t3)) + { + Term t = MkIntegerTerm (max_write_args); + if (!Yap_unify_constant (t3, t)) + return FALSE; + } + else + max_write_args = IntegerOfTerm (t3); + return TRUE; } static Int @@ -5022,7 +5053,7 @@ Yap_InitIOPreds(void) Yap_InitCPred ("$is_same_tty", 2, p_is_same_tty, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("prompt", 2, p_prompt, SafePredFlag|SyncPredFlag); Yap_InitCPred ("always_prompt_user", 0, p_always_prompt_user, SafePredFlag|SyncPredFlag); - Yap_InitCPred ("write_depth", 2, p_write_depth, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("write_depth", 3, p_write_depth, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$change_type_of_char", 2, p_change_type_of_char, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$type_of_char", 2, p_type_of_char, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("char_conversion", 2, p_char_conversion, SyncPredFlag); diff --git a/C/tracer.c b/C/tracer.c index 55b664cea..b56a16dbb 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -125,6 +125,15 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) sc = Yap_heap_regs; vsc_count++; + { + Term WGs = Yap_ReadTimedVar(WokenGoals); + fprintf(stderr,"%d %p %lld: ",port, H, vsc_count); + Yap_DebugPlWrite(WGs); + Yap_DebugErrorPutc ('\n'); + } + if (vsc_count < 100) { + return; + } #ifdef COMMENTED // if (vsc_count == 218280) // vsc_xstop = 1; diff --git a/C/write.c b/C/write.c index db1ab63b0..d64bd62de 100644 --- a/C/write.c +++ b/C/write.c @@ -50,7 +50,7 @@ typedef struct write_globs { wrf writech; int Quote_illegal, Ignore_ops, Handle_vars, Use_portray; int keep_terms; - UInt MaxDepth, MaxList; + UInt MaxDepth, MaxList, MaxArgs; } wglbs; STATIC_PROTO(void wrputn, (Int, wrf)); @@ -698,6 +698,12 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb) wrputc('{', wglb->writech); lastw = separator; for (op = 1; op <= Arity; ++op) { + if (op == wglb->MaxArgs) { + wrputc('.', wglb->writech); + wrputc('.', wglb->writech); + wrputc('.', wglb->writech); + break; + } if (wglb->keep_terms) { /* garbage collection may be called */ sl = Yap_InitSlot(t); @@ -722,6 +728,12 @@ writeTerm(Term t, int p, int depth, int rinfixarg, struct write_globs *wglb) for (op = 1; op <= Arity; ++op) { long sl = 0; + if (op == wglb->MaxArgs) { + wrputc('.', wglb->writech); + wrputc('.', wglb->writech); + wrputc('.', wglb->writech); + break; + } if (wglb->keep_terms) { /* garbage collection may be called */ sl = Yap_InitSlot(t); @@ -758,6 +770,7 @@ Yap_plwrite(Term t, int (*mywrite) (int, int), int flags) wglb.Use_portray = flags & Use_portray_f; wglb.MaxDepth = max_depth; wglb.MaxList = max_list; + wglb.MaxArgs = max_write_args; /* notice: we must have ASP well set when using portray, otherwise we cannot make recursive Prolog calls */ wglb.keep_terms = (flags & (Use_portray_f|To_heap_f)); diff --git a/CLPBN/clpbn.yap b/CLPBN/clpbn.yap index 6845632f3..b7bff7b91 100644 --- a/CLPBN/clpbn.yap +++ b/CLPBN/clpbn.yap @@ -116,11 +116,11 @@ add_evidence(V,V). % or by call_residue/2 % project_attributes(GVars, AVars) :- - GVars = [_|_], - AVars = [_|_], !, + AVars = [_|_], + solver(Solver), + ( GVars = [_|_] ; Solver = graphs), !, sort_vars_by_key(AVars,SortedAVars,DiffVars), get_clpbn_vars(GVars,CLPBNGVars), - solver(Solver), incorporate_evidence(SortedAVars, AllVars), write_out(Solver,CLPBNGVars, AllVars, DiffVars). project_attributes(_, _). diff --git a/CLPBN/clpbn/aggregates.yap b/CLPBN/clpbn/aggregates.yap index 8589d1a27..f48a0b064 100644 --- a/CLPBN/clpbn/aggregates.yap +++ b/CLPBN/clpbn/aggregates.yap @@ -1,6 +1,7 @@ :- module(clpbn_aggregates, [ cpt_average/4, + cpt_average/5, cpt_max/4, cpt_min/4 ]). @@ -12,59 +13,64 @@ cpt_average(Vars, Key, Els0, CPT) :- check_domain(Els0, Els), length(Els, SDomain), - build_avg_table(Vars, Els, SDomain, Key, CPT). + build_avg_table(Vars, Els, SDomain, Els0, Key, 1.0, CPT). + +cpt_average(Vars, Key, Els0, Softness, CPT) :- + check_domain(Els0, Els), + length(Els, SDomain), + build_avg_table(Vars, Els, SDomain, Els0, Key, Softness, CPT). cpt_max(Vars, Key, Els0, CPT) :- check_domain(Els0, Els), length(Els, SDomain), - build_max_table(Vars, Els, SDomain, Key, CPT). + build_max_table(Vars, Els, SDomain, Els0, Key, CPT). cpt_min(Vars, Key, Els0, CPT) :- check_domain(Els0, Els), length(Els, SDomain), - build_min_table(Vars, Els, SDomain, Key, CPT). + build_min_table(Vars, Els, SDomain, Els0, Key, CPT). -build_avg_table(Vars, Domain, SDomain, _, p(Domain, CPT, Vars)) :- +build_avg_table(Vars, Domain, SDomain, ODomain, _, 1.0, p(ODomain, CPT, Vars)) :- int_power(Vars, SDomain, 1, TabSize), TabSize =< 16, /* case gmp is not there !! */ TabSize > 0, !, average_cpt(Vars, Domain, CPT). -build_avg_table(Vars, Domain, _, Key, p(Domain, CPT, [V1,V2])) :- +build_avg_table(Vars, Domain, _, ODomain, Key, Softness, p(ODomain, CPT, [V1,V2])) :- length(Vars,L), LL1 is L//2, LL2 is L-LL1, list_split(LL1, Vars, L1, L2), Domain = [Min|Els1], last(Els1,Max), - build_intermediate_table(LL1, sum(Min,Max), L1, V1, Key, 0, I1), - build_intermediate_table(LL2, sum(Min,Max), L2, V2, Key, I1, _), - normalised_average_cpt(L, [V1,V2], Domain, CPT). + build_intermediate_table(LL1, sum(Min,Max), L1, V1, Key, Softness, 0, I1), + build_intermediate_table(LL2, sum(Min,Max), L2, V2, Key, Softness, I1, _), + normalised_average_cpt(L, [V1,V2], Domain, Softness, CPT). -build_max_table(Vars, Domain, SDomain, _, p(Domain, CPT, Vars)) :- +build_max_table(Vars, Domain, SDomain, ODomain, _, p(ODomain, CPT, Vars)) :- int_power(Vars, SDomain, 1, TabSize), TabSize =< 16, !, max_cpt(Vars, Domain, CPT). -build_max_table(Vars, Domain, Domain, Key, p(Domain, CPT, [V1,V2])) :- +build_max_table(Vars, Domain, _, ODomain, Key, p(ODomain, CPT, [V1,V2])) :- length(Vars,L), LL1 is L//2, LL2 is L-LL1, list_split(LL1, Vars, L1, L2), - build_intermediate_table(LL1, max(Domain,CPT), L1, V1, Key, 0, I1), - build_intermediate_table(LL2, max(Domain,CPT), L2, V2, Key, I1, _), + build_intermediate_table(LL1, max(Domain,CPT), L1, V1, Key, 1.0, 0, I1), + build_intermediate_table(LL2, max(Domain,CPT), L2, V2, Key, 1.0, I1, _), max_cpt([V1,V2], Domain, CPT). -build_min_table(Vars, Domain, SDomain, _, p(Domain, CPT, Vars)) :- +build_min_table(Vars, Domain, SDomain, ODomain, _, p(ODomain, CPT, Vars)) :- int_power(Vars, SDomain, 1, TabSize), TabSize =< 16, !, min_cpt(Vars, Domain, CPT). -build_min_table(Vars, Domain, _, Key, p(Domain, CPT, [V1,V2])) :- +build_min_table(Vars, Domain, _, ODomain, Key, p(ODomain, CPT, [V1,V2])) :- length(Vars,L), LL1 is L//2, LL2 is L-LL1, list_split(LL1, Vars, L1, L2), - build_intermediate_table(LL1, min(Domain,CPT), L1, V1, Key, 0, I1), - build_intermediate_table(LL2, min(Domain,CPT), L2, V2, Key, I1, _), + build_intermediate_table(LL1, min(Domain,CPT), L1, V1, Key, 1.0, 0, I1), + build_intermediate_table(LL2, min(Domain,CPT), L2, V2, Key, 1.0, I1, _), min_cpt([V1,V2], Domain, CPT). int_power([], _, TabSize, TabSize). @@ -72,25 +78,25 @@ int_power([_|L], X, I0, TabSize) :- I is I0*X, int_power(L, X, I, TabSize). -build_intermediate_table(1,_,[V],V, _, I, I) :- !. -build_intermediate_table(2, Op, [V1,V2], V, Key, I0, If) :- !, +build_intermediate_table(1,_,[V],V, _, _, I, I) :- !. +build_intermediate_table(2, Op, [V1,V2], V, Key, Softness, I0, If) :- !, If is I0+1, - generate_tmp_random(Op, 2, [V1,V2], V, Key, I0). -build_intermediate_table(N, Op, L, V, Key, I0, If) :- + generate_tmp_random(Op, 2, [V1,V2], V, Key, Softness, I0). +build_intermediate_table(N, Op, L, V, Key, Softness, I0, If) :- LL1 is N//2, LL2 is N-LL1, list_split(LL1, L, L1, L2), I1 is I0+1, - build_intermediate_table(LL1, Op, L1, V1, Key, I1, I2), - build_intermediate_table(LL2, Op, L2, V2, Key, I2, If), - generate_tmp_random(Op, N, [V1,V2], V, Key, I0). + build_intermediate_table(LL1, Op, L1, V1, Key, Softness, I1, I2), + build_intermediate_table(LL2, Op, L2, V2, Key, Softness, I2, If), + generate_tmp_random(Op, N, [V1,V2], V, Key, Softness, I0). % averages are transformed into sums. -generate_tmp_random(sum(Min,Max), N, [V1,V2], V, Key, I) :- +generate_tmp_random(sum(Min,Max), N, [V1,V2], V, Key, Softness, I) :- Lower is Min*N, Upper is Max*N, generate_list(Lower, Upper, Nbs), - sum_cpt([V1,V2], Nbs, CPT), + sum_cpt([V1,V2], Nbs, Softness, CPT), % write(sum(Nbs, CPT, [V1,V2])),nl, % debugging { V = 'AVG'(I,Key) with p(Nbs,CPT,[V1,V2]) }. generate_tmp_random(max(Domain,CPT), _, [V1,V2], V, Key, I) :- @@ -134,17 +140,17 @@ average_cpt(Vs,Vals,CPT) :- generate_indices(Vals,Inds,0,Av), combine_all(Vs, Inds, Cs), length(Vs, Max), - average_possible_cases(0, Av, Max, Cs, CPT). + average_possible_cases(0, Av, Max, Cs, 1.0, CPT). -sum_cpt(Vs, Vals, CPT) :- +sum_cpt(Vs, Vals, Softness, CPT) :- length(Vals,Sz), combine_all(Vs, Cs), - sum_possible_cases(0, Sz, Cs, CPT). + sum_possible_cases(0, Sz, Cs, Softness, CPT). -normalised_average_cpt(Max, Vs, Vals, CPT) :- +normalised_average_cpt(Max, Vs, Vals, Softness, CPT) :- generate_indices(Vals,_,0,Sz), combine_all(Vs, Cs), - average_possible_cases(0, Sz, Max, Cs, CPT). + average_possible_cases(0, Sz, Max, Cs, Softness, CPT). generate_indices([],[],Av,Av). @@ -185,37 +191,39 @@ sum_all([C|Cs],N0,N) :- X is C+N0, sum_all(Cs,X,N). -average_possible_cases(Av,Av,_,_,[]) :- !. -average_possible_cases(I,Av,Max,Cs,Lf) :- - average_cases2(Cs,I,Max,Lf,L0), +average_possible_cases(Av,Av,_,_,_,[]) :- !. +average_possible_cases(I,Av,Max,Cs,Softness,Lf) :- + average_cases2(Cs,I,Av,Softness,Lf,L0), I1 is I+1, - average_possible_cases(I1,Av,Max,Cs,L0). + average_possible_cases(I1,Av,Max,Cs,Softness,L0). -average_cases2([], _, _, L, L). -average_cases2([C|Cs], I, Av, [P|Lf], L0) :- - calculate_avg_prob(C, I, Av, P), - average_cases2(Cs, I, Av, Lf, L0). +average_cases2([], _, _, _, L, L). +average_cases2([C|Cs], I, Av, Softness, [P|Lf], L0) :- + calculate_avg_prob(C, I, Av, Softness, P), + average_cases2(Cs, I, Av, Softness, Lf, L0). -calculate_avg_prob(C, I, Av, 1.0) :- +calculate_avg_prob(C, I, Av, Softness, Softness) :- sum_all(C,0,N), I =:= integer(round(N/Av)), !. -calculate_avg_prob(_, _, _, 0.0). +calculate_avg_prob(_, _, Av, Softness, Comp) :- + Comp is (1.0-Softness)/(Av-1). -sum_possible_cases(Av,Av,_,[]) :- !. -sum_possible_cases(I,Av,Cs,Lf) :- - sum_cases2(Cs,I,Lf,L0), +sum_possible_cases(Av,Av,_, _, []) :- !. +sum_possible_cases(I,Av,Cs,Softness, Lf) :- + sum_cases2(Cs,I, Av, Softness, Lf,L0), I1 is I+1, - sum_possible_cases(I1,Av,Cs,L0). + sum_possible_cases(I1,Av,Cs,Softness, L0). -sum_cases2([], _, L, L). -sum_cases2([C|Cs], I, [P|Lf], L0) :- - calculate_sum_prob(C, I, P), - sum_cases2(Cs, I, Lf, L0). +sum_cases2([], _, _, _, L, L). +sum_cases2([C|Cs], I, Av, Softness, [P|Lf], L0) :- + calculate_sum_prob(C, I, Av, Softness, P), + sum_cases2(Cs, I, Av, Softness, Lf, L0). -calculate_sum_prob(C, I, 1.0) :- +calculate_sum_prob(C, I, _, Softness, Softness) :- sum_all(C,0,N), I =:= N, !. -calculate_sum_prob(_, _, 0.0). +calculate_sum_prob(_, _, Av, Softness, Comp) :- + Comp is (1.0-Softness)/(Av-1). % % generate a CPT for max. diff --git a/CLPBN/clpbn/discrete_utils.yap b/CLPBN/clpbn/discrete_utils.yap index dd684984c..9557cf523 100644 --- a/CLPBN/clpbn/discrete_utils.yap +++ b/CLPBN/clpbn/discrete_utils.yap @@ -16,14 +16,20 @@ project_from_CPT(V,tab(Table,Deps,Szs),tab(NewTable,NDeps,NSzs)) :- propagate_evidence(V, Evs) :- clpbn:get_atts(V, [evidence(Ev),dist(Out,_,_)]), !, - generate_szs_with_evidence(Out,Ev,Evs). + generate_szs_with_evidence(Out,Ev,Evs,Found), + (var(Found) -> + clpbn:get_atts(V, [key(K)]), + throw(clpbn(evidence_does_not_match,K,Ev,[Out])) + ; + true + ). propagate_evidence(_, _). -generate_szs_with_evidence([],_,[]). -generate_szs_with_evidence([Ev|Out],Ev,[ok|Evs]) :- !, - generate_szs_with_evidence(Out,Ev,Evs). -generate_szs_with_evidence([_|Out],Ev,[not_ok|Evs]) :- - generate_szs_with_evidence(Out,Ev,Evs). +generate_szs_with_evidence([],_,[],_). +generate_szs_with_evidence([Ev|Out],Ev,[ok|Evs],found) :- !, + generate_szs_with_evidence(Out,Ev,Evs,found). +generate_szs_with_evidence([_|Out],Ev,[not_ok|Evs],Found) :- + generate_szs_with_evidence(Out,Ev,Evs,Found). find_projection_factor([V|Deps], V1, Deps, [Sz|Szs], Szs, F, Sz) :- V == V1, !, diff --git a/CLPBN/clpbn/gibbs.yap b/CLPBN/clpbn/gibbs.yap index 159b336de..44800ff8f 100644 --- a/CLPBN/clpbn/gibbs.yap +++ b/CLPBN/clpbn/gibbs.yap @@ -18,7 +18,8 @@ :- use_module(library(lists), [member/2, append/3, - delete/3]). + delete/3, + max_list/2]). :- use_module(library(ordsets), [ord_subtract/3]). @@ -98,6 +99,11 @@ graph_representation([V|Vs], Graph, I0, Keys, [I-IParents|TGraph]) :- arg(I, Graph, var(_,_,_,_,_,_,_,NewTable2,SortedIndices)), graph_representation(Vs, Graph, I, Keys, TGraph). +write_pars([]). +write_pars([V|Parents]) :- + clpbn:get_atts(V, [key(K)]),write(K),nl, + write_pars(Parents). + get_sizes([], []). get_sizes([V|Parents], [Sz|Szs]) :- clpbn:get_atts(V, [dist(Vals,_,_)]), @@ -167,6 +173,7 @@ compile_graph(Graph) :- compile_vars([],_). compile_vars([var(_,I,_,Vals,Sz,VarSlot,Parents,_,_)|VarsInfo],Graph) :- + compile_var(I,Vals,Sz,VarSlot,Parents,Graph), compile_vars(VarsInfo,Graph). @@ -204,7 +211,7 @@ mult_list([Sz|Sizes],Mult0,Mult) :- % compile node as set of facts, faster execution compile_var(TotSize,I,_Vals,Sz,CPTs,Parents,_Sizes,Graph) :- - TotSize < 1024, TotSize > 0, !, + TotSize < 1024*64, TotSize > 0, !, multiply_all(I,Parents,CPTs,Sz,Graph). compile_var(_,I,_,_,_,_,_,_) :- assert(implicit(I)). @@ -231,13 +238,15 @@ fetch_val([_|Vals],I0,Pos) :- I is I0+1, fetch_val(Vals,I,Pos). +:- dynamic a/0. + multiply_all(CPTs,Size,Graph,Probs) :- init_factors(Size,Factors0), mult_factors(CPTs,Size,Graph,Factors0,Factors), - normalise_factors(Factors,0,_,Probs,_). + normalise_factors(Factors,Probs). init_factors(0,[]) :- !. -init_factors(I0,[1|Factors]) :- +init_factors(I0,[0.0|Factors]) :- I is I0-1, init_factors(I,Factors). @@ -260,10 +269,21 @@ factor([I|Parents],Table,Graph,Pos0,Weight0,Pos) :- mult_with_probs([],_,_,_,[]). mult_with_probs([F0|Factors0],Indx,Off,Table,[F|Factors]) :- arg(Indx,Table,P1), - F is F0*P1, + F is F0+log(P1), Indx1 is Indx+Off, mult_with_probs(Factors0,Indx1,Off,Table,Factors). +normalise_factors(Factors,Probs) :- + max_list(Factors,Max), + logs2list(Factors,Max,NFactors), + normalise_factors(NFactors,0,_,Probs,_). + +logs2list([],_,[]). +logs2list([Log|Factors],Max,[P|NFactors]) :- + P is exp(Log+Max), + logs2list(Factors,Max,NFactors). + + normalise_factors([],Sum,Sum,[],1.0) :- Sum > 0.0. normalise_factors([F|Factors],S0,S,[P0|Probs],PF) :- Si is S0+F, @@ -360,7 +380,7 @@ gen_e0(Sz,[0|E0L]) :- process_chains(0,_,F,F,_,_,Est,Est) :- !. process_chains(ToDo,VarOrder,End,Start,Graph,Len,Est0,Estf) :- process_chains(Start,VarOrder,Int,Graph,Len,Est0,Esti), -%cvt2problist(Esti, Probs), format('done ~d: ~w~n',[ToDo,Probs]), +(ToDo mod 100 =:= 0 -> statistics,cvt2problist(Esti, Probs), Int =[S|_], format('did ~d: ~w~n ~w~n',[ToDo,Probs,S]) ; true), ToDo1 is ToDo-1, process_chains(ToDo1,VarOrder,End,Int,Graph,Len,Esti,Estf). @@ -369,7 +389,7 @@ process_chains([], _, [], _, _,[],[]). process_chains([Sample0|Samples0], VarOrder, [Sample|Samples], Graph, SampLen,[E0|E0s],[Ef|Efs]) :- functor(Sample,sample,SampLen), do_sample(VarOrder,Sample,Sample0,Graph), -% format('~w ',[Sample]), +%format('Sample = ~w~n',[Sample]), update_estimate(E0,Sample,Ef), process_chains(Samples0, VarOrder, Samples, Graph, SampLen,E0s,Efs). @@ -396,8 +416,7 @@ do_var(I,Sample,Sample0,Graph) :- multiply_all_in_context(Parents,Args,CPTs,Sz,Graph,Vals) :- set_pos(Parents,Args,Graph), multiply_all(CPTs,Sz,Graph,Vals), - assert(mall(Vals)), - fail. + assert(mall(Vals)), fail. multiply_all_in_context(_,_,_,_,_,Vals) :- retract(mall(Vals)). diff --git a/CLPBN/clpbn/topsort.yap b/CLPBN/clpbn/topsort.yap index fcd548b27..b2bdd40ba 100644 --- a/CLPBN/clpbn/topsort.yap +++ b/CLPBN/clpbn/topsort.yap @@ -3,28 +3,52 @@ topsort/3, reversed_topsort/3]). -:- use_module(library(ordsets), - [ord_subtract/3, - ord_insert/3]). +:- use_module(library(rbtrees), + [new/1, + lookup/3, + insert/4]). -:- attribute index/1,count/1. +:- use_module(library(lists), + [reverse/2]). /* simple implementation of a topological sorting algorithm */ /* graph is as Node-[Parents] */ -topsort([], []) :- !. -topsort(Graph0,Sorted) :- - add_parentless(Graph0, Sorted, IncludedI, Graph1, SortedRest), - sort(IncludedI, Included), - delete_parents(Graph1, Included, NoParents), - topsort(NoParents, SortedRest). +topsort(Graph0, Sorted) :- + new(RB), + topsort(Graph0, [], RB, Sorted). + +topsort(Graph0, Sorted0, Sorted) :- + new(RB), + topsort(Graph0, Sorted0, RB, Sorted). + +topsort([], Sort, _, Sort) :- !. +topsort(Graph0, Sort0, Found0, Sort) :- + add_nodes(Graph0, Found0, SortI, NewGraph, Found, Sort), + topsort(NewGraph, Sort0, Found, SortI). + +add_nodes([], Found, Sort, [], Found, Sort). +add_nodes([N-Ns|Graph0], Found0, SortI, NewGraph, Found, NSort) :- +(N=1600 -> write(Ns), nl ; true), + delete_nodes(Ns, Found0, NNs), + ( NNs == [] -> + NewGraph = IGraph, + NSort = [N|Sort], + insert(Found0, N, '$', FoundI) + ; + NewGraph = [N-NNs|IGraph], + NSort = Sort, + FoundI = Found0 + ), + add_nodes(Graph0, FoundI, SortI, IGraph, Found, Sort). + +delete_nodes([], _, []). +delete_nodes([N|Ns], Found, NNs) :- + lookup(N,'$',Found), !, + delete_nodes(Ns, Found, NNs). +delete_nodes([N|Ns], Found, [N|NNs]) :- + delete_nodes(Ns, Found, NNs). -topsort([], Sorted0, Sorted0) :- !. -topsort(Graph0,Sorted0, Sorted) :- - add_parentless(Graph0, Sorted, IncludedI, Graph1, SortedRest), - sort(IncludedI, Included), - delete_parents(Graph1, Included, NoParents), - topsort(NoParents, Sorted0, SortedRest). % % add the first elements found by topsort to the end of the list, so we diff --git a/CLPBN/clpbn/vel.yap b/CLPBN/clpbn/vel.yap index d9a42efdd..06c0d4bd4 100644 --- a/CLPBN/clpbn/vel.yap +++ b/CLPBN/clpbn/vel.yap @@ -110,7 +110,7 @@ add_table_deps_to_variables([], []). add_table_deps_to_variables([var(V,_,_,_,_,_,Deps,K)|LV], DepGraph) :- steal_deps_for_variable(DepGraph, V, NDepGraph, Deps), compute_size(Deps,[],K), -% ( clpbn:get_atts(V,[key(Key)]) -> write(Key:K), nl ; true), +% ( clpbn:get_atts(V,[key(Key)]) -> format('~w:~w~n',[Key,K]) ; true), add_table_deps_to_variables(LV, NDepGraph). steal_deps_for_variable([V-Info|DepGraph], V0, NDepGraph, [Info|Deps]) :- @@ -149,6 +149,7 @@ process(LV0, _, Out) :- fetch_tables(LV0, WorkTables), multiply_tables(WorkTables, Out). + find_best([], V, _TF, V, _, [], _). %:- % clpbn:get_atts(V,[key(K)]), write(chosen:K:TF), nl. @@ -242,7 +243,6 @@ include([var(V,P,VSz,D,Parents,Ev,Tabs,Est)|LV],tab(T,Vs,Sz),V1,[var(V,P,VSz,D,P include([var(V,P,VSz,D,Parents,Ev,Tabs,_)|LV],Table,NV,[var(V,P,VSz,D,Parents,Ev,NTabs,NEst)|NLV]) :- update_tables(Tabs,NTabs,Table,NV), compute_size(NTabs, [], NEst), -% ( clpbn:get_atts(V,[key(Key)]) -> write(Key:NEst), nl ; true), include(LV,Table,NV,NLV). update_tables([],[Table],Table,_). diff --git a/H/Heap.h b/H/Heap.h index 3915d8c96..a380a05bd 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -10,7 +10,7 @@ * File: Heap.h * * mods: * * comments: Heap Init Structure * -* version: $Id: Heap.h,v 1.86 2005-11-17 13:40:18 vsc Exp $ * +* version: $Id: Heap.h,v 1.87 2005-12-05 17:16:11 vsc Exp $ * *************************************************************************/ /* information that can be stored in Code Space */ @@ -83,14 +83,28 @@ typedef struct worker_local_struct { scratch_block scratchpad; #ifdef MULTI_ASSIGNMENT_VARIABLES Term woken_goals; - Term mutable_list; Term atts_mutable_list; #endif /* gc_stuff */ Term gc_generation; /* global stack limit at last generation */ unsigned int gc_calls; /* number of times GC has been called */ Int tot_gc_time; /* total time spent in GC */ - Int tot_gc_recovered; /* number of heap objects in all garbage collections */ + YAP_ULONG_LONG tot_gc_recovered; /* number of heap objects in all garbage collections */ +/* in a single gc */ +#if defined(YAPOR) || defined(THREADS) + /* otherwise, use global variables for speed */ + unsigned long int tot_marked, tot_oldies; /* number of heap objects marked */ +#if DEBUG +#ifdef COROUTINING + unsigned long int tot_smarked; +#endif +#endif +#ifdef EASY_SHUNTING + struct choicept *wl_current_B; + struct trail_frame *wl_sTR, *wl_sTR0; + CELL *wl_prev_HB; +#endif +#endif jmp_buf gc_restore; /* where to jump if garbage collection crashes */ struct array_entry *dynamic_arrays; struct static_array_entry *static_arrays; @@ -222,7 +236,7 @@ typedef struct various_codes { int compiler_compile_mode; AtomHashEntry invisiblechain; OPCODE dummycode[1]; - UInt maxdepth, maxlist; + UInt maxdepth, maxlist, maxwriteargs; int update_mode; Atom atprompt; char prompt[MAX_PROMPT]; @@ -496,6 +510,7 @@ struct various_codes *Yap_heap_regs; #define INVISIBLECHAIN Yap_heap_regs->invisiblechain #define max_depth Yap_heap_regs->maxdepth #define max_list Yap_heap_regs->maxlist +#define max_write_args Yap_heap_regs->maxwriteargs #define AtPrompt (&(Yap_heap_regs->atprompt )) #define Prompt Yap_heap_regs->prompt #if USE_THREADED_CODE @@ -736,13 +751,25 @@ struct various_codes *Yap_heap_regs; #define ScratchPad Yap_heap_regs->wl[worker_id].scratchpad #ifdef COROUTINING #define WokenGoals Yap_heap_regs->wl[worker_id].woken_goals -#define MutableList Yap_heap_regs->wl[worker_id].mutable_list #define AttsMutableList Yap_heap_regs->wl[worker_id].atts_mutable_list #endif #define GcGeneration Yap_heap_regs->wl[worker_id].gc_generation #define GcCalls Yap_heap_regs->wl[worker_id].gc_calls #define TotGcTime Yap_heap_regs->wl[worker_id].tot_gc_time #define TotGcRecovered Yap_heap_regs->wl[worker_id].tot_gc_recovered +#define total_marked Yap_heap_regs->wl[worker_id].tot_marked +#define total_oldies Yap_heap_regs->wl[worker_id].tot_oldies +#if DEBUG +#ifdef COROUTINING +#define total_smarked Yap_heap_regs->wl[worker_id].tot_smarked +#endif +#endif +#ifdef EASY_SHUNTING +#define current_B Yap_heap_regs->wl[worker_id].wl_current_B +#define sTR Yap_heap_regs->wl[worker_id].wl_sTR +#define sTR0 Yap_heap_regs->wl[worker_id].wl_sTR0 +#define prev_HB Yap_heap_regs->wl[worker_id].wl_prev_HB +#endif #define Yap_gc_restore Yap_heap_regs->wl[worker_id].gc_restore #define TrustLUCode Yap_heap_regs->wl[worker_id].trust_lu_code #define DynamicArrays Yap_heap_regs->wl[worker_id].dynamic_arrays @@ -777,7 +804,6 @@ struct various_codes *Yap_heap_regs; #define ScratchPad Yap_heap_regs->wl.scratchpad #ifdef COROUTINING #define WokenGoals Yap_heap_regs->wl.woken_goals -#define MutableList Yap_heap_regs->wl.mutable_list #define AttsMutableList Yap_heap_regs->wl.atts_mutable_list #endif #define GcGeneration Yap_heap_regs->wl.gc_generation diff --git a/H/Yapproto.h b/H/Yapproto.h index 5edec681a..45d0bfc77 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -10,7 +10,7 @@ * File: Yap.proto * * mods: * * comments: Function declarations for YAP * -* version: $Id: Yapproto.h,v 1.64 2005-11-22 11:25:10 tiagosoares Exp $ * +* version: $Id: Yapproto.h,v 1.65 2005-12-05 17:16:11 vsc Exp $ * *************************************************************************/ /* prototype file for Yap */ @@ -207,6 +207,10 @@ void STD_PROTO(Yap_InitInlines,(void)); void STD_PROTO(Yap_InitPlIO,(void)); void STD_PROTO(Yap_InitBackIO,(void)); void STD_PROTO(Yap_InitIOPreds,(void)); +#ifdef DEBUG +extern void Yap_DebugPlWrite (Term t); +extern void Yap_DebugErrorPutc (int n); +#endif /* depth_lim.c */ void STD_PROTO(Yap_InitItDeepenPreds,(void)); diff --git a/H/rheap.h b/H/rheap.h index 56942a94a..edda62780 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -11,8 +11,11 @@ * File: rheap.h * * comments: walk through heap code * * * -* Last rev: $Date: 2005-11-23 03:01:33 $,$Author: vsc $ * +* Last rev: $Date: 2005-12-05 17:16:11 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.58 2005/11/23 03:01:33 vsc +* fix several bugs in save/restore.b +* * Revision 1.57 2005/10/28 17:38:50 vsc * sveral updates * @@ -479,8 +482,6 @@ restore_codes(void) if (Yap_heap_regs->wake_up_code != NULL) Yap_heap_regs->wake_up_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(Yap_heap_regs->wake_up_code)); #if !defined(THREADS) - Yap_heap_regs->wl.mutable_list = - AbsAppl(PtoGloAdjust(RepAppl(Yap_heap_regs->wl.mutable_list))); Yap_heap_regs->wl.atts_mutable_list = AbsAppl(PtoGloAdjust(RepAppl(Yap_heap_regs->wl.atts_mutable_list))); if (Yap_heap_regs->wl.dynamic_arrays) { diff --git a/changes-5.1.html b/changes-5.1.html index b461255e2..eac2cc9e2 100644 --- a/changes-5.1.html +++ b/changes-5.1.html @@ -16,6 +16,13 @@

Yap-5.1.0: