From 0101c0923698308fa36100ac24ace24922f2dace Mon Sep 17 00:00:00 2001 From: vsc Date: Sat, 5 Jun 2004 03:37:01 +0000 Subject: [PATCH] coroutining is now a part of attvars. some more fixes. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1070 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/absmi.c | 115 ++++--- C/adtdefs.c | 2 +- C/attvar.c | 83 +++-- C/c_interface.c | 11 +- C/cdmgr.c | 9 +- C/corout.c | 736 +---------------------------------------- C/dbase.c | 14 +- C/exec.c | 23 +- C/heapgc.c | 3 - C/init.c | 3 +- C/iopreds.c | 3 + C/sysbits.c | 13 +- C/write.c | 7 +- H/Regs.h | 8 +- H/Yapproto.h | 5 +- H/corout.h | 14 +- H/rheap.h | 7 +- docs/yap.tex | 12 +- include/YapInterface.h | 2 +- library/atts.yap | 6 +- m4/TermExt.h.m4 | 5 +- m4/Yatom.h.m4 | 2 +- pl/boot.yap | 4 +- pl/corout.yap | 208 +++++++----- pl/signals.yap | 2 +- 25 files changed, 341 insertions(+), 956 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index 3789bd96a..6a9cb2a9f 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -10,8 +10,12 @@ * * * File: absmi.c * * comments: Portable abstract machine interpreter * -* Last rev: $Date: 2004-05-13 20:54:57 $,$Author: vsc $ * +* Last rev: $Date: 2004-06-05 03:36:59 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.133 2004/05/13 20:54:57 vsc +* debugger fixes +* make sure we always go back to current module, even during initizlization. +* * Revision 1.132 2004/04/29 03:45:49 vsc * fix garbage collection in execute_tail * @@ -1863,13 +1867,9 @@ Yap_absmi(int inp) #ifdef YAPOR CUT_prune_to((choiceptr) d0); #else - B = (choiceptr) d0; -#endif /* YAPOR */ -#ifdef TABLING - abolish_incomplete_subgoals(B); -#endif /* TABLING */ - SET_BB(PROTECT_FROZEN_B(B)); - HBREG = PROTECT_FROZEN_H(B); + while (B->cp_b != (choiceptr)d0) { + B = B->cp_b; + } trim_trail: { tr_fr_ptr pt1, pt0; @@ -1920,6 +1920,13 @@ Yap_absmi(int inp) } TR = pt0; } + B = B->cp_b; +#endif /* YAPOR */ +#ifdef TABLING + abolish_incomplete_subgoals(B); +#endif /* TABLING */ + SET_BB(PROTECT_FROZEN_B(B)); + HBREG = PROTECT_FROZEN_H(B); } ENDD(d0); GONext(); @@ -1937,13 +1944,10 @@ Yap_absmi(int inp) #ifdef YAPOR CUT_prune_to((choiceptr) d0); #else - B = (choiceptr) d0; + while (B->cp_b != (choiceptr)d0) { + B = B->cp_b; + } #endif /* YAPOR */ -#ifdef TABLING - abolish_incomplete_subgoals(B); -#endif /* TABLING */ - SET_BB(PROTECT_FROZEN_B(B)); - HBREG = PROTECT_FROZEN_H(B); goto trim_trail; } ENDD(d0); @@ -1961,13 +1965,10 @@ Yap_absmi(int inp) #ifdef YAPOR CUT_prune_to((choiceptr) d0); #else - B = (choiceptr) d0; + while (B->cp_b != (choiceptr)d0) { + B = B->cp_b; + } #endif /* YAPOR */ -#ifdef TABLING - abolish_incomplete_subgoals(B); -#endif /* TABLING */ - SET_BB(PROTECT_FROZEN_B(B)); - HBREG = PROTECT_FROZEN_H(B); goto trim_trail; } ENDD(d0); @@ -2022,13 +2023,10 @@ Yap_absmi(int inp) #ifdef YAPOR CUT_prune_to(pt0); #else - B = pt0; + while (B->cp_b != pt0) { + B = B->cp_b; + } #endif /* YAPOR */ -#ifdef TABLING - abolish_incomplete_subgoals(B); -#endif /* TABLING */ - SET_BB(PROTECT_FROZEN_B(B)); - HBREG = PROTECT_FROZEN_H(pt0); goto trim_trail; } } @@ -2058,13 +2056,10 @@ Yap_absmi(int inp) #ifdef YAPOR CUT_prune_to(pt0); #else - B = pt0; + while (B->cp_b != pt0) { + B = B->cp_b; + } #endif /* YAPOR */ -#ifdef TABLING - abolish_incomplete_subgoals(B); -#endif /* TABLING */ - SET_BB(PROTECT_FROZEN_B(B)); - HBREG = PROTECT_FROZEN_H(pt0); goto trim_trail; } } @@ -2670,7 +2665,6 @@ Yap_absmi(int inp) } else #endif SREG = (CELL *) CreepCode; - CFREG = CalculateStackGap(); UNLOCK(SignalLock); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) @@ -7725,13 +7719,10 @@ Yap_absmi(int inp) #ifdef YAPOR CUT_prune_to(pt0); #else - B = pt0; + while (B->cp_b != pt0) { + B = B->cp_b; + } #endif /* YAPOR */ -#ifdef TABLING - abolish_incomplete_subgoals(B); -#endif /* TABLING */ - HBREG = PROTECT_FROZEN_H(B); - PREG = NEXTOP(PREG, xF); goto trim_trail; } PREG = NEXTOP(PREG, xF); @@ -7773,13 +7764,10 @@ Yap_absmi(int inp) #ifdef YAPOR CUT_prune_to(pt1); #else - B = pt1; + while (B->cp_b != pt1) { + B = B->cp_b; + } #endif /* YAPOR */ -#ifdef TABLING - abolish_incomplete_subgoals(B); -#endif /* TABLING */ - HBREG = PROTECT_FROZEN_H(B); - PREG = NEXTOP(PREG, yF); goto trim_trail; } PREG = NEXTOP(PREG, yF); @@ -11847,7 +11835,6 @@ Yap_absmi(int inp) if (ASP > (CELL *)B) ASP = (CELL *)B; LOCK(SignalLock); - ActiveSignals &= ~YAP_CDOVF_SIGNAL; UNLOCK(SignalLock); if (ActiveSignals & YAP_CDOVF_SIGNAL) { saveregs_and_ycache(); @@ -11858,8 +11845,44 @@ Yap_absmi(int inp) } setregs_and_ycache(); LOCK(SignalLock); + ActiveSignals &= ~YAP_CDOVF_SIGNAL; CFREG = CalculateStackGap(); UNLOCK(SignalLock); + if (!ActiveSignals) { + goto execute_after_comma; + } + } + if (ActiveSignals & YAP_CDOVF_SIGNAL) { + saveregs_and_ycache(); + if (!Yap_growheap(FALSE, 0, NULL)) { + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap: %s", Yap_ErrorMessage); + setregs_and_ycache(); + FAIL(); + } + setregs_and_ycache(); + LOCK(SignalLock); + ActiveSignals &= ~YAP_CDOVF_SIGNAL; + CFREG = CalculateStackGap(); + UNLOCK(SignalLock); + if (!ActiveSignals) { + goto execute_after_comma; + } + } + if (ActiveSignals & YAP_TROVF_SIGNAL) { + saveregs_and_ycache(); + if(!Yap_growtrail (sizeof(CELL) * 16 * 1024L)) { + Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"YAP failed to reserve %ld bytes in growtrail",sizeof(CELL) * 16 * 1024L); + setregs_and_ycache(); + FAIL(); + } + setregs_and_ycache(); + LOCK(SignalLock); + ActiveSignals &= ~YAP_TROVF_SIGNAL; + CFREG = CalculateStackGap(); + UNLOCK(SignalLock); + if (!ActiveSignals) { + goto execute_after_comma; + } } if (ActiveSignals) { goto creep; diff --git a/C/adtdefs.c b/C/adtdefs.c index 5869f063b..6d058cf2f 100644 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -513,7 +513,7 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod) p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->cs.p_code.ExpandCode = EXPAND_OP_CODE; if (cur_mod == TermProlog) - p->ModuleOfPred = 0; + p->ModuleOfPred = 0L; else p->ModuleOfPred = cur_mod; Yap_NewModulePred(cur_mod, p); diff --git a/C/attvar.c b/C/attvar.c index 73c3ec7f0..726b63938 100644 --- a/C/attvar.c +++ b/C/attvar.c @@ -38,55 +38,35 @@ static CELL * AddToQueue(attvar_record *attv) { Term t[2]; - sus_record *WGs; - sus_record *new; + Term WGs, ng; t[0] = (CELL)&(attv->Done); t[1] = attv->Value; /* follow the chain */ - WGs = (sus_record *)Yap_ReadTimedVar(WokenGoals); - new = (sus_record *)H; - H = (CELL *)(new+1); - new->NR = (sus_record *)(&(new->NR)); - new->SG = Yap_MkApplTerm(FunctorAttGoal, 2, t); - new->NS = new; + WGs = Yap_ReadTimedVar(WokenGoals); + ng = Yap_MkApplTerm(FunctorAttGoal, 2, t); + Yap_UpdateTimedVar(WokenGoals, MkPairTerm(ng, WGs)); if ((Term)WGs == TermNil) { - Yap_UpdateTimedVar(WokenGoals, (CELL)new); /* from now on, we have to start waking up goals */ Yap_signal(YAP_WAKEUP_SIGNAL); - } else { - /* add to the end of the current list of suspended goals */ - CELL *where_to = (CELL *)Deref((CELL)WGs); - Bind_Global(where_to, (CELL)new); } - return(RepAppl(new->SG)+2); + return(RepAppl(ng)+2); } -static CELL * +static void AddFailToQueue(void) { - sus_record *WGs; - sus_record *new; + Term WGs; /* follow the chain */ - WGs = (sus_record *)Yap_ReadTimedVar(WokenGoals); - new = (sus_record *)H; - H = (CELL *)(new+1); - new->NR = (sus_record *)(&(new->NR)); - new->SG = MkAtomTerm(AtomFail); - new->NS = new; + WGs = Yap_ReadTimedVar(WokenGoals); + Yap_UpdateTimedVar(WokenGoals, MkPairTerm(MkAtomTerm(AtomFail),WGs)); if ((Term)WGs == TermNil) { - Yap_UpdateTimedVar(WokenGoals, (CELL)new); /* from now on, we have to start waking up goals */ Yap_signal(YAP_WAKEUP_SIGNAL); - } else { - /* add to the end of the current list of suspended goals */ - CELL *where_to = (CELL *)Deref((CELL)WGs); - Bind_Global(where_to, (CELL)new); } - return(RepAppl(new->SG)+2); } static int @@ -213,6 +193,15 @@ WakeAttVar(CELL* pt1, CELL reg2) Bind_Global(&(attv->Value), reg2); } +void +Yap_WakeUp(CELL *pt0) { + CELL d0 = *pt0; + RESET_VARIABLE(pt0); + TR--; + WakeAttVar(pt0, d0); +} + + static void mark_attvar(CELL *orig) { @@ -289,6 +278,18 @@ PutAtt(attvar_record *attv, Int i, Term tatt) { return(TRUE); } +static Int +UpdateAtt(attvar_record *attv, Int i, Term tatt) { + Int pos = i*2; + + if (!IsUnboundVar(attv->Atts[pos+1])) { + tatt = MkPairTerm(tatt, attv->Atts[pos+1]); + } else { + tatt = MkPairTerm(tatt, TermNil); + } + return PutAtt(attv, i, tatt); +} + static Int RmAtt(attvar_record *attv, Int i) { Int pos = i *2; @@ -482,6 +483,29 @@ p_put_att(void) { } } +static Int +p_update_att(void) { + /* receive a variable in ARG1 */ + Term inp = Deref(ARG1); + /* if this is unbound, ok */ + if (IsVarTerm(inp)) { + if (IsAttachedTerm(inp)) { + attvar_record *attv = (attvar_record *)VarOfTerm(inp); + exts id = (exts)attv->sus_id; + + if (id != attvars_ext) { + Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2"); + return(FALSE); + } + return(UpdateAtt(attv, IntegerOfTerm(Deref(ARG2)), Deref(ARG3))); + } + return(BuildNewAttVar(inp, IntegerOfTerm(Deref(ARG2)), MkPairTerm(Deref(ARG3),TermNil))); + } else { + Yap_Error(TYPE_ERROR_VARIABLE,inp,"put_attributes/2"); + return(FALSE); + } +} + static Int p_rm_att(void) { /* receive a variable in ARG1 */ @@ -655,6 +679,7 @@ void Yap_InitAttVarPreds(void) Yap_InitCPred("get_all_atts", 2, p_get_all_atts, SafePredFlag); Yap_InitCPred("free_att", 2, p_free_att, SafePredFlag); Yap_InitCPred("put_att", 3, p_put_att, 0); + Yap_InitCPred("update_att", 3, p_update_att, 0); Yap_InitCPred("rm_att", 2, p_rm_att, SafePredFlag); Yap_InitCPred("inc_n_of_atts", 1, p_inc_atts, SafePredFlag); Yap_InitCPred("n_of_atts", 1, p_n_atts, SafePredFlag); diff --git a/C/c_interface.c b/C/c_interface.c index 20db6ed61..c2b5b5197 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -10,8 +10,11 @@ * File: c_interface.c * * comments: c_interface primitives definition * * * -* Last rev: $Date: 2004-05-17 21:42:08 $,$Author: vsc $ * +* Last rev: $Date: 2004-06-05 03:36:59 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.47 2004/05/17 21:42:08 vsc +* misc fixes +* * Revision 1.46 2004/05/14 17:56:45 vsc * Yap_WriteBuffer * @@ -101,7 +104,7 @@ X_API Term STD_PROTO(YAP_ReadBuffer, (char *,Term *)); X_API Term STD_PROTO(YAP_BufferToString, (char *)); X_API Term STD_PROTO(YAP_BufferToAtomList, (char *)); X_API void STD_PROTO(YAP_Error,(char *)); -X_API int STD_PROTO(YAP_RunGoal,(Term)); +X_API Term STD_PROTO(YAP_RunGoal,(Term)); X_API int STD_PROTO(YAP_RestartGoal,(void)); X_API int STD_PROTO(YAP_GoalHasException,(Term *)); X_API int STD_PROTO(YAP_ContinueGoal,(void)); @@ -752,10 +755,10 @@ static void myputc (int ch) putc(ch,stderr); } -X_API int +X_API Term YAP_RunGoal(Term t) { - int out; + Term out; yamop *old_CP = CP; BACKUP_MACHINE_REGS(); diff --git a/C/cdmgr.c b/C/cdmgr.c index 20635792f..03ff1faf3 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -11,8 +11,11 @@ * File: cdmgr.c * * comments: Code manager * * * -* Last rev: $Date: 2004-05-17 21:42:09 $,$Author: vsc $ * +* Last rev: $Date: 2004-06-05 03:36:59 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.123 2004/05/17 21:42:09 vsc +* misc fixes +* * Revision 1.122 2004/05/13 21:36:45 vsc * get rid of pesky debugging prints * @@ -2388,12 +2391,12 @@ search_for_static_predicate_in_use(PredEntry *p, int check_everything) } do { /* check first environments that are younger than our latest choicepoint */ - if (check_everything) { + if (check_everything && env_ptr) { /* I do not need to check environments for asserts, only for retracts */ - while (b_ptr > (choiceptr)env_ptr) { + while (env_ptr && b_ptr > (choiceptr)env_ptr) { PredEntry *pe = EnvPreg(env_ptr[E_CP]); if (p == pe) return(TRUE); if (env_ptr != NULL) diff --git a/C/corout.c b/C/corout.c index d18756997..16cd0e079 100644 --- a/C/corout.c +++ b/C/corout.c @@ -26,601 +26,12 @@ static char SccsId[]="%W% %G%"; #define NULL (void *)0 #endif -/* - -These are simple routines to support co-routining in YAP. The idea is -to make the interface as simple as possible. - -The interface for co-routines is: - -$freeze(+X,+G) -> execute G only when V is *bound* (not -necessarily ground. - -The data-structures are: - - - |-------------------| -Ref ---------------->| V | SG\ | - |-------------\-----| - \ - \ |------------/ - >| | | G | NS| - | | | | | - |-|----------| - | - V - |------------/ - ->| | G | NS| - | | | | | | - | |-|----------| - | | - |---- - -Where V is an indicator for the term, SG is a pointer for the list of -suspended goals, G is the suspended goal, and NS is a pointer to a -list of suspended goals. - -When suspend_on is called, it executes the following operations: - if (X is a reference): - add a record containing G to the tail - of the current SG list for V - if (X is unbound) - create a record R containing G and a self-reference. - create a suspension register containing a free - variable V and a pointer to R (sus goal list) - Bind V to a Ref to the new structure. - if (X is nonvar) - Oooppssss!!!! The Prolog interface should have - prevented this. - -When trying to unify a nonvar to a suspension variable, the following -actions are taken: - - o Bind V to to the nonvar. This is done within absmi.c and - depends a lot on the surrounding code. - - o Make the list SG the head of the list WokenGoals. - - o Activate the Interrupt Flag, so that the system will process - the suspended goals at the next "call" absmiop. - - At the next "call": - + Save the current goal on the heap (C). - + Take the first member of the WokenGoals list. - + set up '$resume_and_continue'(?G,?C), which should execute - G and then C. - + If WokenGoals is empty, down Interrupt Flag - + jump to the code for '$resume_and_continue'(?G,?C) - + Note, the system will fetch the next goal at the next - "call" op. - -When trying to unify two suspended variables X and Y, we just bind X -to Y, and include Y's goals in X's list. - -The standard definition for resume_and_continue: - -'$wake_up_goal'(C,G) :- call(G), call(C). - -Advantages: - - o Implementation is simple (the main work is changing absmi). - - o Does not need updatable variables. - - o No special support in backtracking. - - o Data structures spend little space. - -Disadvantages - - o We create a goal frame for every suspended goal. This is - avoided by storing both P and the arguments in the suspension - record, and then jumping. - - o We do a lot of meta-calls. This can be avoided by - manipulating P and CP directly. - -*/ - -STATIC_PROTO(Int p_read_svar_list, (void)); -STATIC_PROTO(Int p_set_svar_list, (void)); -STATIC_PROTO(Int p_frozen_goals, (void)); -STATIC_PROTO(Int p_all_frozen_goals, (void)); -STATIC_PROTO(Int p_freeze_on_first, (void)); -STATIC_PROTO(Int p_freeze, (void)); -STATIC_PROTO(Int p_can_unify, (void)); -STATIC_PROTO(Int p_non_ground, (void)); - -#ifdef COROUTINING - -STATIC_PROTO(void Wake, (CELL *, CELL)); -STATIC_PROTO(sus_record *UpdateSVarList, (sus_record *)); -STATIC_PROTO(sus_record *GetSVarList, (void)); -STATIC_PROTO(void mark_sus_record, (sus_record *)); -STATIC_PROTO(void mark_suspended_goal, (CELL *)); -STATIC_PROTO(void AddSuspendedGoals, (sus_record *, sus_record *)); -STATIC_PROTO(void ReleaseGoals, (sus_record *)); -STATIC_PROTO(void wake_if_binding_vars_in_frozen_goal, (Term, sus_record *)); -STATIC_PROTO(void AddSuspendedGoals, (sus_record *, sus_record *)); -STATIC_PROTO(sus_record *has_been_suspended, (Term, sus_record *)); -STATIC_PROTO(void AddSuspendedGoal, (Term, sus_record *)); -STATIC_PROTO(Term AddSusToList, (Term, Term)); -STATIC_PROTO(Term AddSusSubGoals, (Term, CELL *, int)); -STATIC_PROTO(Int freeze_goal, (Term, Term)); -STATIC_PROTO(Term AddVarIfNotThere, (Term, Term)); -STATIC_PROTO(int can_unify_complex, (CELL *, CELL *, CELL *, Term *)); -STATIC_PROTO(int can_unify, (Term, Term, Term *)); -STATIC_PROTO(int non_ground_complex, (CELL *, CELL *, Term *)); -STATIC_PROTO(int non_ground, (Term, Term *)); -#ifdef FOLLOW_ENVIRONMENTS_FOR_SUSPENDED_GOALS -STATIC_PROTO(Term FindFrozenGoals, (Term, CELL *, int)); -#endif - -#ifdef MULTI_ASSIGNMENT_VARIABLES - -inline static sus_record * -UpdateSVarList(sus_record *sl) -{ - /* make sl the new head of the suspension list, and update the list - to use the old one. Note that the list is only bound once, - MutableList is the one variable being updated all the time */ - return((sus_record *)Yap_UpdateTimedVar(MutableList, (CELL)sl)); -} - -inline static sus_record * -GetSVarList(void) -{ - Term t = Yap_ReadTimedVar(MutableList); - /* just return the start of the list */ - if (t == TermNil) - return(NULL); - else - return((sus_record *)t); -} - -#endif - -/* dif (and eventually others) may have the same goal suspended on the - several variables. If this is the case, whenever we bind two - variables we may need to wake the goals. That's implemented by - going to the other guy's list, and checking if the same goal - appears there. - -*/ - -static Term -ListOfWokenGoals(void) { - sus_record *pt = (sus_record *)Yap_ReadTimedVar(WokenGoals); - Term t; - - t = TermNil; - while (pt->NR != (sus_record *)(&(pt->NR))) { - t = MkPairTerm(pt->SG, t); - pt = pt->NR; - } - t = MkPairTerm(pt->SG, t); - return(t); -} - -Term -Yap_ListOfWokenGoals(void) { - return ListOfWokenGoals(); -} - - -static void ReleaseGoals(sus_record *from) -{ - /* follow the chain */ - sus_record *WGs = (sus_record *)Yap_ReadTimedVar(WokenGoals); - - if ((Term)WGs == TermNil) { - Yap_UpdateTimedVar(WokenGoals, (CELL)from); - } else { - /* add to the end of the current list of suspended goals */ - CELL *where_to = (CELL *)Deref((CELL)WGs); - Bind_Global(where_to, (CELL)from); - } - Yap_signal(YAP_WAKEUP_SIGNAL); -} - -static void -wake_if_binding_vars_in_frozen_goal(Term goal, sus_record *from) -{ - do { - if (from->SG == goal) { - sus_record *gf; - - /* A dif like goal has suspended on both variables. We cannot - wake it up directly, because it may have other goals - suspended on the same variable. So we'll just wake up a copy, - and wake up the copy. - */ - gf = (sus_record *)H; - H += sizeof(sus_record)/sizeof(CELL); - gf->NR = (sus_record *)&(gf->NR); - gf->SG = goal; -#ifdef MULTI_ASSIGNMENT_VARIABLES - gf->NS = UpdateSVarList(gf); -#endif - ReleaseGoals(gf); - /* done */ - return; - } - if (from->NR == (sus_record *)&(from->NR)) - return; - else from = from->NR; - } while (TRUE); -} - -inline static void AddSuspendedGoals(sus_record *to, sus_record *from) -{ - /* deref the chain */ - do { - if (IsApplTerm(to->SG)) - wake_if_binding_vars_in_frozen_goal(to->SG, from); - if (to->NR == (sus_record *)&(to->NR)) - break; - else to = to->NR; - } while (TRUE); - /* and bind it */ - Bind_Global((CELL *)(to->NR), (CELL)from); -} - - -static sus_record * -has_been_suspended(Term goal, sus_record *from) -{ - do { - if (from->SG == goal) { - /* we found it */ - return (NULL); - } - if (from->NR == (sus_record *)&(from->NR)) - return (from); - else from = from->NR; - } while (TRUE); - /* make lcc happy */ - return(NULL); -} - -/* This is a simplified version for the case we add a goal to a - suspended goal queue. It avoids having the same copy of the goal - all over the place! -*/ -inline static void AddSuspendedGoal(Term goal, sus_record *from) -{ - sus_record *gf; - - /* do nothing if we suspended before on the same goal! */ - if (IsApplTerm(goal) && ((from = has_been_suspended(goal, from)) == NULL)) - return; - /* else add goal to the queue */ - gf = (sus_record *)H; - H += sizeof(sus_record)/sizeof(CELL); - gf->NR = (sus_record *)&(gf->NR); - gf->SG = goal; -#ifdef MULTI_ASSIGNMENT_VARIABLES - gf->NS = UpdateSVarList(gf); -#endif - Bind_Global((CELL *)&(from->NR), (CELL)gf); -} - -static sus_record * -copy_suspended_goals(sus_record *pt, CELL ***to_visit_ptr) -{ - CELL **to_visit = *to_visit_ptr; - sus_record *gf; - gf = (sus_record *)H; - H += sizeof(sus_record)/sizeof(CELL); - to_visit[0] = &(pt->SG)-1; - to_visit[1] = &(pt->SG); - to_visit[2] = &(gf->SG); - to_visit[3] = (CELL *)(*to_visit[0]); - *to_visit_ptr = to_visit+4; -#ifdef MULTI_ASSIGNMENT_VARIABLES - gf->NS = UpdateSVarList(gf); -#endif - if (pt->NR == (sus_record *)(&(pt->NR))) { - gf->NR = (sus_record *)&(gf->NR); - } else { - gf->NR = copy_suspended_goals(pt->NR, to_visit_ptr); - } - return(gf); -} - -static int -CopySuspendedVar(CELL *orig, CELL ***to_visit_ptr, CELL *res) -{ - register sus_tag *sreg = (sus_tag *)orig, *vs; - - /* add a new suspension */ - vs = (sus_tag *)Yap_ReadTimedVar(DelayedVars); - if (H0 - (CELL *)vs < 1024) - return(FALSE); - RESET_VARIABLE(&(vs->ActiveSus)); - vs->sus_id = susp_ext; - vs->SG = copy_suspended_goals(sreg->SG, to_visit_ptr); - *res = (CELL)&(vs->ActiveSus); - Yap_UpdateTimedVar(DelayedVars, (CELL)(vs+1)); - return(TRUE); -} - -static Term -mk_sus_var_list(sus_record *sr, sus_record *osr) -{ - if (sr == osr) - return(TermNil); - return(MkPairTerm(sr->SG, mk_sus_var_list(sr->NR, sr))); -} - -static Term -SuspendedVarToTerm(CELL *orig) -{ - register sus_tag *sreg = (sus_tag *)orig; - - return(MkPairTerm(sreg->SG->SG, mk_sus_var_list(sreg->SG->NR, sreg->SG))); -} - -static sus_record * -terms_to_suspended_goals(Term gl) -{ - sus_record *gf; - gf = (sus_record *)H; - H += sizeof(sus_record)/sizeof(CELL); -#ifdef MULTI_ASSIGNMENT_VARIABLES - gf->NS = UpdateSVarList(gf); -#endif - gf->SG = HeadOfTerm(gl); - gl = TailOfTerm(gl); - if (gl == TermNil) { - gf->NR = (sus_record *)&(gf->NR); - } else { - gf->NR = terms_to_suspended_goals(gl); - } - return(gf); -} - -static int -TermToSuspendedVar(Term gs, Term var) -{ - register sus_tag *vs; - /* add a new suspension */ - vs = (sus_tag *)Yap_ReadTimedVar(DelayedVars); - if (H0 - (CELL *)vs < 1024) - return(FALSE); - Yap_UpdateTimedVar(DelayedVars, (CELL)(vs+1)); - RESET_VARIABLE(&(vs->ActiveSus)); - vs->sus_id = susp_ext; - vs->SG = terms_to_suspended_goals(gs); - Yap_unify(var,(CELL)&(vs->ActiveSus)); - return(TRUE); -} - - -static void -mark_sus_record(sus_record *sg) -{ - if (MARKED(((CELL)(sg->NR)))) - return; - MARK(((CELL *)&(sg->NR))); - Yap_inc_mark_variable(); - Yap_mark_variable((CELL *)&(sg->SG)); -#ifdef MULTI_ASSIGNMENT_VARIABLES - Yap_inc_mark_variable(); - if (!IsAtomTerm((CELL)(sg->NS))) - mark_sus_record(sg->NS); - MARK(((CELL *)&(sg->NS))); -#endif -} - -static void mark_suspended_goal(CELL *orig) -{ - register sus_tag *sreg = (sus_tag *)orig; - - mark_sus_record(sreg->SG); - Yap_mark_external_reference(((CELL *)&(sreg->SG))); -} - - -void -Yap_mark_all_suspended_goals(void) -{ - sus_record *sg = GetSVarList(); - if (sg == NULL) - return; - /* okay, we are on top of the list of variables. Let's burn rubber! - */ - while (sg != (sus_record *)TermNil) { - CELL tmp; - mark_sus_record(sg); - tmp = (CELL)(sg->NS); - if (MARKED(tmp)) - sg = (sus_record *)UNMARK_CELL(tmp); - else - sg = (sus_record *)tmp; - } -} - - -/* - - This routine does most of the work. It is called after - someone tries to instantiate a suspension reference. - - Three operations are possible: - - SBIND: trying to bind it to a constructed non-var term, most - often a primitive term; - SISPAIR: the term is *going* to be bound to a list. We need to - return where. - SISAPPL: the term is *going* to be bound to a compound term. We - need to return where, if we allow the binding. - -*/ - -static void -Wake(CELL *pt1, CELL reg2) -{ - - /* if bound to someone else, follow until we find the last one */ - register sus_tag *susp = (sus_tag *)pt1; - CELL *myH = H; - - if (IsVarTerm(reg2)) { - if (IsAttachedTerm(reg2)) { - sus_tag *susp2 = (sus_tag *)VarOfTerm(reg2); - - /* binding two suspended variables, be careful */ - if (susp2->sus_id != susp_ext) { - /* joining two suspensions */ - Yap_Error(SYSTEM_ERROR, TermNil, "joining two suspensions not implemented"); - return; - } - /* join the two suspended lists */ - if (susp2 > susp) { - AddSuspendedGoals(susp->SG, susp2->SG); - Bind_Global(VarOfTerm(reg2), (CELL)pt1); - return; - } else { - AddSuspendedGoals(susp2->SG, susp->SG); - Bind_Global(pt1, reg2); - return; - } - } else { - Bind(VarOfTerm(reg2), (CELL)pt1); - } - } else { - /* release the variable into the WokenGoals list */ - ReleaseGoals(susp->SG); - if (IsPairTerm(reg2) && RepPair(reg2) == myH) - reg2 = AbsPair(H); - else if (IsApplTerm(reg2) && RepAppl(reg2) == myH) - reg2 = AbsAppl(H); - /* bind it to t1's value */ - Bind_Global(pt1, reg2); - } - return; -} - -/* find all goals frozen in the current chain of environments */ - -/* This will also mark them as bound, in order that goal lists - won't be displayed twice */ -static Term -AddSusToList(Term t, Term t1) -{ - if (IsVarTerm(t1)) { - /* we found an active suspension variable */ - sus_tag * susp = (sus_tag *)VarOfTerm(t); - sus_record *s = susp->SG; - while (s->NR != (sus_record *)&(s->NR)) { - t = MkPairTerm(s->SG,t); - s = s->NR; - } while (s->NR != (sus_record *)&(s->NR)); - t = MkPairTerm(s->SG,t); - Bind_Global((CELL *)(susp->ActiveSus), TermNil); - } else if (IsApplTerm(t1)) { - int args = ArityOfFunctor(FunctorOfTerm(t1)); - t = AddSusSubGoals(t, RepAppl(t1)+1, args); - } else if (IsPairTerm(t1)) { - t = AddSusSubGoals(t, RepPair(t1), 2); - } - return(t); -} - -/* used to search from subarguments from within a compound term */ -static Term -AddSusSubGoals(Term t, CELL *saved_var, int max) -{ - int i; - - for (i = 0; i < max; i++) - { - Term t1 = Derefa(saved_var); - if (!IsVarTerm(t1)) { - if (IsApplTerm(t1)) { - Functor f = FunctorOfTerm(t1); - - if (!IsExtensionFunctor(f)) { - int args = ArityOfFunctor(f); - - t = AddSusSubGoals(t, RepAppl(t1)+1, args); - } - } else if (IsPairTerm(t1)) { - t = AddSusSubGoals(t, RepPair(t1), 2); - } - } else { - if (IsAttachedTerm(t1)) { - t = AddSusToList(t, t1); - } - } - } - return(t); -} - -static Int -freeze_goal(Term t, Term g) -{ - if (IsVarTerm(t)) { - sus_record *gf; - sus_tag *vs; - - if (IsAttachedTerm(t)) { - sus_tag *susp = (sus_tag *)VarOfTerm(t); - exts id; - - id = (exts)(susp->sus_id); - if (id != susp_ext) { - /* obtain the term */ - Yap_Error(SYSTEM_ERROR,TermNil,"multiple suspensions not supported"); - return(FALSE); - } - - AddSuspendedGoal(g, susp->SG); - return(TRUE); - } - vs = (sus_tag *)Yap_ReadTimedVar(DelayedVars); - if (H0 - (CELL *)vs < 1024) { - ARG1 = t; - ARG2 = g; - if (!Yap_growglobal(NULL)) { - Yap_Error(SYSTEM_ERROR, t, Yap_ErrorMessage); - return FALSE; - } - t = ARG1; - g = ARG2; - } - /* create a new suspension record */ - gf = (sus_record *)H; - /* I assume here sus_record has size multiple of CELL !!!! */ - H += sizeof(sus_record)/sizeof(CELL); - gf->NR = (sus_record *)&(gf->NR); - gf->SG = g; -#ifdef MULTI_ASSIGNMENT_VARIABLES - gf->NS = UpdateSVarList(gf); -#endif - vs->sus_id = susp_ext; - vs->SG = gf; - RESET_VARIABLE(&(vs->ActiveSus)); - Yap_UpdateTimedVar(DelayedVars, (CELL)(vs+1)); - Bind_Global((CELL *)t,(CELL)&(vs->ActiveSus)); - return(TRUE); - } - else { - /* Oops, first argument was bound :-( */ - Yap_Error(TYPE_ERROR_VARIABLE, t, "freeze/2"); - return(FALSE); - } -} - -#endif /* COROUTINING */ - static Int p_read_svar_list(void) { #ifdef COROUTINING #ifdef MULTI_ASSIGNMENT_VARIABLES - return(Yap_unify(ARG1, MutableList) && Yap_unify(ARG2, AttsMutableList)); + return(Yap_unify(ARG1, AttsMutableList)); #else return(TRUE); #endif @@ -634,122 +45,12 @@ p_set_svar_list(void) { #ifdef COROUTINING #ifdef MULTI_ASSIGNMENT_VARIABLES - MutableList = Deref(ARG1); - AttsMutableList = Deref(ARG2); + AttsMutableList = Deref(ARG1); #endif #endif return(TRUE); } -static Int -p_freeze(void) -{ -#ifdef COROUTINING - Term t = Deref(ARG1); - return(freeze_goal(t, Deref(ARG2))); -#else - return(FALSE); -#endif /* COROUTINING */ -} - -/* The idea here is that we are trying to freeze on a list of - variables. If we can freeze on the first one, we create a - suspension record and are off to see the wizard of Oz. Otherwise, - the goal fails, indicating we did not have to freeze (look at code - for wait and for block to understand why. -*/ -static Int p_freeze_on_first(void) -{ -#ifdef COROUTINING - Term r = Deref(ARG1); - int i; - CELL *pt; - - if (!IsApplTerm(r)) return(FALSE); - i = ArityOfFunctor(FunctorOfTerm(r)); - pt = RepAppl(r)+1; - do { - if (IsNonVarTerm(Derefa(pt))) - return(FALSE); - i --; - pt++; - } while(i); - /* we can freeze on the first variable */ - return(freeze_goal(Derefa(RepAppl(r)+1), Deref(ARG2))); -#else - return(FALSE); -#endif -} - - -/* return a queue with goals currently frozen on the first argument */ -static Int p_frozen_goals(void) -{ - /* initially, we do not know of any frozen goals */ - Term t = TermNil; -#ifdef COROUTINING - Term t1 = Deref(ARG1); - CELL *pt1; - tr_fr_ptr pt0; - /* make B and HB point to H to guarantee all bindings will - be trailed - */ - pt1 = (CELL *)B; - pt0 = TR; - HB = H; - B = (choiceptr)H; - /* look at the first argument */ - if (!IsVarTerm(t1)) { - if (IsApplTerm(t1)) { - Functor f = FunctorOfTerm(t1); - int args; - - if (!IsExtensionFunctor(f)) { - args = ArityOfFunctor(f); - t = AddSusSubGoals(t, RepAppl(t1)+1, args); - } - } else if (IsPairTerm(t1)) { - t = AddSusSubGoals(t, RepPair(t1), 2); - } - } else { - if (IsAttachedTerm(t1)) { - t = AddSusToList(t, t1); - } - } - B = (choiceptr)pt1; - /* untrail all bindings made by IUnify */ - while (TR != pt0) { - pt1 = (CELL *)(TrailTerm(--TR)); - RESET_VARIABLE(pt1); - } - HB = B->cp_h; -#endif - return(Yap_unify(ARG2,t)); -} - -/* return a queue with all goals frozen in the system */ -static Int p_all_frozen_goals(void) -{ -#ifdef COROUTINING - /* initially, we do not know of any goals frozen */ - Term t = Yap_CurrentAttVars(); -#ifdef MULTI_ASSIGNMENT_VARIABLES - sus_record *x = GetSVarList(); - if (x == NULL) - return(Yap_unify(ARG1,t)); - /* okay, we are on top of the list of variables. Let's burn rubber! - */ - while ((CELL)x != TermNil) { - t = MkPairTerm(x->SG,t); - x = x->NS; - } -#endif - return(Yap_unify(ARG1,t)); -#else - return(Yap_unify(ARG1,TermNil)); -#endif -} - #ifdef COROUTINING /* check if variable was there */ @@ -1195,6 +496,16 @@ static Int p_coroutining(void) #endif } +static Term +ListOfWokenGoals(void) { + return Yap_ReadTimedVar(WokenGoals); +} + +Term +Yap_ListOfWokenGoals(void) { + return ListOfWokenGoals(); +} + /* return a list of awoken goals */ static Int p_awoken_goals(void) { @@ -1211,16 +522,6 @@ static Int p_awoken_goals(void) #endif } -#ifdef COROUTINING -void -Yap_WakeUp(CELL *pt0) { - CELL d0 = *pt0; - RESET_VARIABLE(pt0); - TR--; - attas[ExtFromCell(pt0)].bind_op(pt0, d0); -} -#endif - static Int p_yap_has_rational_trees(void) { @@ -1248,11 +549,6 @@ Yap_InitCoroutPreds(void) Atom at; PredEntry *pred; - attas[susp_ext].bind_op = Wake; - attas[susp_ext].copy_term_op = CopySuspendedVar; - attas[susp_ext].to_term_op = SuspendedVarToTerm; - attas[susp_ext].term_to_op = TermToSuspendedVar; - attas[susp_ext].mark_op = mark_suspended_goal; at = Yap_LookupAtom("$wake_up_goal"); pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 2),0)); WakeUpCode = pred; @@ -1260,12 +556,8 @@ Yap_InitCoroutPreds(void) #endif /* COROUTINING */ Yap_InitCPred("$yap_has_rational_trees", 0, p_yap_has_rational_trees, SafePredFlag); Yap_InitCPred("$yap_has_coroutining", 0, p_yap_has_coroutining, SafePredFlag); - Yap_InitCPred("$read_svar_list", 2, p_read_svar_list, SafePredFlag); - Yap_InitCPred("$set_svar_list", 2, p_set_svar_list, SafePredFlag); - Yap_InitCPred("$freeze", 2, p_freeze, 0); - Yap_InitCPred("freeze_on_first", 2, p_freeze_on_first, TestPredFlag); - Yap_InitCPred("$frozen_goals", 2, p_frozen_goals, SafePredFlag); - Yap_InitCPred("$all_frozen_goals", 1, p_all_frozen_goals, SafePredFlag); + Yap_InitCPred("$read_svar_list", 1, p_read_svar_list, SafePredFlag); + Yap_InitCPred("$set_svar_list", 1, p_set_svar_list, SafePredFlag); Yap_InitCPred("$can_unify", 3, p_can_unify, SafePredFlag); Yap_InitCPred("$non_ground", 2, p_non_ground, SafePredFlag); Yap_InitCPred("$coroutining", 0, p_coroutining, SafePredFlag); diff --git a/C/dbase.c b/C/dbase.c index a9d2bbe18..861938a45 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -4740,7 +4740,7 @@ p_init_queue(void) dbq->Flags = DBClMask; dbq->FirstInQueue = dbq->LastInQueue = NULL; INIT_RWLOCK(dbq->QRWLock); - t = MkDBRefTerm((DBRef)dbq); + t = MkIntegerTerm((Int)dbq); return(Yap_unify(ARG1, t)); } @@ -4755,11 +4755,11 @@ p_enqueue(void) if (IsVarTerm(Father)) { Yap_Error(INSTANTIATION_ERROR, Father, "enqueue"); return(FALSE); - } else if (!IsDBRefTerm(Father)) { - Yap_Error(TYPE_ERROR_DBREF, Father, "enqueue"); + } else if (!IsIntegerTerm(Father)) { + Yap_Error(TYPE_ERROR_INTEGER, Father, "enqueue"); return(FALSE); } else - father_key = (db_queue *)DBRefOfTerm(Father); + father_key = (db_queue *)IntegerOfTerm(Father); while ((x = (QueueEntry *)AllocDBSpace(sizeof(QueueEntry))) == NULL) { if (!Yap_growheap(FALSE, sizeof(QueueEntry), NULL)) { Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "in findall"); @@ -4823,11 +4823,11 @@ p_dequeue(void) if (IsVarTerm(Father)) { Yap_Error(INSTANTIATION_ERROR, Father, "dequeue"); return(FALSE); - } else if (!IsDBRefTerm(Father)) { - Yap_Error(TYPE_ERROR_DBREF, Father, "dequeue"); + } else if (!IsIntegerTerm(Father)) { + Yap_Error(TYPE_ERROR_INTEGER, Father, "dequeue"); return(FALSE); } else - father_key = (db_queue *)DBRefOfTerm(Father); + father_key = (db_queue *)IntegerOfTerm(Father); WRITE_LOCK(father_key->QRWLock); if ((cur_instance = father_key->FirstInQueue) == NULL) { /* an empty queue automatically goes away */ diff --git a/C/exec.c b/C/exec.c index 55eefa40f..284d215bb 100644 --- a/C/exec.c +++ b/C/exec.c @@ -1031,15 +1031,17 @@ exec_absmi(int top) return(Yap_absmi(0)); } -static int -do_goal(yamop *CodeAdr, int arity, CELL *pt, int top) +static Term +do_goal(Term t, yamop *CodeAdr, int arity, CELL *pt, int top) { choiceptr saved_b = B; + Term out = 0L; /* create an initial pseudo environment so that when garbage collection is going up in the environment chain it doesn't get confused */ EX = 0L; + // sl = Yap_InitSlot(t); YENV = ASP; YENV[E_CP] = (CELL)P; YENV[E_CB] = (CELL)B; @@ -1084,7 +1086,12 @@ do_goal(yamop *CodeAdr, int arity, CELL *pt, int top) CP = YESCODE; S = CellPtr (RepPredProp (PredPropByFunc (Yap_MkFunctor(AtomCall, 1),0))); /* A1 mishaps */ - return(exec_absmi(top)); + out = exec_absmi(top); + // if (out) { + // out = Yap_GetFromSlot(sl); + // } + // Yap_RecoverSlots(1); + return out; } int @@ -1139,12 +1146,12 @@ Yap_execute_goal(Term t, int nargs, Term mod) if (IsAtomTerm(t)) { CodeAdr = RepPredProp (pe)->CodeOfPred; READ_UNLOCK(ppe->PRWLock); - out = do_goal(CodeAdr, 0, pt, FALSE); + out = do_goal(t, CodeAdr, 0, pt, FALSE); } else { Functor f = FunctorOfTerm(t); CodeAdr = RepPredProp (pe)->CodeOfPred; READ_UNLOCK(ppe->PRWLock); - out = do_goal(CodeAdr, ArityOfFunctor(f), pt, FALSE); + out = do_goal(t, CodeAdr, ArityOfFunctor(f), pt, FALSE); } if (out == 1) { @@ -1218,7 +1225,7 @@ Yap_trust_last(void) } } -int +Term Yap_RunTopGoal(Term t) { yamop *CodeAdr; @@ -1227,7 +1234,7 @@ Yap_RunTopGoal(Term t) CELL *pt; UInt arity; Term mod = CurrentModule; - int goal_out = 0; + Term goal_out = 0; restart_runtopgoal: if (IsAtomTerm(t)) { @@ -1273,7 +1280,7 @@ Yap_RunTopGoal(Term t) Yap_Error(SYSTEM_ERROR,TermNil, "unable to boot because of too little heap space"); } - goal_out = do_goal(CodeAdr, arity, pt, TRUE); + goal_out = do_goal(t, CodeAdr, arity, pt, TRUE); return(goal_out); } diff --git a/C/heapgc.c b/C/heapgc.c index a075dcea0..0636e35e8 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -2910,9 +2910,6 @@ marking_phase(tr_fr_ptr old_TR, CELL *current_env, yamop *curp, CELL *max) cont_top = (cont *)db_vec; /* These two must be marked first so that our trail optimisation won't lose values */ -#ifdef COROUTINING - Yap_mark_all_suspended_goals(); -#endif mark_regs(old_TR); /* active registers & trail */ #ifdef COROUTINING mark_delays(max); diff --git a/C/init.c b/C/init.c index 0639100d4..7436d6026 100644 --- a/C/init.c +++ b/C/init.c @@ -842,9 +842,8 @@ InitCodes(void) heap_regs->atprompt = 0; #ifdef COROUTINING - heap_regs->num_of_atts = 0; /* initially no attributes have been defined */ + heap_regs->num_of_atts = 1; /* initially only coroutining is supported */ #endif - /* system boots in compile mode */ heap_regs->static_predicates_marked = TRUE; /* use Quintus compatible atom_chars and number_chars, not ISO compatible */ diff --git a/C/iopreds.c b/C/iopreds.c index 2930b05b2..4fc120daf 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -4660,9 +4660,11 @@ Yap_StringToTerm(char *s,Term *tp) int sno = open_buf_read_stream(s, strlen(s)+1); Term t; TokEntry *tokstart; + tr_fr_ptr TR_before_parse; if (sno < 0) return FALSE; + TR_before_parse = TR; tokstart = Yap_tokptr = Yap_toktide = Yap_tokenizer(sno); /* cannot actually use CloseStream, because we didn't allocate the buffer */ Stream[sno].status = Free_Stream_f; @@ -4680,6 +4682,7 @@ Yap_StringToTerm(char *s,Term *tp) return FALSE; } t = Yap_Parse(); + TR = TR_before_parse; if (Yap_ErrorMessage) { if (tp) { *tp = syntax_error(tokstart); diff --git a/C/sysbits.c b/C/sysbits.c index 840972457..db7c33997 100644 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -878,16 +878,17 @@ static void HandleSIGSEGV(int sig, siginfo_t *sip, ucontext_t *uap) { +#if !USE_SYSTEM_MALLOC if (sip->si_code != SI_NOINFO && sip->si_code == SEGV_MAPERR && (void *)(sip->si_addr) > (void *)(Yap_HeapBase) && - (void *)(sip->si_addr) < (void *)(Yap_TrailTop+64 * 1024L) && - ! USE_SYSTEM_MALLOC) { + (void *)(sip->si_addr) < (void *)(Yap_TrailTop+64 * 1024L)) { Yap_growtrail(64 * 1024L); - } - else { - Yap_Error(FATAL_ERROR, TermNil, - "likely bug in YAP, segmentation violation at %p", sip->si_addr); + } else +#endif + { + Yap_Error(FATAL_ERROR, TermNil, + "likely bug in YAP, segmentation violation at %p", sip->si_addr); } } diff --git a/C/write.c b/C/write.c index 06c8c9c98..c561427a5 100644 --- a/C/write.c +++ b/C/write.c @@ -311,12 +311,7 @@ write_var(CELL *t, struct write_globs *wglb) exts ext = ExtFromCell(t); Yap_Portray_delays = FALSE; - if (ext == susp_ext) { - wrputs("$DL(",wglb->writech); - write_var(t, wglb); - wrputc(')', wglb->writech); - lastw = separator; - } else if (ext == attvars_ext) { + if (ext == attvars_ext) { attvar_record *attv = (attvar_record *)t; int i; long sl = 0; diff --git a/H/Regs.h b/H/Regs.h index 8db7fa09a..10c733958 100644 --- a/H/Regs.h +++ b/H/Regs.h @@ -10,7 +10,7 @@ * File: Regs.h * * mods: * * comments: YAP abstract machine registers * -* version: $Id: Regs.h,v 1.28 2004-05-13 20:54:58 vsc Exp $ * +* version: $Id: Regs.h,v 1.29 2004-06-05 03:37:00 vsc Exp $ * *************************************************************************/ @@ -92,12 +92,6 @@ typedef struct CELL EX_; /* 18 */ #ifdef COROUTINING Term DelayedVars_; /* maximum number of attributed variables */ -#endif -#ifndef USE_OFFSETS -#ifndef EXT_BASE - Term TermDot_; /* 19 */ - Term TermNil_; /* 20 */ -#endif #endif Term CurrentModule_; #if defined(SBA) || defined(TABLING) diff --git a/H/Yapproto.h b/H/Yapproto.h index bb79ab2ad..96e91e171 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.51 2004-03-05 15:26:33 vsc Exp $ * +* version: $Id: Yapproto.h,v 1.52 2004-06-05 03:37:00 vsc Exp $ * *************************************************************************/ /* prototype file for Yap */ @@ -130,7 +130,6 @@ void STD_PROTO(Yap_InitCoroutPreds,(void)); #ifdef COROUTINING Term STD_PROTO(Yap_ListOfWokenGoals,(void)); void STD_PROTO(Yap_WakeUp,(CELL *)); -void STD_PROTO(Yap_mark_all_suspended_goals,(void)); #endif /* dbase.c */ @@ -150,7 +149,7 @@ void STD_PROTO(Yap_InitEval,(void)); Term STD_PROTO(Yap_ExecuteCallMetaCall,(Term)); void STD_PROTO(Yap_InitExecFs,(void)); Int STD_PROTO(Yap_JumpToEnv,(Term)); -int STD_PROTO(Yap_RunTopGoal,(Term)); +Term STD_PROTO(Yap_RunTopGoal,(Term)); Int STD_PROTO(Yap_execute_goal,(Term, int, Term)); int STD_PROTO(Yap_exec_absmi,(int)); void STD_PROTO(Yap_trust_last,(void)); diff --git a/H/corout.h b/H/corout.h index 88cb73daf..18524ad62 100644 --- a/H/corout.h +++ b/H/corout.h @@ -19,24 +19,22 @@ static char SccsId[]="%W% %G%"; #endif typedef struct sus_record_struct { - struct sus_record_struct *NR; /* next record */ - Term SG; /* suspended goal */ -#ifdef MULTI_ASSIGNMENT_VARIABLES - struct sus_record_struct *NS; /* other suspended goals */ -#endif + Functor f; + Term NR; /* next record for same variable */ + Term SG; /* actual suspended goal */ + Term NS; /* other suspended goals */ } sus_record; typedef struct sus_tag_struct { Term ActiveSus; /* if unbound suspension active, if bound terminated */ CELL sus_id; - sus_record *SG; /* list of suspended goals */ + Term TimeStamp; /* actual suspended goal */ + Term SG; /* list of suspended goals */ } sus_tag; #ifdef COROUTINING /*********** tags for suspension variables */ - #define AbsSuspendedVar(sustag_ptr) AbsAppl(((CELL *)(sustag_ptr))) #define RepSuspendedVar(val) ((sus_tag *)RepAppl(val)) - #endif diff --git a/H/rheap.h b/H/rheap.h index fd9b403fc..6990cd31f 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -11,8 +11,11 @@ * File: rheap.h * * comments: walk through heap code * * * -* Last rev: $Date: 2004-04-29 03:45:50 $,$Author: vsc $ * +* Last rev: $Date: 2004-06-05 03:37:00 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.41 2004/04/29 03:45:50 vsc +* fix garbage collection in execute_tail +* * Revision 1.40 2004/03/31 01:03:10 vsc * support expand group of clauses * @@ -595,7 +598,7 @@ restore_opcodes(yamop *pc) pc->u.Ill.I = (LogUpdIndex *)PtoOpAdjust((yamop *)(pc->u.Ill.I)); pc->u.Ill.l1 = PtoOpAdjust(pc->u.Ill.l1); pc->u.Ill.l2 = PtoOpAdjust(pc->u.Ill.l2); - pc = NEXTOP(pc,Ill); + pc = pc->u.Ill.l1; break; /* instructions type l */ case _enter_profiling: diff --git a/docs/yap.tex b/docs/yap.tex index e811e4102..af8fb9474 100644 --- a/docs/yap.tex +++ b/docs/yap.tex @@ -14083,10 +14083,18 @@ simple way for controlling and communicating with the Prolog run-time. @findex YAP_Read/1 Parse a Term using the function @var{GetC} to input characters. -@item @code{int} YAP_RunGoal(@code{Term} @var{Goal}) +@item @code{Term} YAP_RunGoal(@code{Term} @var{Goal}) @findex YAP_RunGoal/1 Execute query @var{Goal} and return 1 if the query succeeds, and -0 otherwise. +0 otherwise. The predicate returns 0 if failure, otherwise it will +return @var{Term}. Note that @var{Term} may change due to garbage +collection, so you should use something like: +@example + t = YAP_RunGoal(t); + if (t == 0) return FALSE; +@end example +If the execution fails, garbage collection might still have changed +the term, so you should not use the input argument again. @item @code{int} YAP_RestartGoal(@code{void}) @findex YAP_RestartGoal/0 diff --git a/include/YapInterface.h b/include/YapInterface.h index 9efa130ab..957b40a59 100644 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -203,7 +203,7 @@ extern X_API void *PROTO(YAP_AllocSpaceFromYap,(unsigned int)); extern X_API void PROTO(YAP_FreeSpaceFromYap,(void *)); /* int YAP_RunGoal(YAP_Term) */ -extern X_API YAP_Bool PROTO(YAP_RunGoal,(YAP_Term)); +extern X_API YAP_Term PROTO(YAP_RunGoal,(YAP_Term)); /* int YAP_RestartGoal(void) */ extern X_API YAP_Bool PROTO(YAP_RestartGoal,(void)); diff --git a/library/atts.yap b/library/atts.yap index 88343987e..dc425b7ba 100644 --- a/library/atts.yap +++ b/library/atts.yap @@ -15,8 +15,6 @@ * * *************************************************************************/ -:- sequential. - :- module(attributes, []). :- op(1150, fx, attribute). @@ -29,10 +27,10 @@ :- dynamic_predicate(existing_attribute/3,logical). :- dynamic_predicate(modules_with_attributes/1,logical). -:- user_defined_directive(attribute(G), attributes:new_attribute(G)). - modules_with_attributes([]). +:- user_defined_directive(attribute(G), attributes:new_attribute(G)). + user:goal_expansion(get_atts(Var,AccessSpec), Mod, Gs) :- !, expand_get_attributes(AccessSpec,Mod,Var,[],GL), convert_to_goals(GL,Gs). diff --git a/m4/TermExt.h.m4 b/m4/TermExt.h.m4 index cc11994c6..8fda38734 100644 --- a/m4/TermExt.h.m4 +++ b/m4/TermExt.h.m4 @@ -10,7 +10,7 @@ * File: TermExt.h * * mods: * * comments: Extensions to standard terms for YAP * -* version: $Id: TermExt.h.m4,v 1.13 2004-04-22 20:07:06 vsc Exp $ * +* version: $Id: TermExt.h.m4,v 1.14 2004-06-05 03:37:00 vsc Exp $ * *************************************************************************/ #ifdef USE_SYSTEM_MALLOC @@ -85,8 +85,7 @@ typedef struct { /* known delays */ typedef enum { empty_ext = 0*sizeof(ext_op), /* default op, this should never be called */ - susp_ext = 1*sizeof(ext_op), /* support for delayable goals */ - attvars_ext = 2*sizeof(ext_op) /* support for attributed variables */ + attvars_ext = 1*sizeof(ext_op) /* support for attributed variables */ /* add your own extensions here */ /* keep this one */ } exts; diff --git a/m4/Yatom.h.m4 b/m4/Yatom.h.m4 index 32b91c05d..e537062a9 100644 --- a/m4/Yatom.h.m4 +++ b/m4/Yatom.h.m4 @@ -238,10 +238,10 @@ typedef struct pred_entry { tab_ent_ptr TableOfPred; #endif /* TABLING */ Term ModuleOfPred; /* module for this definition */ - struct pred_entry *NextPredOfModule; /* next pred for same module */ /* This must be at an odd number of cells, otherwise it will not be aligned on RISC machines */ profile_data StatisticsForPred; /* enable profiling for predicate */ + struct pred_entry *NextPredOfModule; /* next pred for same module */ } PredEntry; #define PEProp ((PropFlags)(0x0000)) diff --git a/pl/boot.yap b/pl/boot.yap index d6c95141e..649aa1eb3 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -452,9 +452,9 @@ repeat :- '$repeat'. '$write_query_answer_true'(_). '$show_frozen'(G,V,LGs) :- - '$all_frozen_goals'(LGs0), LGs0 = [_|_], !, attributes:all_attvars(LAV), - '$convert_to_list_of_frozen_goals'(LGs0,V,LAV,G,LGs). + LAV = [_|_], !, + '$convert_to_list_of_frozen_goals'(V,LAV,G,LGs). '$show_frozen'(_,_,[]). % diff --git a/pl/corout.yap b/pl/corout.yap index 0ba8f661d..28abea61c 100644 --- a/pl/corout.yap +++ b/pl/corout.yap @@ -36,11 +36,8 @@ :- assert((extensions_to_present_answer(Level) :- '$show_frozen_goals'(Level))). -'$convert_to_list_of_frozen_goals'(LGs0,LIV,LAV,G,NLG) :- - '$sort'(LGs0, LGs), - '$purge_done_goals'(LGs, LG), - '$clean_list_of_frozen_goals'(LG, ILG), - '$project'(G,LIV,LAV,NLG,ILG). +'$convert_to_list_of_frozen_goals'(LIV,LAV,G,NLG) :- + '$project'(LAV,LIV,NLG). '$get_rid_of_vls'((_-G),G). @@ -88,26 +85,44 @@ '$execute_woken_system_goals'([]). '$execute_woken_system_goals'([G|LG]) :- - '$execute_woken_system_goal'(G, G), + '$execute_woken_system_goal'(G), '$execute_woken_system_goals'(LG). +% +% 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,_) :- + '$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_woken_system_goal'('$redo_dif'(Done, X, Y), G) :- +'$execute_frozen_goal'('$redo_dif'(Done, X, Y), G) :- '$redo_dif'(Done, X, Y, G). -% -% X surely was bound, otherwise we would not be awaken. -% -'$execute_woken_system_goal'('$redo_freeze'(Done, _, Goal), _) :- +'$execute_frozen_goal'('$redo_freeze'(Done, _, Goal), _) :- '$redo_freeze'(Done, Goal). -'$execute_woken_system_goal'('$redo_eq'(Done, X, Y, Goal), G) :- +'$execute_frozen_goal'('$redo_eq'(Done, X, Y, Goal), G) :- '$redo_eq'(Done, X, Y, Goal, G). -'$execute_woken_system_goal'('$redo_ground'(Done, X, Goal), _) :- +'$execute_frozen_goal'('$redo_ground'(Done, X, Goal), _) :- '$redo_ground'(Done, X, Goal). -'$execute_woken_system_goal'('$att_do'(V,New), _) :- - % make sure we are not trying to wake up again a bound variable. - ( '$att_bound'(V) -> true ; attributes:woken_att_do(V,New) ). freeze(V, G) :- var(V), !, @@ -468,9 +483,7 @@ when(_,Goal) :- frozen(V, G) :- nonvar(V), !, G = true. frozen(V, LG) :- - '$frozen_goals'(V, LGs), - '$find_att_vars'(LGs, AttVars), - '$convert_to_list_of_frozen_goals'(LGs,[V],AttVars,V,G), + '$project'([V],[V],G), '$simplify_list_of_frozen_goals'(G,LG). %write(vsc:G0), nl, % '$purge_done_goals'(G0, GI), @@ -503,36 +516,6 @@ frozen(V, LG) :- '$purge_done_goals'(G0, GF). -'$clean_list_of_frozen_goals'([], []). -'$clean_list_of_frozen_goals'([A|B], G) :- - '$convert_list_of_frozen_goals_into_list'([A|B], G). - -'$convert_list_of_frozen_goals_into_list'([A], [LV-G]) :- !, - '$convert_frozen_goal'(A, [], _, LV0, G0), - '$clean_bound_args'(LV0, LV1), - '$sort'(LV1, LV), - '$process_when'(G0, G). -'$convert_list_of_frozen_goals_into_list'([A|L], OUT) :- !, - '$convert_frozen_goal'(A, LV, Done, NA, G0), - '$process_when'(G0, Gf), - '$fetch_same_done_goals'(L, Done, LV, NL), - '$clean_bound_args'(NA, NA1), - '$sort'(NA1, LVf), - ( NL = [] -> OUT = [LVf-Gf]; - OUT = [(LVf-Gf)|Gs], - '$convert_list_of_frozen_goals_into_list'(NL, Gs)). - - -'$clean_bound_args'([], []). -'$clean_bound_args'([NV|L], NL) :- nonvar(NV), !, - '$clean_bound_args'(L,NL). -'$clean_bound_args'([V|L], [V|NL]) :- - '$clean_bound_args'(L,NL). - -'$process_when'('$when'(_,G,_), NG) :- !, - '$process_when'(G, NG). -'$process_when'(G, G). - '$convert_frozen_goal'(V, _, _, V, _) :- '$is_att_variable'(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). @@ -559,20 +542,19 @@ frozen(V, LG) :- call_residue(Goal,Residue) :- - '$read_svar_list'(OldList,OldAttsList), + '$read_svar_list'(OldAttsList), '$copy_term_but_not_constraints'(Goal, NGoal), - ( create_mutable([], CurrentList), - create_mutable([], CurrentAttsList), - '$set_svar_list'(CurrentList, CurrentAttsList), + ( create_mutable([], CurrentAttsList), + '$set_svar_list'(CurrentAttsList), '$execute'(NGoal), '$call_residue_continuation'(NGoal,NResidue), - ( '$set_svar_list'(OldList,OldAttsList), + ( '$set_svar_list'(OldAttsList), '$copy_term_but_not_constraints'(NGoal+NResidue, Goal+Residue) ; - '$set_svar_list'(CurrentList,CurrentAttsList), fail + '$set_svar_list'(CurrentAttsList), fail ) ; - '$set_svar_list'(OldList,OldAttsList), fail + '$set_svar_list'(OldAttsList), fail ). % @@ -588,8 +570,7 @@ call_residue(Goal,Residue) :- attributes:convert_att_var(AttV, GS), '$purge_and_set_done_goals'(G0, GF, Atts). '$purge_and_set_done_goals'(['$redo_dif'(Done, X , Y)|G0], [LVars-dif(X,Y)|GF], Atts) :- - var(Done), - !, + var(Done), !, Done = '$done', '$can_unify'(X, Y, LVars), '$purge_and_set_done_goals'(G0, GF, Atts). @@ -609,20 +590,19 @@ call_residue(Goal,Residue) :- '$purge_and_set_done_goals'(G0, GF, Atts). -'$project'(true,_,_,Gs,Gs) :- !. -'$project'(_,_,_,Gs,Gs) :- - '$undefined'(modules_with_attributes(_), attributes), !. -'$project'(_,LIV,LAV,Gs,Gs0) :- +'$project'([],_,[]). +'$project'([V|LAV],_,LGs) :- + % we don't have constraints yet, so we must be talking about delays. + '$undefined'(modules_with_attributes(LAV),attributes), !, + attributes:all_attvars(NLAV), + '$fetch_delays'(NLAV,LGs, []). +'$project'([V|LAV],LIV,LDs) :- attributes:modules_with_attributes(LMods), - (LAV = [] -> - Gs = Gs0 - ; - '$pick_vars_for_project'(LIV,NLIV), - '$project_module'(LMods,NLIV,LAV), - attributes:all_attvars(NLAV0), - '$sort'(NLAV0, NLAV), - '$convert_att_vars'(NLAV, LIV, Gs, Gs0) - ). + '$pick_vars_for_project'(LIV,NLIV), + '$project_module'(LMods,NLIV,[V|LAV]), + attributes:all_attvars(NLAV), + '$convert_att_vars'(NLAV, LIV, LGs), + '$fetch_delays'(NLAV, LDs, LGs). '$pick_vars_for_project'([],[]). '$pick_vars_for_project'([V|L],[V|NL]) :- var(V), !, @@ -639,25 +619,27 @@ call_residue(Goal,Residue) :- '$project_module'([_|LMods], LIV, LAV) :- '$project_module'(LMods,LIV,LAV). -'$convert_att_vars'([], _, L, L). -'$convert_att_vars'([V|LAV], LIV, NGs, NGs0) :- + +'$convert_att_vars'(Vs, LIV, []) :- + % do nothing + '$undefined'(convert_att_var(Vs,LIV),attributes), !. +'$convert_att_vars'(Vs0, LIV, LGs) :- + '$sort'(Vs0, Vs), + '$do_convert_att_vars'(Vs0, LIV, LGs). + +'$do_convert_att_vars'([], _, []). +'$do_convert_att_vars'([V|LAV], LIV, NGs) :- var(V), - attributes:convert_att_var(V, G), + attributes:convert_att_var(V,G), G \= true, -% '$variables_in_term'(G,[],GV0), - % I'm allowing goals without variables to go through -% '$sort'(GV0,GV), -% ( GV0 = [] -> true ; -% '$sort'(LIV,NLIV), % notice that ordering changes as we introduce constraints -% '$vars_interset_for_constr'(GV,NLIV) ), !, !, '$split_goals_for_catv'(G,V,NGs,IGs), - '$convert_att_vars'(LAV, LIV, IGs, NGs0). -'$convert_att_vars'([_|LAV], LIV, Gs, NGs0) :- - '$convert_att_vars'(LAV, LIV, Gs, NGs0). + '$do_convert_att_vars'(LAV, LIV, IGs). +'$do_convert_att_vars'([_|LAV], LIV, Gs) :- + '$do_convert_att_vars'(LAV, LIV, Gs). -'$split_goals_for_catv'((G,NG),V,Gs,Gs0) :- !, - '$split_goals_for_catv'(NG,V,Gs,[V-G|Gs0]). +'$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|_]) :- @@ -668,6 +650,62 @@ call_residue(Goal,Residue) :- '$vars_interset_for_constr'([V1|GV],[_|LIV]) :- '$vars_interset_for_constr'([V1|GV],LIV). +%'$fetch_delays'(_, L, L) :- +% '$no_delayed_goals', !. +'$fetch_delays'(Vs, LDs, LAs) :- + '$do_fetch_delays'(Vs, LGs0), + '$sort'(LGs0, LGs), + '$purge_done_goals'(LGs, LG), + '$clean_list_of_frozen_goals'(LG, LDs, LAs). + + +'$do_fetch_delays'([], []). +'$do_fetch_delays'([V|NLAV], GF) :- + '$frozen_goals'(V,G), !, + '$hole_in_frozen_goals'(G,GF,G1), + '$do_fetch_delays'(NLAV, G1). +'$do_fetch_delays'([V|NLAV], GF) :- + '$do_fetch_delays'(NLAV, GF). +'$hole_in_frozen_goals'([],V,V). +'$hole_in_frozen_goals'([G|Gs],[G|GF],G1) :- + '$hole_in_frozen_goals'(Gs,GF,G1). + +'$clean_list_of_frozen_goals'([], L, L). +'$clean_list_of_frozen_goals'([A|B], Gs, Gs0) :- + '$convert_list_of_frozen_goals_into_list'([A|B], Gs, Gs0). + +'$convert_list_of_frozen_goals_into_list'([A], [LV-G|L], L) :- !, + '$convert_frozen_goal'(A, [], _, LV0, G0), + '$clean_bound_args'(LV0, LV1), + '$sort'(LV1, LV), + '$process_when'(G0, G). +'$convert_list_of_frozen_goals_into_list'([A|L], OUT, Gs0) :- !, + '$convert_frozen_goal'(A, LV, Done, NA, G0), + '$process_when'(G0, Gf), + '$fetch_same_done_goals'(L, Done, LV, NL), + '$clean_bound_args'(NA, NA1), + '$sort'(NA1, LVf), + ( NL = [] -> OUT = [LVf-Gf|Gs0]; + OUT = [(LVf-Gf)|Gs], + '$convert_list_of_frozen_goals_into_list'(NL, Gs, Gs0)). + + +'$clean_bound_args'([], []). +'$clean_bound_args'([NV|L], NL) :- nonvar(NV), !, + '$clean_bound_args'(L,NL). +'$clean_bound_args'([V|L], [V|NL]) :- + '$clean_bound_args'(L,NL). + +'$process_when'('$when'(_,G,_), NG) :- !, + '$process_when'(G, NG). +'$process_when'(G, G). + +'$freeze'(V,G) :- + attributes:update_att(V, 0, G). + +'$frozen_goals'(V,Gs) :- + attributes:get_att(V, 0, Gs), nonvar(Gs). + diff --git a/pl/signals.yap b/pl/signals.yap index 29655950e..33ab11312 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -27,7 +27,7 @@ '$execute'(M:G). '$do_signal'(sig_wake_up, G) :- - '$awoken_goals'(LG), + '$awoken_goals'(LG), % if more signals alive, set creep flag '$continue_signals', '$wake_up_goal'(G, LG).